Repository: kanaka/mal Branch: master Commit: 2bbfaa54cca4 Files: 2441 Total size: 11.2 MB Directory structure: gitextract_0ybyg9g2/ ├── .gitattributes ├── .github/ │ ├── pull_request_template.md │ └── workflows/ │ └── main.yml ├── .gitignore ├── .gitmodules ├── .travis.yml ├── IMPLS.yml ├── LICENSE ├── Makefile ├── Makefile.impls ├── README.md ├── ci.sh ├── docs/ │ ├── FAQ.md │ ├── Hints.md │ ├── TODO │ ├── cheatsheet.html │ ├── exercises.md │ ├── graph/ │ │ ├── README.md │ │ ├── all_data.json │ │ ├── base_data.yaml │ │ ├── collect_data.js │ │ ├── graph_languages.js │ │ ├── index.html │ │ ├── package.json │ │ └── so-tags.csv │ ├── index.html │ ├── notes.md │ ├── step_notes.txt │ └── web/ │ ├── ansi.css │ ├── base.css │ ├── console.css │ ├── himera.css │ ├── layout.css │ ├── mal.js │ └── skeleton.css ├── examples/ │ ├── clojurewest2014.mal │ ├── exercises.mal │ ├── hello.mal │ └── presentation.mal ├── get-ci-matrix.py ├── impls/ │ ├── .gitignore │ ├── ada/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.adb │ │ ├── core.ads │ │ ├── envs.adb │ │ ├── envs.ads │ │ ├── eval_callback.ads │ │ ├── printer.adb │ │ ├── printer.ads │ │ ├── reader.adb │ │ ├── reader.ads │ │ ├── run │ │ ├── smart_pointers.adb │ │ ├── smart_pointers.ads │ │ ├── step0_repl.adb │ │ ├── step1_read_print.adb │ │ ├── step2_eval.adb │ │ ├── step3_env.adb │ │ ├── step4_if_fn_do.adb │ │ ├── step5_tco.adb │ │ ├── step6_file.adb │ │ ├── step7_quote.adb │ │ ├── step8_macros.adb │ │ ├── step9_try.adb │ │ ├── stepa_mal.adb │ │ ├── types-hash_map.adb │ │ ├── types-hash_map.ads │ │ ├── types-vector.adb │ │ ├── types-vector.ads │ │ ├── types.adb │ │ └── types.ads │ ├── ada.2/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README │ │ ├── core.adb │ │ ├── core.ads │ │ ├── envs.adb │ │ ├── envs.ads │ │ ├── err.adb │ │ ├── err.ads │ │ ├── garbage_collected.adb │ │ ├── garbage_collected.ads │ │ ├── printer.adb │ │ ├── printer.ads │ │ ├── reader.adb │ │ ├── reader.ads │ │ ├── readline.adb │ │ ├── readline.ads │ │ ├── run │ │ ├── step0_repl.adb │ │ ├── step1_read_print.adb │ │ ├── step2_eval.adb │ │ ├── step3_env.adb │ │ ├── step4_if_fn_do.adb │ │ ├── step5_tco.adb │ │ ├── step6_file.adb │ │ ├── step7_quote.adb │ │ ├── step8_macros.adb │ │ ├── step9_try.adb │ │ ├── stepa_mal.adb │ │ ├── types-atoms.adb │ │ ├── types-atoms.ads │ │ ├── types-builtins.adb │ │ ├── types-builtins.ads │ │ ├── types-fns.adb │ │ ├── types-fns.ads │ │ ├── types-maps.adb │ │ ├── types-maps.ads │ │ ├── types-sequences.adb │ │ ├── types-sequences.ads │ │ ├── types-strings.adb │ │ ├── types-strings.ads │ │ ├── types.adb │ │ └── types.ads │ ├── awk/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.awk │ │ ├── env.awk │ │ ├── printer.awk │ │ ├── reader.awk │ │ ├── run │ │ ├── step0_repl.awk │ │ ├── step1_read_print.awk │ │ ├── step2_eval.awk │ │ ├── step3_env.awk │ │ ├── step4_if_fn_do.awk │ │ ├── step5_tco.awk │ │ ├── step6_file.awk │ │ ├── step7_quote.awk │ │ ├── step8_macros.awk │ │ ├── step9_try.awk │ │ ├── stepA_mal.awk │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.awk │ ├── bash/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.sh │ │ ├── env.sh │ │ ├── printer.sh │ │ ├── reader.sh │ │ ├── run │ │ ├── step0_repl.sh │ │ ├── step1_read_print.sh │ │ ├── step2_eval.sh │ │ ├── step3_env.sh │ │ ├── step4_if_fn_do.sh │ │ ├── step5_tco.sh │ │ ├── step6_file.sh │ │ ├── step7_quote.sh │ │ ├── step8_macros.sh │ │ ├── step9_try.sh │ │ ├── stepA_mal.sh │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ └── types.sh │ ├── basic/ │ │ ├── .args.mal │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── basicpp.py │ │ ├── cbmbasic_console.patch │ │ ├── core.in.bas │ │ ├── debug.in.bas │ │ ├── env.in.bas │ │ ├── mem.in.bas │ │ ├── printer.in.bas │ │ ├── reader.in.bas │ │ ├── readline.in.bas │ │ ├── run │ │ ├── step0_repl.in.bas │ │ ├── step1_read_print.in.bas │ │ ├── step2_eval.in.bas │ │ ├── step3_env.in.bas │ │ ├── step4_if_fn_do.in.bas │ │ ├── step5_tco.in.bas │ │ ├── step6_file.in.bas │ │ ├── step7_quote.in.bas │ │ ├── step8_macros.in.bas │ │ ├── step9_try.in.bas │ │ ├── stepA_mal.in.bas │ │ ├── types.in.bas │ │ └── variables.txt │ ├── bbc-basic/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.bas │ │ ├── env.bas │ │ ├── printer.bas │ │ ├── reader.bas │ │ ├── riscos/ │ │ │ ├── .gitignore │ │ │ ├── setup,feb │ │ │ └── tokenize,ffe │ │ ├── run │ │ ├── step0_repl.bas │ │ ├── step1_read_print.bas │ │ ├── step2_eval.bas │ │ ├── step3_env.bas │ │ ├── step4_if_fn_do.bas │ │ ├── step5_tco.bas │ │ ├── step6_file.bas │ │ ├── step7_quote.bas │ │ ├── step8_macros.bas │ │ ├── step9_try.bas │ │ ├── stepA_mal.bas │ │ └── types.bas │ ├── c/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.c │ │ ├── core.h │ │ ├── env.c │ │ ├── interop.c │ │ ├── interop.h │ │ ├── printer.c │ │ ├── printer.h │ │ ├── reader.c │ │ ├── reader.h │ │ ├── readline.c │ │ ├── readline.h │ │ ├── run │ │ ├── step0_repl.c │ │ ├── step1_read_print.c │ │ ├── step2_eval.c │ │ ├── step3_env.c │ │ ├── step4_if_fn_do.c │ │ ├── step5_tco.c │ │ ├── step6_file.c │ │ ├── step7_quote.c │ │ ├── step8_macros.c │ │ ├── step9_try.c │ │ ├── stepA_mal.c │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ ├── types.c │ │ └── types.h │ ├── c.2/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README │ │ ├── core.c │ │ ├── core.h │ │ ├── env.c │ │ ├── env.h │ │ ├── error.c │ │ ├── error.h │ │ ├── hashmap.c │ │ ├── hashmap.h │ │ ├── linked_list.c │ │ ├── linked_list.h │ │ ├── printer.c │ │ ├── printer.h │ │ ├── reader.c │ │ ├── reader.h │ │ ├── readline.c │ │ ├── readline.h │ │ ├── run │ │ ├── step0_repl.c │ │ ├── step1_read_print.c │ │ ├── step2_eval.c │ │ ├── step3_env.c │ │ ├── step4_if_fn_do.c │ │ ├── step5_tco.c │ │ ├── step6_file.c │ │ ├── step7_quote.c │ │ ├── step8_macros.c │ │ ├── step9_try.c │ │ ├── stepA_mal.c │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ ├── types.c │ │ ├── types.h │ │ ├── vector.c │ │ └── vector.h │ ├── chuck/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── chuck.md │ │ ├── core.ck │ │ ├── env.ck │ │ ├── func.ck │ │ ├── notes.md │ │ ├── printer.ck │ │ ├── reader.ck │ │ ├── readline.ck │ │ ├── run │ │ ├── step0_repl.ck │ │ ├── step1_read_print.ck │ │ ├── step2_eval.ck │ │ ├── step3_env.ck │ │ ├── step4_if_fn_do.ck │ │ ├── step5_tco.ck │ │ ├── step6_file.ck │ │ ├── step7_quote.ck │ │ ├── step8_macros.ck │ │ ├── step9_try.ck │ │ ├── stepA_mal.ck │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ ├── types/ │ │ │ ├── MalObject.ck │ │ │ ├── MalSubr.ck │ │ │ ├── mal/ │ │ │ │ ├── MalAtom.ck │ │ │ │ ├── MalError.ck │ │ │ │ ├── MalFalse.ck │ │ │ │ ├── MalHashMap.ck │ │ │ │ ├── MalInt.ck │ │ │ │ ├── MalKeyword.ck │ │ │ │ ├── MalList.ck │ │ │ │ ├── MalNil.ck │ │ │ │ ├── MalString.ck │ │ │ │ ├── MalSymbol.ck │ │ │ │ ├── MalTrue.ck │ │ │ │ └── MalVector.ck │ │ │ └── subr/ │ │ │ ├── MalAdd.ck │ │ │ ├── MalApply.ck │ │ │ ├── MalAssoc.ck │ │ │ ├── MalAtomify.ck │ │ │ ├── MalConcat.ck │ │ │ ├── MalConj.ck │ │ │ ├── MalCons.ck │ │ │ ├── MalCount.ck │ │ │ ├── MalDeref.ck │ │ │ ├── MalDissoc.ck │ │ │ ├── MalDiv.ck │ │ │ ├── MalDoReset.ck │ │ │ ├── MalDoSwap.ck │ │ │ ├── MalEqual.ck │ │ │ ├── MalFirst.ck │ │ │ ├── MalGet.ck │ │ │ ├── MalGreater.ck │ │ │ ├── MalGreaterEqual.ck │ │ │ ├── MalHashMapify.ck │ │ │ ├── MalIsAtom.ck │ │ │ ├── MalIsContains.ck │ │ │ ├── MalIsEmpty.ck │ │ │ ├── MalIsFalse.ck │ │ │ ├── MalIsFn.ck │ │ │ ├── MalIsHashMap.ck │ │ │ ├── MalIsKeyword.ck │ │ │ ├── MalIsList.ck │ │ │ ├── MalIsMacro.ck │ │ │ ├── MalIsNil.ck │ │ │ ├── MalIsNumber.ck │ │ │ ├── MalIsString.ck │ │ │ ├── MalIsSymbol.ck │ │ │ ├── MalIsTrue.ck │ │ │ ├── MalIsVector.ck │ │ │ ├── MalKeys.ck │ │ │ ├── MalKeywordify.ck │ │ │ ├── MalLess.ck │ │ │ ├── MalLessEqual.ck │ │ │ ├── MalListify.ck │ │ │ ├── MalMap.ck │ │ │ ├── MalMeta.ck │ │ │ ├── MalMul.ck │ │ │ ├── MalNth.ck │ │ │ ├── MalPrStr.ck │ │ │ ├── MalPrintln.ck │ │ │ ├── MalPrn.ck │ │ │ ├── MalReadStr.ck │ │ │ ├── MalReadline.ck │ │ │ ├── MalRest.ck │ │ │ ├── MalSeq.ck │ │ │ ├── MalSequential.ck │ │ │ ├── MalSlurp.ck │ │ │ ├── MalStr.ck │ │ │ ├── MalSub.ck │ │ │ ├── MalSymbolify.ck │ │ │ ├── MalThrow.ck │ │ │ ├── MalTimeMs.ck │ │ │ ├── MalVals.ck │ │ │ ├── MalVec.ck │ │ │ ├── MalVectorify.ck │ │ │ └── MalWithMeta.ck │ │ └── util/ │ │ ├── Constants.ck │ │ ├── String.ck │ │ └── Util.ck │ ├── clojure/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── package.json │ │ ├── project.clj │ │ ├── run │ │ ├── src/ │ │ │ └── mal/ │ │ │ ├── core.cljc │ │ │ ├── env.cljc │ │ │ ├── node_readline.js │ │ │ ├── printer.cljc │ │ │ ├── reader.cljc │ │ │ ├── readline.clj │ │ │ ├── readline.cljs │ │ │ ├── step0_repl.cljc │ │ │ ├── step1_read_print.cljc │ │ │ ├── step2_eval.cljc │ │ │ ├── step3_env.cljc │ │ │ ├── step4_if_fn_do.cljc │ │ │ ├── step5_tco.cljc │ │ │ ├── step6_file.cljc │ │ │ ├── step7_quote.cljc │ │ │ ├── step8_macros.cljc │ │ │ ├── step9_try.cljc │ │ │ └── stepA_mal.cljc │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── coffee/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.coffee │ │ ├── env.coffee │ │ ├── node_readline.coffee │ │ ├── package.json │ │ ├── printer.coffee │ │ ├── reader.coffee │ │ ├── run │ │ ├── step0_repl.coffee │ │ ├── step1_read_print.coffee │ │ ├── step2_eval.coffee │ │ ├── step3_env.coffee │ │ ├── step4_if_fn_do.coffee │ │ ├── step5_tco.coffee │ │ ├── step6_file.coffee │ │ ├── step7_quote.coffee │ │ ├── step8_macros.coffee │ │ ├── step9_try.coffee │ │ ├── stepA_mal.coffee │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.coffee │ ├── common-lisp/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.org │ │ ├── fake-readline.lisp │ │ ├── hist/ │ │ │ └── .keepdir │ │ ├── run │ │ ├── run-abcl.lisp │ │ ├── run-mkcl.lisp │ │ ├── src/ │ │ │ ├── core.lisp │ │ │ ├── env.lisp │ │ │ ├── printer.lisp │ │ │ ├── reader.lisp │ │ │ ├── step0_repl.lisp │ │ │ ├── step1_read_print.lisp │ │ │ ├── step2_eval.lisp │ │ │ ├── step3_env.lisp │ │ │ ├── step4_if_fn_do.lisp │ │ │ ├── step5_tco.lisp │ │ │ ├── step6_file.lisp │ │ │ ├── step7_quote.lisp │ │ │ ├── step8_macros.lisp │ │ │ ├── step9_try.lisp │ │ │ ├── stepA_mal.lisp │ │ │ ├── types.lisp │ │ │ └── utils.lisp │ │ ├── step0_repl.asd │ │ ├── step1_read_print.asd │ │ ├── step2_eval.asd │ │ ├── step3_env.asd │ │ ├── step4_if_fn_do.asd │ │ ├── step5_tco.asd │ │ ├── step6_file.asd │ │ ├── step7_quote.asd │ │ ├── step8_macros.asd │ │ ├── step9_try.asd │ │ ├── stepA_mal.asd │ │ └── tests/ │ │ └── stepA_mal.mal │ ├── cpp/ │ │ ├── .gitignore │ │ ├── Core.cpp │ │ ├── Debug.h │ │ ├── Dockerfile │ │ ├── Environment.cpp │ │ ├── Environment.h │ │ ├── MAL.h │ │ ├── Makefile │ │ ├── README.md │ │ ├── ReadLine.cpp │ │ ├── ReadLine.h │ │ ├── Reader.cpp │ │ ├── RefCountedPtr.h │ │ ├── StaticList.h │ │ ├── String.cpp │ │ ├── String.h │ │ ├── Types.cpp │ │ ├── Types.h │ │ ├── Validation.cpp │ │ ├── Validation.h │ │ ├── docker.sh │ │ ├── run │ │ ├── step0_repl.cpp │ │ ├── step1_read_print.cpp │ │ ├── step2_eval.cpp │ │ ├── step3_env.cpp │ │ ├── step4_if_fn_do.cpp │ │ ├── step5_tco.cpp │ │ ├── step6_file.cpp │ │ ├── step7_quote.cpp │ │ ├── step8_macros.cpp │ │ ├── step9_try.cpp │ │ ├── stepA_mal.cpp │ │ └── tests/ │ │ └── step5_tco.mal │ ├── crystal/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.cr │ │ ├── env.cr │ │ ├── error.cr │ │ ├── printer.cr │ │ ├── reader.cr │ │ ├── run │ │ ├── shard.yml │ │ ├── step0_repl.cr │ │ ├── step1_read_print.cr │ │ ├── step2_eval.cr │ │ ├── step3_env.cr │ │ ├── step4_if_fn_do.cr │ │ ├── step5_tco.cr │ │ ├── step6_file.cr │ │ ├── step7_quote.cr │ │ ├── step8_macros.cr │ │ ├── step9_try.cr │ │ ├── stepA_mal.cr │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.cr │ ├── cs/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.cs │ │ ├── env.cs │ │ ├── getline.cs │ │ ├── interop.cs │ │ ├── printer.cs │ │ ├── reader.cs │ │ ├── readline.cs │ │ ├── run │ │ ├── step0_repl.cs │ │ ├── step1_read_print.cs │ │ ├── step2_eval.cs │ │ ├── step3_env.cs │ │ ├── step4_if_fn_do.cs │ │ ├── step5_tco.cs │ │ ├── step6_file.cs │ │ ├── step7_quote.cs │ │ ├── step8_macros.cs │ │ ├── step9_try.cs │ │ ├── stepA_mal.cs │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.cs │ ├── d/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── env.d │ │ ├── main.di │ │ ├── mal_core.d │ │ ├── printer.d │ │ ├── reader.d │ │ ├── readline.d │ │ ├── run │ │ ├── step0_repl.d │ │ ├── step1_read_print.d │ │ ├── step2_eval.d │ │ ├── step3_env.d │ │ ├── step4_if_fn_do.d │ │ ├── step5_tco.d │ │ ├── step6_file.d │ │ ├── step7_quote.d │ │ ├── step8_macros.d │ │ ├── step9_try.d │ │ ├── stepA_mal.d │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.d │ ├── dart/ │ │ ├── .analysis_options │ │ ├── .packages │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.dart │ │ ├── env.dart │ │ ├── printer.dart │ │ ├── pubspec.yaml │ │ ├── reader.dart │ │ ├── run │ │ ├── step0_repl.dart │ │ ├── step1_read_print.dart │ │ ├── step2_eval.dart │ │ ├── step3_env.dart │ │ ├── step4_if_fn_do.dart │ │ ├── step5_tco.dart │ │ ├── step6_file.dart │ │ ├── step7_quote.dart │ │ ├── step8_macros.dart │ │ ├── step9_try.dart │ │ ├── stepA_mal.dart │ │ └── types.dart │ ├── elisp/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── mal/ │ │ │ ├── core.el │ │ │ ├── env.el │ │ │ ├── printer.el │ │ │ ├── reader.el │ │ │ └── types.el │ │ ├── run │ │ ├── step0_repl.el │ │ ├── step1_read_print.el │ │ ├── step2_eval.el │ │ ├── step3_env.el │ │ ├── step4_if_fn_do.el │ │ ├── step5_tco.el │ │ ├── step6_file.el │ │ ├── step7_quote.el │ │ ├── step8_macros.el │ │ ├── step9_try.el │ │ ├── stepA_mal.el │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── elixir/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── lib/ │ │ │ ├── mal/ │ │ │ │ ├── atom.ex │ │ │ │ ├── core.ex │ │ │ │ ├── env.ex │ │ │ │ ├── printer.ex │ │ │ │ ├── reader.ex │ │ │ │ └── types.ex │ │ │ ├── mal.ex │ │ │ └── mix/ │ │ │ └── tasks/ │ │ │ ├── step0_repl.ex │ │ │ ├── step1_read_print.ex │ │ │ ├── step2_eval.ex │ │ │ ├── step3_env.ex │ │ │ ├── step4_if_fn_do.ex │ │ │ ├── step5_tco.ex │ │ │ ├── step6_file.ex │ │ │ ├── step7_quote.ex │ │ │ ├── step8_macros.ex │ │ │ ├── step9_try.ex │ │ │ └── stepA_mal.ex │ │ ├── mix.exs │ │ ├── run │ │ └── tests/ │ │ └── step5_tco.mal │ ├── elm/ │ │ ├── .dockerignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── bootstrap.js │ │ ├── elm.json │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── run │ │ └── src/ │ │ ├── Core.elm │ │ ├── Env.elm │ │ ├── Eval.elm │ │ ├── IO.elm │ │ ├── Printer.elm │ │ ├── Reader.elm │ │ ├── Step0_repl.elm │ │ ├── Step1_read_print.elm │ │ ├── Step2_eval.elm │ │ ├── Step3_env.elm │ │ ├── Step4_if_fn_do.elm │ │ ├── Step5_tco.elm │ │ ├── Step6_file.elm │ │ ├── Step7_quote.elm │ │ ├── Step8_macros.elm │ │ ├── Step9_try.elm │ │ ├── StepA_mal.elm │ │ ├── Types.elm │ │ └── Utils.elm │ ├── erlang/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── rebar.config │ │ ├── rebar.config.script │ │ ├── run │ │ ├── src/ │ │ │ ├── atom.erl │ │ │ ├── core.erl │ │ │ ├── env.erl │ │ │ ├── mal.app.src │ │ │ ├── printer.erl │ │ │ ├── reader.erl │ │ │ ├── step0_repl.erl │ │ │ ├── step1_read_print.erl │ │ │ ├── step2_eval.erl │ │ │ ├── step3_env.erl │ │ │ ├── step4_if_fn_do.erl │ │ │ ├── step5_tco.erl │ │ │ ├── step6_file.erl │ │ │ ├── step7_quote.erl │ │ │ ├── step8_macros.erl │ │ │ ├── step9_try.erl │ │ │ ├── stepA_mal.erl │ │ │ └── types.erl │ │ └── tests/ │ │ └── step5_tco.mal │ ├── es6/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.mjs │ │ ├── env.mjs │ │ ├── node_readline.mjs │ │ ├── package.json │ │ ├── printer.mjs │ │ ├── reader.mjs │ │ ├── run │ │ ├── step0_repl.mjs │ │ ├── step1_read_print.mjs │ │ ├── step2_eval.mjs │ │ ├── step3_env.mjs │ │ ├── step4_if_fn_do.mjs │ │ ├── step5_tco.mjs │ │ ├── step6_file.mjs │ │ ├── step7_quote.mjs │ │ ├── step8_macros.mjs │ │ ├── step9_try.mjs │ │ ├── stepA_mal.mjs │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.mjs │ ├── factor/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── lib/ │ │ │ ├── core/ │ │ │ │ ├── core-tests.factor │ │ │ │ └── core.factor │ │ │ ├── env/ │ │ │ │ ├── env-tests.factor │ │ │ │ └── env.factor │ │ │ ├── printer/ │ │ │ │ ├── printer-tests.factor │ │ │ │ └── printer.factor │ │ │ ├── reader/ │ │ │ │ ├── reader-tests.factor │ │ │ │ └── reader.factor │ │ │ └── types/ │ │ │ └── types.factor │ │ ├── run │ │ ├── step0_repl/ │ │ │ ├── deploy.factor │ │ │ └── step0_repl.factor │ │ ├── step1_read_print/ │ │ │ ├── deploy.factor │ │ │ └── step1_read_print.factor │ │ ├── step2_eval/ │ │ │ ├── deploy.factor │ │ │ └── step2_eval.factor │ │ ├── step3_env/ │ │ │ ├── deploy.factor │ │ │ └── step3_env.factor │ │ ├── step4_if_fn_do/ │ │ │ ├── deploy.factor │ │ │ └── step4_if_fn_do.factor │ │ ├── step5_tco/ │ │ │ ├── deploy.factor │ │ │ └── step5_tco.factor │ │ ├── step6_file/ │ │ │ ├── deploy.factor │ │ │ └── step6_file.factor │ │ ├── step7_quote/ │ │ │ ├── deploy.factor │ │ │ └── step7_quote.factor │ │ ├── step8_macros/ │ │ │ ├── deploy.factor │ │ │ └── step8_macros.factor │ │ ├── step9_try/ │ │ │ ├── deploy.factor │ │ │ └── step9_try.factor │ │ ├── stepA_mal/ │ │ │ ├── deploy.factor │ │ │ └── stepA_mal.factor │ │ └── tests/ │ │ └── step5_tco.mal │ ├── fantom/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── run │ │ ├── src/ │ │ │ ├── mallib/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ ├── core.fan │ │ │ │ ├── env.fan │ │ │ │ ├── interop.fan │ │ │ │ ├── reader.fan │ │ │ │ └── types.fan │ │ │ ├── step0_repl/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step1_read_print/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step2_eval/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step3_env/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step4_if_fn_do/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step5_tco/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step6_file/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step7_quote/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step8_macros/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ ├── step9_try/ │ │ │ │ ├── build.fan │ │ │ │ └── fan/ │ │ │ │ └── main.fan │ │ │ └── stepA_mal/ │ │ │ ├── build.fan │ │ │ └── fan/ │ │ │ └── main.fan │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── fennel/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.fnl │ │ ├── env.fnl │ │ ├── printer.fnl │ │ ├── reader.fnl │ │ ├── run │ │ ├── step0_repl.fnl │ │ ├── step1_read_print.fnl │ │ ├── step2_eval.fnl │ │ ├── step3_env.fnl │ │ ├── step4_if_fn_do.fnl │ │ ├── step5_tco.fnl │ │ ├── step6_file.fnl │ │ ├── step7_quote.fnl │ │ ├── step8_macros.fnl │ │ ├── step9_try.fnl │ │ ├── stepA_mal.fnl │ │ ├── types.fnl │ │ └── utils.fnl │ ├── forth/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.fs │ │ ├── env.fs │ │ ├── misc-tests.fs │ │ ├── printer.fs │ │ ├── reader.fs │ │ ├── run │ │ ├── step0_repl.fs │ │ ├── step1_read_print.fs │ │ ├── step2_eval.fs │ │ ├── step3_env.fs │ │ ├── step4_if_fn_do.fs │ │ ├── step5_tco.fs │ │ ├── step6_file.fs │ │ ├── step7_quote.fs │ │ ├── step8_macros.fs │ │ ├── step9_try.fs │ │ ├── stepA_mal.fs │ │ ├── str.fs │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.fs │ ├── fsharp/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.fs │ │ ├── env.fs │ │ ├── error.fs │ │ ├── node.fs │ │ ├── printer.fs │ │ ├── reader.fs │ │ ├── readline.fs │ │ ├── run │ │ ├── step0_repl.fs │ │ ├── step1_read_print.fs │ │ ├── step2_eval.fs │ │ ├── step3_env.fs │ │ ├── step4_if_fn_do.fs │ │ ├── step5_tco.fs │ │ ├── step6_file.fs │ │ ├── step7_quote.fs │ │ ├── step8_macros.fs │ │ ├── step9_try.fs │ │ ├── stepA_mal.fs │ │ ├── terminal.cs │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ ├── tokenizer.fs │ │ └── types.fs │ ├── gnu-smalltalk/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.st │ │ ├── env.st │ │ ├── func.st │ │ ├── printer.st │ │ ├── reader.st │ │ ├── readline.st │ │ ├── run │ │ ├── step0_repl.st │ │ ├── step1_read_print.st │ │ ├── step2_eval.st │ │ ├── step3_env.st │ │ ├── step4_if_fn_do.st │ │ ├── step5_tco.st │ │ ├── step6_file.st │ │ ├── step7_quote.st │ │ ├── step8_macros.st │ │ ├── step9_try.st │ │ ├── stepA_mal.st │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ ├── types.st │ │ └── util.st │ ├── go/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── go.mod │ │ ├── run │ │ ├── src/ │ │ │ ├── core/ │ │ │ │ └── core.go │ │ │ ├── env/ │ │ │ │ └── env.go │ │ │ ├── printer/ │ │ │ │ └── printer.go │ │ │ ├── reader/ │ │ │ │ └── reader.go │ │ │ ├── readline/ │ │ │ │ └── readline.go │ │ │ ├── step0_repl/ │ │ │ │ └── step0_repl.go │ │ │ ├── step1_read_print/ │ │ │ │ └── step1_read_print.go │ │ │ ├── step2_eval/ │ │ │ │ └── step2_eval.go │ │ │ ├── step3_env/ │ │ │ │ └── step3_env.go │ │ │ ├── step4_if_fn_do/ │ │ │ │ └── step4_if_fn_do.go │ │ │ ├── step5_tco/ │ │ │ │ └── step5_tco.go │ │ │ ├── step6_file/ │ │ │ │ └── step6_file.go │ │ │ ├── step7_quote/ │ │ │ │ └── step7_quote.go │ │ │ ├── step8_macros/ │ │ │ │ └── step8_macros.go │ │ │ ├── step9_try/ │ │ │ │ └── step9_try.go │ │ │ ├── stepA_mal/ │ │ │ │ └── stepA_mal.go │ │ │ └── types/ │ │ │ └── types.go │ │ └── tests/ │ │ ├── step2_eval.mal │ │ ├── step4_if_fn_do.mal │ │ └── step5_tco.mal │ ├── groovy/ │ │ ├── Dockerfile │ │ ├── GroovyWrapper.groovy │ │ ├── Makefile │ │ ├── core.groovy │ │ ├── env.groovy │ │ ├── printer.groovy │ │ ├── reader.groovy │ │ ├── run │ │ ├── step0_repl.groovy │ │ ├── step1_read_print.groovy │ │ ├── step2_eval.groovy │ │ ├── step3_env.groovy │ │ ├── step4_if_fn_do.groovy │ │ ├── step5_tco.groovy │ │ ├── step6_file.groovy │ │ ├── step7_quote.groovy │ │ ├── step8_macros.groovy │ │ ├── step9_try.groovy │ │ ├── stepA_mal.groovy │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.groovy │ ├── guile/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.scm │ │ ├── env.scm │ │ ├── pcre.scm │ │ ├── printer.scm │ │ ├── reader.scm │ │ ├── readline.scm │ │ ├── run │ │ ├── step0_repl.scm │ │ ├── step1_read_print.scm │ │ ├── step2_eval.scm │ │ ├── step3_env.scm │ │ ├── step4_if_fn_do.scm │ │ ├── step5_tco.scm │ │ ├── step6_file.scm │ │ ├── step7_quote.scm │ │ ├── step8_macros.scm │ │ ├── step9_try.scm │ │ ├── stepA_mal.scm │ │ └── types.scm │ ├── hare/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── makefile │ │ ├── mal/ │ │ │ ├── core.ha │ │ │ ├── env.ha │ │ │ ├── error.ha │ │ │ ├── gc.ha │ │ │ ├── hashmap.ha │ │ │ ├── printer.ha │ │ │ ├── reader.ha │ │ │ ├── tokenizer.ha │ │ │ └── types.ha │ │ ├── run │ │ ├── step0_repl.ha │ │ ├── step1_read_print.ha │ │ ├── step2_eval.ha │ │ ├── step3_env.ha │ │ ├── step4_if_fn_do.ha │ │ ├── step5_tco.ha │ │ ├── step6_file.ha │ │ ├── step7_quote.ha │ │ ├── step8_macros.ha │ │ ├── step9_try.ha │ │ └── stepA_mal.ha │ ├── haskell/ │ │ ├── Core.hs │ │ ├── Dockerfile │ │ ├── Env.hs │ │ ├── Makefile │ │ ├── Printer.hs │ │ ├── Reader.hs │ │ ├── Readline.hs │ │ ├── Types.hs │ │ ├── run │ │ ├── step0_repl.hs │ │ ├── step1_read_print.hs │ │ ├── step2_eval.hs │ │ ├── step3_env.hs │ │ ├── step4_if_fn_do.hs │ │ ├── step5_tco.hs │ │ ├── step6_file.hs │ │ ├── step7_quote.hs │ │ ├── step8_macros.hs │ │ ├── step9_try.hs │ │ ├── stepA_mal.hs │ │ └── tests/ │ │ └── step5_tco.mal │ ├── haxe/ │ │ ├── Compat.hx │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── Step0_repl.hx │ │ ├── Step1_read_print.hx │ │ ├── Step2_eval.hx │ │ ├── Step3_env.hx │ │ ├── Step4_if_fn_do.hx │ │ ├── Step5_tco.hx │ │ ├── Step6_file.hx │ │ ├── Step7_quote.hx │ │ ├── Step8_macros.hx │ │ ├── Step9_try.hx │ │ ├── StepA_mal.hx │ │ ├── core/ │ │ │ └── Core.hx │ │ ├── env/ │ │ │ └── Env.hx │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── printer/ │ │ │ └── Printer.hx │ │ ├── reader/ │ │ │ ├── BlankLine.hx │ │ │ └── Reader.hx │ │ ├── run │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types/ │ │ ├── MalException.hx │ │ └── Types.hx │ ├── hy/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.hy │ │ ├── env.hy │ │ ├── mal_types.hy │ │ ├── printer.hy │ │ ├── reader.hy │ │ ├── run │ │ ├── step0_repl.hy │ │ ├── step1_read_print.hy │ │ ├── step2_eval.hy │ │ ├── step3_env.hy │ │ ├── step4_if_fn_do.hy │ │ ├── step5_tco.hy │ │ ├── step6_file.hy │ │ ├── step7_quote.hy │ │ ├── step8_macros.hy │ │ ├── step9_try.hy │ │ ├── stepA_mal.hy │ │ └── tests/ │ │ └── step5_tco.mal │ ├── io/ │ │ ├── Dockerfile │ │ ├── Env.io │ │ ├── Makefile │ │ ├── MalCore.io │ │ ├── MalReader.io │ │ ├── MalReadline.io │ │ ├── MalTypes.io │ │ ├── run │ │ ├── step0_repl.io │ │ ├── step1_read_print.io │ │ ├── step2_eval.io │ │ ├── step3_env.io │ │ ├── step4_if_fn_do.io │ │ ├── step5_tco.io │ │ ├── step6_file.io │ │ ├── step7_quote.io │ │ ├── step8_macros.io │ │ ├── step9_try.io │ │ ├── stepA_mal.io │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── janet/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.janet │ │ ├── env.janet │ │ ├── printer.janet │ │ ├── reader.janet │ │ ├── run │ │ ├── step0_repl.janet │ │ ├── step1_read_print.janet │ │ ├── step2_eval.janet │ │ ├── step3_env.janet │ │ ├── step4_if_fn_do.janet │ │ ├── step5_tco.janet │ │ ├── step6_file.janet │ │ ├── step7_quote.janet │ │ ├── step8_macros.janet │ │ ├── step9_try.janet │ │ ├── stepA_mal.janet │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ ├── types.janet │ │ └── utils.janet │ ├── java/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── pom.xml │ │ ├── run │ │ ├── src/ │ │ │ └── main/ │ │ │ └── java/ │ │ │ └── mal/ │ │ │ ├── core.java │ │ │ ├── env.java │ │ │ ├── printer.java │ │ │ ├── reader.java │ │ │ ├── readline.java │ │ │ ├── step0_repl.java │ │ │ ├── step1_read_print.java │ │ │ ├── step2_eval.java │ │ │ ├── step3_env.java │ │ │ ├── step4_if_fn_do.java │ │ │ ├── step5_tco.java │ │ │ ├── step6_file.java │ │ │ ├── step7_quote.java │ │ │ ├── step8_macros.java │ │ │ ├── step9_try.java │ │ │ ├── stepA_mal.java │ │ │ └── types.java │ │ └── tests/ │ │ └── step5_tco.mal │ ├── java-truffle/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── build.gradle │ │ ├── make-native.sh │ │ ├── run │ │ ├── settings.gradle │ │ └── src/ │ │ └── main/ │ │ └── java/ │ │ └── truffle/ │ │ └── mal/ │ │ ├── Core.java │ │ ├── MalEnv.java │ │ ├── Printer.java │ │ ├── Reader.java │ │ ├── Types.java │ │ ├── step0_repl.java │ │ ├── step1_read_print.java │ │ ├── step2_eval.java │ │ ├── step3_env.java │ │ ├── step4_if_fn_do.java │ │ ├── step5_tco.java │ │ ├── step6_file.java │ │ ├── step7_quote.java │ │ ├── step8_macros.java │ │ ├── step9_try.java │ │ ├── stepA_mal.java │ │ ├── stepB_calls.java │ │ ├── stepC_slots.java │ │ ├── stepD_caching.java │ │ └── stepE_macros.java │ ├── jq/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.jq │ │ ├── docs/ │ │ │ └── impl-notes.md │ │ ├── env.jq │ │ ├── interp.jq │ │ ├── printer.jq │ │ ├── reader.jq │ │ ├── run │ │ ├── step0_repl.jq │ │ ├── step1_read_print.jq │ │ ├── step2_eval.jq │ │ ├── step3_env.jq │ │ ├── step4_if_fn_do.jq │ │ ├── step5_tco.jq │ │ ├── step6_file.jq │ │ ├── step7_quote.jq │ │ ├── step8_macros.jq │ │ ├── step9_try.jq │ │ ├── stepA_mal.jq │ │ └── utils.jq │ ├── js/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.js │ │ ├── env.js │ │ ├── interop.js │ │ ├── jq_readline.js │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── printer.js │ │ ├── reader.js │ │ ├── run │ │ ├── step0_repl.js │ │ ├── step1_read_print.js │ │ ├── step2_eval.js │ │ ├── step3_env.js │ │ ├── step4_if_fn_do.js │ │ ├── step5_tco.js │ │ ├── step6_file.js │ │ ├── step7_quote.js │ │ ├── step8_macros.js │ │ ├── step9_try.js │ │ ├── stepA_mal.js │ │ ├── tests/ │ │ │ ├── common.js │ │ │ ├── reader.js │ │ │ ├── step5_tco.mal │ │ │ ├── stepA_mal.mal │ │ │ └── types.js │ │ └── types.js │ ├── julia/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.jl │ │ ├── env.jl │ │ ├── printer.jl │ │ ├── reader.jl │ │ ├── readline_mod.jl │ │ ├── run │ │ ├── step0_repl.jl │ │ ├── step1_read_print.jl │ │ ├── step2_eval.jl │ │ ├── step3_env.jl │ │ ├── step4_if_fn_do.jl │ │ ├── step5_tco.jl │ │ ├── step6_file.jl │ │ ├── step7_quote.jl │ │ ├── step8_macros.jl │ │ ├── step9_try.jl │ │ ├── stepA_mal.jl │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.jl │ ├── kotlin/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── run │ │ ├── src/ │ │ │ └── mal/ │ │ │ ├── core.kt │ │ │ ├── env.kt │ │ │ ├── printer.kt │ │ │ ├── reader.kt │ │ │ ├── readline.kt │ │ │ ├── step0_repl.kt │ │ │ ├── step1_read_print.kt │ │ │ ├── step2_eval.kt │ │ │ ├── step3_env.kt │ │ │ ├── step4_if_fn_do.kt │ │ │ ├── step5_tco.kt │ │ │ ├── step6_file.kt │ │ │ ├── step7_quote.kt │ │ │ ├── step8_macros.kt │ │ │ ├── step9_try.kt │ │ │ ├── stepA_mal.kt │ │ │ └── types.kt │ │ └── tests/ │ │ └── step5_tco.mal │ ├── latex3/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.sty │ │ ├── env.sty │ │ ├── printer.sty │ │ ├── reader.sty │ │ ├── run │ │ ├── step0_repl.tex │ │ ├── step1_read_print.tex │ │ ├── step2_eval.tex │ │ ├── step3_env.tex │ │ ├── step4_if_fn_do.tex │ │ ├── step6_file.tex │ │ ├── step7_quote.tex │ │ ├── step8_macros.tex │ │ ├── step9_try.tex │ │ ├── stepA_mal.tex │ │ └── types.sty │ ├── lib/ │ │ ├── README.md │ │ ├── alias-hacks.mal │ │ ├── benchmark.mal │ │ ├── equality.mal │ │ ├── load-file-once.mal │ │ ├── memoize.mal │ │ ├── perf.mal │ │ ├── pprint.mal │ │ ├── protocols.mal │ │ ├── reducers.mal │ │ ├── test_cascade.mal │ │ ├── threading.mal │ │ └── trivial.mal │ ├── livescript/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.ls │ │ ├── env.ls │ │ ├── error.ls │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── printer.ls │ │ ├── reader.ls │ │ ├── run │ │ ├── step0_repl.ls │ │ ├── step1_read_print.ls │ │ ├── step2_eval.ls │ │ ├── step3_env.ls │ │ ├── step4_if_fn_do.ls │ │ ├── step5_tco.ls │ │ ├── step6_file.ls │ │ ├── step7_quote.ls │ │ ├── step8_macros.ls │ │ ├── step9_try.ls │ │ ├── stepA_mal.ls │ │ └── utils.ls │ ├── logo/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.lg │ │ ├── env.lg │ │ ├── examples/ │ │ │ └── tree.mal │ │ ├── printer.lg │ │ ├── reader.lg │ │ ├── readline.lg │ │ ├── run │ │ ├── step0_repl.lg │ │ ├── step1_read_print.lg │ │ ├── step2_eval.lg │ │ ├── step3_env.lg │ │ ├── step4_if_fn_do.lg │ │ ├── step5_tco.lg │ │ ├── step6_file.lg │ │ ├── step7_quote.lg │ │ ├── step8_macros.lg │ │ ├── step9_try.lg │ │ ├── stepA_mal.lg │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ └── types.lg │ ├── lua/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.lua │ │ ├── env.lua │ │ ├── printer.lua │ │ ├── reader.lua │ │ ├── readline.lua │ │ ├── run │ │ ├── step0_repl.lua │ │ ├── step1_read_print.lua │ │ ├── step2_eval.lua │ │ ├── step3_env.lua │ │ ├── step4_if_fn_do.lua │ │ ├── step5_tco.lua │ │ ├── step6_file.lua │ │ ├── step7_quote.lua │ │ ├── step8_macros.lua │ │ ├── step9_try.lua │ │ ├── stepA_mal.lua │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ ├── types.lua │ │ └── utils.lua │ ├── make/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README │ │ ├── core.mk │ │ ├── env.mk │ │ ├── gmsl.mk │ │ ├── numbers.mk │ │ ├── printer.mk │ │ ├── reader.mk │ │ ├── readline.mk │ │ ├── rules.mk │ │ ├── run │ │ ├── step0_repl.mk │ │ ├── step1_read_print.mk │ │ ├── step2_eval.mk │ │ ├── step3_env.mk │ │ ├── step4_if_fn_do.mk │ │ ├── step6_file.mk │ │ ├── step7_quote.mk │ │ ├── step8_macros.mk │ │ ├── step9_try.mk │ │ ├── stepA_mal.mk │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ ├── types.mk │ │ └── util.mk │ ├── matlab/ │ │ ├── +types/ │ │ │ ├── Atom.m │ │ │ ├── Function.m │ │ │ ├── HashMap.m │ │ │ ├── List.m │ │ │ ├── MalException.m │ │ │ ├── Nil.m │ │ │ ├── Reader.m │ │ │ ├── Symbol.m │ │ │ └── Vector.m │ │ ├── .dockerignore │ │ ├── Dict.m │ │ ├── Dockerfile │ │ ├── Env.m │ │ ├── Makefile │ │ ├── core.m │ │ ├── printer.m │ │ ├── reader.m │ │ ├── run │ │ ├── step0_repl.m │ │ ├── step1_read_print.m │ │ ├── step2_eval.m │ │ ├── step3_env.m │ │ ├── step4_if_fn_do.m │ │ ├── step5_tco.m │ │ ├── step6_file.m │ │ ├── step7_quote.m │ │ ├── step8_macros.m │ │ ├── step9_try.m │ │ ├── stepA_mal.m │ │ └── type_utils.m │ ├── miniMAL/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.json │ │ ├── env.json │ │ ├── miniMAL-core.json │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── printer.json │ │ ├── reader.json │ │ ├── run │ │ ├── step0_repl.json │ │ ├── step1_read_print.json │ │ ├── step2_eval.json │ │ ├── step3_env.json │ │ ├── step4_if_fn_do.json │ │ ├── step5_tco.json │ │ ├── step6_file.json │ │ ├── step7_quote.json │ │ ├── step8_macros.json │ │ ├── step9_try.json │ │ ├── stepA_mal.json │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.json │ ├── nasm/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.asm │ │ ├── env.asm │ │ ├── exceptions.asm │ │ ├── macros.mac │ │ ├── printer.asm │ │ ├── reader.asm │ │ ├── run │ │ ├── step0_repl.asm │ │ ├── step1_read_print.asm │ │ ├── step2_eval.asm │ │ ├── step3_env.asm │ │ ├── step4_if_fn_do.asm │ │ ├── step5_tco.asm │ │ ├── step6_file.asm │ │ ├── step7_quote.asm │ │ ├── step8_macros.asm │ │ ├── step9_try.asm │ │ ├── stepA_mal.asm │ │ ├── system.asm │ │ └── types.asm │ ├── nim/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.nim │ │ ├── env.nim │ │ ├── mal.nimble │ │ ├── nim.cfg │ │ ├── printer.nim │ │ ├── reader.nim │ │ ├── run │ │ ├── step0_repl.nim │ │ ├── step1_read_print.nim │ │ ├── step2_eval.nim │ │ ├── step3_env.nim │ │ ├── step4_if_fn_do.nim │ │ ├── step5_tco.nim │ │ ├── step6_file.nim │ │ ├── step7_quote.nim │ │ ├── step8_macros.nim │ │ ├── step9_try.nim │ │ ├── stepA_mal.nim │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.nim │ ├── objc/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.h │ │ ├── core.m │ │ ├── env.h │ │ ├── env.m │ │ ├── mal_readline.c │ │ ├── mal_readline.h │ │ ├── malfunc.h │ │ ├── malfunc.m │ │ ├── printer.h │ │ ├── printer.m │ │ ├── reader.h │ │ ├── reader.m │ │ ├── run │ │ ├── step0_repl.m │ │ ├── step1_read_print.m │ │ ├── step2_eval.m │ │ ├── step3_env.m │ │ ├── step4_if_fn_do.m │ │ ├── step5_tco.m │ │ ├── step6_file.m │ │ ├── step7_quote.m │ │ ├── step8_macros.m │ │ ├── step9_try.m │ │ ├── stepA_mal.m │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ ├── types.h │ │ └── types.m │ ├── objpascal/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.pas │ │ ├── mal_env.pas │ │ ├── mal_func.pas │ │ ├── mal_readline.pas │ │ ├── mal_types.pas │ │ ├── printer.pas │ │ ├── reader.pas │ │ ├── regexpr/ │ │ │ └── Source/ │ │ │ └── RegExpr.pas │ │ ├── run │ │ ├── step0_repl.pas │ │ ├── step1_read_print.pas │ │ ├── step2_eval.pas │ │ ├── step3_env.pas │ │ ├── step4_if_fn_do.pas │ │ ├── step5_tco.pas │ │ ├── step6_file.pas │ │ ├── step7_quote.pas │ │ ├── step8_macros.pas │ │ ├── step9_try.pas │ │ ├── stepA_mal.pas │ │ └── tests/ │ │ └── step5_tco.mal │ ├── ocaml/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.ml │ │ ├── env.ml │ │ ├── printer.ml │ │ ├── reader.ml │ │ ├── run │ │ ├── step0_repl.ml │ │ ├── step1_read_print.ml │ │ ├── step2_eval.ml │ │ ├── step3_env.ml │ │ ├── step4_if_fn_do.ml │ │ ├── step6_file.ml │ │ ├── step7_quote.ml │ │ ├── step8_macros.ml │ │ ├── step9_try.ml │ │ ├── stepA_mal.ml │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.ml │ ├── perl/ │ │ ├── Core.pm │ │ ├── Dockerfile │ │ ├── Env.pm │ │ ├── Interop.pm │ │ ├── Makefile │ │ ├── Printer.pm │ │ ├── README.md │ │ ├── Reader.pm │ │ ├── Readline.pm │ │ ├── Types.pm │ │ ├── run │ │ ├── step0_repl.pl │ │ ├── step1_read_print.pl │ │ ├── step2_eval.pl │ │ ├── step3_env.pl │ │ ├── step4_if_fn_do.pl │ │ ├── step5_tco.pl │ │ ├── step6_file.pl │ │ ├── step7_quote.pl │ │ ├── step8_macros.pl │ │ ├── step9_try.pl │ │ ├── stepA_mal.pl │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── perl6/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.pm │ │ ├── env.pm │ │ ├── printer.pm │ │ ├── reader.pm │ │ ├── run │ │ ├── step0_repl.pl │ │ ├── step1_read_print.pl │ │ ├── step2_eval.pl │ │ ├── step3_env.pl │ │ ├── step4_if_fn_do.pl │ │ ├── step5_tco.pl │ │ ├── step6_file.pl │ │ ├── step7_quote.pl │ │ ├── step8_macros.pl │ │ ├── step9_try.pl │ │ ├── stepA_mal.pl │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ └── types.pm │ ├── php/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.php │ │ ├── env.php │ │ ├── interop.php │ │ ├── printer.php │ │ ├── reader.php │ │ ├── readline.php │ │ ├── run │ │ ├── step0_repl.php │ │ ├── step1_read_print.php │ │ ├── step2_eval.php │ │ ├── step3_env.php │ │ ├── step4_if_fn_do.php │ │ ├── step5_tco.php │ │ ├── step6_file.php │ │ ├── step7_quote.php │ │ ├── step8_macros.php │ │ ├── step9_try.php │ │ ├── stepA_mal.php │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ ├── types.php │ │ └── webrunner.php │ ├── picolisp/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.l │ │ ├── env.l │ │ ├── func.l │ │ ├── printer.l │ │ ├── reader.l │ │ ├── readline.l │ │ ├── run │ │ ├── step0_repl.l │ │ ├── step1_read_print.l │ │ ├── step2_eval.l │ │ ├── step3_env.l │ │ ├── step4_if_fn_do.l │ │ ├── step5_tco.l │ │ ├── step6_file.l │ │ ├── step7_quote.l │ │ ├── step8_macros.l │ │ ├── step9_try.l │ │ ├── stepA_mal.l │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.l │ ├── pike/ │ │ ├── Core.pmod │ │ ├── Dockerfile │ │ ├── Env.pmod │ │ ├── Interop.pmod │ │ ├── Makefile │ │ ├── Printer.pmod │ │ ├── Reader.pmod │ │ ├── Readline.pmod │ │ ├── Types.pmod │ │ ├── run │ │ ├── step0_repl.pike │ │ ├── step1_read_print.pike │ │ ├── step2_eval.pike │ │ ├── step3_env.pike │ │ ├── step4_if_fn_do.pike │ │ ├── step5_tco.pike │ │ ├── step6_file.pike │ │ ├── step7_quote.pike │ │ ├── step8_macros.pike │ │ ├── step9_try.pike │ │ ├── stepA_mal.pike │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── plpgsql/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.sql │ │ ├── entrypoint.sh │ │ ├── envs.sql │ │ ├── init.sql │ │ ├── io.sql │ │ ├── printer.sql │ │ ├── reader.sql │ │ ├── run │ │ ├── step0_repl.sql │ │ ├── step1_read_print.sql │ │ ├── step2_eval.sql │ │ ├── step3_env.sql │ │ ├── step4_if_fn_do.sql │ │ ├── step5_tco.sql │ │ ├── step6_file.sql │ │ ├── step7_quote.sql │ │ ├── step8_macros.sql │ │ ├── step9_try.sql │ │ ├── stepA_mal.sql │ │ ├── types.sql │ │ └── wrap.sh │ ├── plsql/ │ │ ├── Dockerfile │ │ ├── Dockerfile-oracle │ │ ├── Dockerfile-postgres │ │ ├── Makefile │ │ ├── core.sql │ │ ├── entrypoint.sh │ │ ├── env.sql │ │ ├── io.sql │ │ ├── login.sql │ │ ├── printer.sql │ │ ├── reader.sql │ │ ├── run │ │ ├── step0_repl.sql │ │ ├── step1_read_print.sql │ │ ├── step2_eval.sql │ │ ├── step3_env.sql │ │ ├── step4_if_fn_do.sql │ │ ├── step5_tco.sql │ │ ├── step6_file.sql │ │ ├── step7_quote.sql │ │ ├── step8_macros.sql │ │ ├── step9_try.sql │ │ ├── stepA_mal.sql │ │ ├── types.sql │ │ └── wrap.sh │ ├── powershell/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.psm1 │ │ ├── env.psm1 │ │ ├── printer.psm1 │ │ ├── reader.psm1 │ │ ├── run │ │ ├── step0_repl.ps1 │ │ ├── step1_read_print.ps1 │ │ ├── step2_eval.ps1 │ │ ├── step3_env.ps1 │ │ ├── step4_if_fn_do.ps1 │ │ ├── step5_tco.ps1 │ │ ├── step6_file.ps1 │ │ ├── step7_quote.ps1 │ │ ├── step8_macros.ps1 │ │ ├── step9_try.ps1 │ │ ├── stepA_mal.ps1 │ │ └── types.psm1 │ ├── prolog/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.pl │ │ ├── env.pl │ │ ├── printer.pl │ │ ├── reader.pl │ │ ├── run │ │ ├── step0_repl.pl │ │ ├── step1_read_print.pl │ │ ├── step2_eval.pl │ │ ├── step3_env.pl │ │ ├── step4_if_fn_do.pl │ │ ├── step6_file.pl │ │ ├── step7_quote.pl │ │ ├── step8_macros.pl │ │ ├── step9_try.pl │ │ ├── stepA_mal.pl │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ ├── types.pl │ │ └── utils.pl │ ├── ps/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.ps │ │ ├── env.ps │ │ ├── interop.ps │ │ ├── printer.ps │ │ ├── reader.ps │ │ ├── run │ │ ├── step0_repl.ps │ │ ├── step1_read_print.ps │ │ ├── step2_eval.ps │ │ ├── step3_env.ps │ │ ├── step4_if_fn_do.ps │ │ ├── step5_tco.ps │ │ ├── step6_file.ps │ │ ├── step7_quote.ps │ │ ├── step8_macros.ps │ │ ├── step9_try.ps │ │ ├── stepA_mal.ps │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.ps │ ├── purs/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── package.json │ │ ├── packages.dhall │ │ ├── run │ │ ├── spago.dhall │ │ └── src/ │ │ ├── Core.purs │ │ ├── Env.purs │ │ ├── Printer.purs │ │ ├── Reader.purs │ │ ├── Readline.js │ │ ├── Readline.purs │ │ ├── Types.purs │ │ ├── step0_repl.purs │ │ ├── step1_read_print.purs │ │ ├── step2_eval.purs │ │ ├── step3_env.purs │ │ ├── step4_if_fn_do.purs │ │ ├── step5_tco.purs │ │ ├── step6_file.purs │ │ ├── step7_quote.purs │ │ ├── step8_macros.purs │ │ ├── step9_try.purs │ │ └── stepA_mal.purs │ ├── python2/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.py │ │ ├── env.py │ │ ├── mal_readline.py │ │ ├── mal_types.py │ │ ├── printer.py │ │ ├── reader.py │ │ ├── run │ │ ├── step0_repl.py │ │ ├── step1_read_print.py │ │ ├── step2_eval.py │ │ ├── step3_env.py │ │ ├── step4_if_fn_do.py │ │ ├── step5_tco.py │ │ ├── step6_file.py │ │ ├── step7_quote.py │ │ ├── step8_macros.py │ │ ├── step9_try.py │ │ ├── stepA_mal.py │ │ └── tests/ │ │ ├── step5_tco.mal │ │ └── stepA_mal.mal │ ├── python3/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.py │ │ ├── env.py │ │ ├── mal_readline.py │ │ ├── mal_types.py │ │ ├── reader.py │ │ ├── run │ │ ├── step0_repl.py │ │ ├── step1_read_print.py │ │ ├── step2_eval.py │ │ ├── step3_env.py │ │ ├── step4_if_fn_do.py │ │ ├── step5_tco.py │ │ ├── step6_file.py │ │ ├── step7_quote.py │ │ ├── step8_macros.py │ │ ├── step9_try.py │ │ ├── stepA_mal.py │ │ └── tests/ │ │ ├── __init__.py │ │ ├── step5_tco.mal │ │ ├── stepA_mal.mal │ │ ├── test_step2.py │ │ ├── test_step3.py │ │ ├── test_step4.py │ │ ├── test_step5.py │ │ ├── test_step6.py │ │ ├── test_step7.py │ │ ├── test_step8.py │ │ ├── test_step9.py │ │ └── test_stepA.py │ ├── r/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.r │ │ ├── env.r │ │ ├── printer.r │ │ ├── reader.r │ │ ├── readline.r │ │ ├── run │ │ ├── step0_repl.r │ │ ├── step1_read_print.r │ │ ├── step2_eval.r │ │ ├── step3_env.r │ │ ├── step4_if_fn_do.r │ │ ├── step5_tco.r │ │ ├── step6_file.r │ │ ├── step7_quote.r │ │ ├── step8_macros.r │ │ ├── step9_try.r │ │ ├── stepA_mal.r │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.r │ ├── racket/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.rkt │ │ ├── env.rkt │ │ ├── printer.rkt │ │ ├── reader.rkt │ │ ├── readline.rkt │ │ ├── run │ │ ├── step0_repl.rkt │ │ ├── step1_read_print.rkt │ │ ├── step2_eval.rkt │ │ ├── step3_env.rkt │ │ ├── step4_if_fn_do.rkt │ │ ├── step5_tco.rkt │ │ ├── step6_file.rkt │ │ ├── step7_quote.rkt │ │ ├── step8_macros.rkt │ │ ├── step9_try.rkt │ │ ├── stepA_mal.rkt │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.rkt │ ├── rexx/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.rexx │ │ ├── env.rexx │ │ ├── printer.rexx │ │ ├── reader.rexx │ │ ├── readline.rexx │ │ ├── run │ │ ├── step0_repl.rexx │ │ ├── step1_read_print.rexx │ │ ├── step2_eval.rexx │ │ ├── step3_env.rexx │ │ ├── step4_if_fn_do.rexx │ │ ├── step5_tco.rexx │ │ ├── step6_file.rexx │ │ ├── step7_quote.rexx │ │ ├── step8_macros.rexx │ │ ├── step9_try.rexx │ │ ├── stepA_mal.rexx │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.rexx │ ├── rpython/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.py │ │ ├── env.py │ │ ├── mal_readline.py │ │ ├── mal_types.py │ │ ├── printer.py │ │ ├── reader.py │ │ ├── run │ │ ├── step0_repl.py │ │ ├── step1_read_print.py │ │ ├── step2_eval.py │ │ ├── step3_env.py │ │ ├── step4_if_fn_do.py │ │ ├── step5_tco.py │ │ ├── step6_file.py │ │ ├── step7_quote.py │ │ ├── step8_macros.py │ │ ├── step9_try.py │ │ ├── stepA_mal.py │ │ └── tests/ │ │ └── step5_tco.mal │ ├── ruby/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.rb │ │ ├── env.rb │ │ ├── mal_readline.rb │ │ ├── printer.rb │ │ ├── reader.rb │ │ ├── run │ │ ├── step0_repl.rb │ │ ├── step1_read_print.rb │ │ ├── step2_eval.rb │ │ ├── step3_env.rb │ │ ├── step4_if_fn_do.rb │ │ ├── step5_tco.rb │ │ ├── step6_file.rb │ │ ├── step7_quote.rb │ │ ├── step8_macros.rb │ │ ├── step9_try.rb │ │ ├── stepA_mal.rb │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.rb │ ├── ruby.2/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.rb │ │ ├── env.rb │ │ ├── errors.rb │ │ ├── printer.rb │ │ ├── reader.rb │ │ ├── run │ │ ├── step0_repl.rb │ │ ├── step1_read_print.rb │ │ ├── step2_eval.rb │ │ ├── step3_env.rb │ │ ├── step4_if_fn_do.rb │ │ ├── step5_tco.rb │ │ ├── step6_file.rb │ │ ├── step7_quote.rb │ │ ├── step8_macros.rb │ │ ├── step9_try.rb │ │ ├── stepA_mal.rb │ │ └── types.rb │ ├── rust/ │ │ ├── .gitignore │ │ ├── Cargo.toml │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.rs │ │ ├── env.rs │ │ ├── printer.rs │ │ ├── reader.rs │ │ ├── readline.rs │ │ ├── run │ │ ├── step0_repl.rs │ │ ├── step1_read_print.rs │ │ ├── step2_eval.rs │ │ ├── step3_env.rs │ │ ├── step4_if_fn_do.rs │ │ ├── step5_tco.rs │ │ ├── step6_file.rs │ │ ├── step7_quote.rs │ │ ├── step8_macros.rs │ │ ├── step9_try.rs │ │ ├── stepA_mal.rs │ │ └── types.rs │ ├── scala/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── assembly.sbt │ │ ├── build.sbt │ │ ├── core.scala │ │ ├── env.scala │ │ ├── printer.scala │ │ ├── project/ │ │ │ └── assembly.sbt │ │ ├── reader.scala │ │ ├── run │ │ ├── step0_repl.scala │ │ ├── step1_read_print.scala │ │ ├── step2_eval.scala │ │ ├── step3_env.scala │ │ ├── step4_if_fn_do.scala │ │ ├── step5_tco.scala │ │ ├── step6_file.scala │ │ ├── step7_quote.scala │ │ ├── step8_macros.scala │ │ ├── step9_try.scala │ │ ├── stepA_mal.scala │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.scala │ ├── scheme/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── lib/ │ │ │ ├── core.sld │ │ │ ├── env.sld │ │ │ ├── printer.sld │ │ │ ├── reader.sld │ │ │ ├── types.sld │ │ │ └── util.sld │ │ ├── run │ │ ├── step0_repl.scm │ │ ├── step1_read_print.scm │ │ ├── step2_eval.scm │ │ ├── step3_env.scm │ │ ├── step4_if_fn_do.scm │ │ ├── step5_tco.scm │ │ ├── step6_file.scm │ │ ├── step7_quote.scm │ │ ├── step8_macros.scm │ │ ├── step9_try.scm │ │ ├── stepA_mal.scm │ │ └── tests/ │ │ └── stepA_mal.mal │ ├── skew/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.sk │ │ ├── env.sk │ │ ├── printer.sk │ │ ├── reader.sk │ │ ├── run │ │ ├── step0_repl.sk │ │ ├── step1_read_print.sk │ │ ├── step2_eval.sk │ │ ├── step3_env.sk │ │ ├── step4_if_fn_do.sk │ │ ├── step5_tco.sk │ │ ├── step6_file.sk │ │ ├── step7_quote.sk │ │ ├── step8_macros.sk │ │ ├── step9_try.sk │ │ ├── stepA_mal.sk │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ ├── types.sk │ │ └── util.sk │ ├── sml/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── LargeInt.sml │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.sml │ │ ├── env.sml │ │ ├── main.sml │ │ ├── printer.sml │ │ ├── reader.sml │ │ ├── run │ │ ├── step0_repl.mlb │ │ ├── step0_repl.sml │ │ ├── step1_read_print.mlb │ │ ├── step1_read_print.sml │ │ ├── step2_eval.mlb │ │ ├── step2_eval.sml │ │ ├── step3_env.mlb │ │ ├── step3_env.sml │ │ ├── step4_if_fn_do.mlb │ │ ├── step4_if_fn_do.sml │ │ ├── step6_file.mlb │ │ ├── step6_file.sml │ │ ├── step7_quote.mlb │ │ ├── step7_quote.sml │ │ ├── step8_macros.mlb │ │ ├── step8_macros.sml │ │ ├── step9_try.mlb │ │ ├── step9_try.sml │ │ ├── stepA_mal.mlb │ │ ├── stepA_mal.sml │ │ ├── types.sml │ │ └── util.sml │ ├── swift3/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── Sources/ │ │ │ ├── core.swift │ │ │ ├── env.swift │ │ │ ├── printer.swift │ │ │ ├── reader.swift │ │ │ ├── step0_repl/ │ │ │ │ └── main.swift │ │ │ ├── step1_read_print/ │ │ │ │ └── main.swift │ │ │ ├── step2_eval/ │ │ │ │ └── main.swift │ │ │ ├── step3_env/ │ │ │ │ └── main.swift │ │ │ ├── step4_if_fn_do/ │ │ │ │ └── main.swift │ │ │ ├── step5_tco/ │ │ │ │ └── main.swift │ │ │ ├── step6_file/ │ │ │ │ └── main.swift │ │ │ ├── step7_quote/ │ │ │ │ └── main.swift │ │ │ ├── step8_macros/ │ │ │ │ └── main.swift │ │ │ ├── step9_try/ │ │ │ │ └── main.swift │ │ │ ├── stepA_mal/ │ │ │ │ └── main.swift │ │ │ └── types.swift │ │ ├── run │ │ └── tests/ │ │ └── step5_tco.mal │ ├── swift4/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── Sources/ │ │ │ ├── core.swift │ │ │ ├── env.swift │ │ │ ├── printer.swift │ │ │ ├── reader.swift │ │ │ ├── step0_repl/ │ │ │ │ └── main.swift │ │ │ ├── step1_read_print/ │ │ │ │ └── main.swift │ │ │ ├── step2_eval/ │ │ │ │ └── main.swift │ │ │ ├── step3_env/ │ │ │ │ └── main.swift │ │ │ ├── step4_if_fn_do/ │ │ │ │ └── main.swift │ │ │ ├── step5_tco/ │ │ │ │ └── main.swift │ │ │ ├── step6_file/ │ │ │ │ └── main.swift │ │ │ ├── step7_quote/ │ │ │ │ └── main.swift │ │ │ ├── step8_macros/ │ │ │ │ └── main.swift │ │ │ ├── step9_try/ │ │ │ │ └── main.swift │ │ │ ├── stepA_mal/ │ │ │ │ └── main.swift │ │ │ └── types.swift │ │ └── run │ ├── swift6/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── Package.swift │ │ ├── Sources/ │ │ │ ├── core/ │ │ │ │ ├── Core.swift │ │ │ │ ├── Env.swift │ │ │ │ ├── Errors.swift │ │ │ │ ├── Parser.swift │ │ │ │ ├── Printer.swift │ │ │ │ ├── Reader.swift │ │ │ │ ├── Types.swift │ │ │ │ └── Utils.swift │ │ │ ├── step0_repl/ │ │ │ │ └── main.swift │ │ │ ├── step1_read_print/ │ │ │ │ └── main.swift │ │ │ ├── step2_eval/ │ │ │ │ └── main.swift │ │ │ ├── step3_env/ │ │ │ │ └── main.swift │ │ │ ├── step4_if_fn_do/ │ │ │ │ └── main.swift │ │ │ ├── step5_tco/ │ │ │ │ └── main.swift │ │ │ ├── step6_file/ │ │ │ │ └── main.swift │ │ │ ├── step7_quote/ │ │ │ │ └── main.swift │ │ │ ├── step8_macros/ │ │ │ │ └── main.swift │ │ │ ├── step9_try/ │ │ │ │ └── main.swift │ │ │ └── stepA_mal/ │ │ │ └── main.swift │ │ └── run │ ├── tcl/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.tcl │ │ ├── env.tcl │ │ ├── mal_readline.tcl │ │ ├── printer.tcl │ │ ├── reader.tcl │ │ ├── run │ │ ├── step0_repl.tcl │ │ ├── step1_read_print.tcl │ │ ├── step2_eval.tcl │ │ ├── step3_env.tcl │ │ ├── step4_if_fn_do.tcl │ │ ├── step5_tco.tcl │ │ ├── step6_file.tcl │ │ ├── step7_quote.tcl │ │ ├── step8_macros.tcl │ │ ├── step9_try.tcl │ │ ├── stepA_mal.tcl │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ └── types.tcl │ ├── tests/ │ │ ├── busywork.mal │ │ ├── computations.mal │ │ ├── docker/ │ │ │ └── Dockerfile │ │ ├── docker-build.sh │ │ ├── docker-run.sh │ │ ├── fib.mal │ │ ├── inc.mal │ │ ├── incA.mal │ │ ├── incB.mal │ │ ├── incC.mal │ │ ├── lib/ │ │ │ ├── alias-hacks.mal │ │ │ ├── equality.mal │ │ │ ├── load-file-once-inc.mal │ │ │ ├── load-file-once.mal │ │ │ ├── memoize.mal │ │ │ ├── pprint.mal │ │ │ ├── protocols.mal │ │ │ ├── reducers.mal │ │ │ ├── test_cascade.mal │ │ │ ├── threading.mal │ │ │ └── trivial.mal │ │ ├── perf1.mal │ │ ├── perf2.mal │ │ ├── perf3.mal │ │ ├── print_argv.mal │ │ ├── run_argv_test.sh │ │ ├── step0_repl.mal │ │ ├── step1_read_print.mal │ │ ├── step2_eval.mal │ │ ├── step3_env.mal │ │ ├── step4_if_fn_do.mal │ │ ├── step5_tco.mal │ │ ├── step6_file.mal │ │ ├── step7_quote.mal │ │ ├── step8_macros.mal │ │ ├── step9_try.mal │ │ ├── stepA_mal.mal │ │ ├── test.txt │ │ └── travis_trigger.sh │ ├── ts/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.ts │ │ ├── env.ts │ │ ├── node_readline.ts │ │ ├── package.json │ │ ├── printer.ts │ │ ├── reader.ts │ │ ├── run │ │ ├── step0_repl.ts │ │ ├── step1_read_print.ts │ │ ├── step2_eval.ts │ │ ├── step3_env.ts │ │ ├── step4_if_fn_do.ts │ │ ├── step5_tco.ts │ │ ├── step6_file.ts │ │ ├── step7_quote.ts │ │ ├── step8_macros.ts │ │ ├── step9_try.ts │ │ ├── stepA_mal.ts │ │ ├── tsconfig.json │ │ └── types.ts │ ├── vala/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.vala │ │ ├── env.vala │ │ ├── gc.vala │ │ ├── printer.vala │ │ ├── reader.vala │ │ ├── run │ │ ├── step0_repl.vala │ │ ├── step1_read_print.vala │ │ ├── step2_eval.vala │ │ ├── step3_env.vala │ │ ├── step4_if_fn_do.vala │ │ ├── step5_tco.vala │ │ ├── step6_file.vala │ │ ├── step7_quote.vala │ │ ├── step8_macros.vala │ │ ├── step9_try.vala │ │ ├── stepA_mal.vala │ │ └── types.vala │ ├── vb/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.vb │ │ ├── env.vb │ │ ├── getline.cs │ │ ├── printer.vb │ │ ├── reader.vb │ │ ├── readline.vb │ │ ├── run │ │ ├── step0_repl.vb │ │ ├── step1_read_print.vb │ │ ├── step2_eval.vb │ │ ├── step3_env.vb │ │ ├── step4_if_fn_do.vb │ │ ├── step5_tco.vb │ │ ├── step6_file.vb │ │ ├── step7_quote.vb │ │ ├── step8_macros.vb │ │ ├── step9_try.vb │ │ ├── stepA_mal.vb │ │ ├── tests/ │ │ │ └── step5_tco.mal │ │ └── types.vb │ ├── vbs/ │ │ ├── Makefile │ │ ├── core.vbs │ │ ├── env.vbs │ │ ├── install.vbs │ │ ├── io.vbs │ │ ├── printer.vbs │ │ ├── reader.vbs │ │ ├── run │ │ ├── step0_repl.vbs │ │ ├── step1_read_print.vbs │ │ ├── step2_eval.vbs │ │ ├── step3_env.vbs │ │ ├── step4_if_fn_do.vbs │ │ ├── step5_tco.vbs │ │ ├── step6_file.vbs │ │ ├── step7_quote.vbs │ │ ├── step8_macros.vbs │ │ ├── step9_try.vbs │ │ ├── stepA_mal.vbs │ │ ├── tests/ │ │ │ ├── step4_if_fn_do.mal │ │ │ └── step9_try.mal │ │ └── types.vbs │ ├── vhdl/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.vhdl │ │ ├── env.vhdl │ │ ├── pkg_readline.vhdl │ │ ├── printer.vhdl │ │ ├── reader.vhdl │ │ ├── run │ │ ├── run_vhdl.sh │ │ ├── step0_repl.vhdl │ │ ├── step1_read_print.vhdl │ │ ├── step2_eval.vhdl │ │ ├── step3_env.vhdl │ │ ├── step4_if_fn_do.vhdl │ │ ├── step5_tco.vhdl │ │ ├── step6_file.vhdl │ │ ├── step7_quote.vhdl │ │ ├── step8_macros.vhdl │ │ ├── step9_try.vhdl │ │ ├── stepA_mal.vhdl │ │ └── types.vhdl │ ├── vimscript/ │ │ ├── .gitignore │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.vim │ │ ├── env.vim │ │ ├── printer.vim │ │ ├── reader.vim │ │ ├── readline.vim │ │ ├── run │ │ ├── run_vimscript.sh │ │ ├── step0_repl.vim │ │ ├── step1_read_print.vim │ │ ├── step2_eval.vim │ │ ├── step3_env.vim │ │ ├── step4_if_fn_do.vim │ │ ├── step5_tco.vim │ │ ├── step6_file.vim │ │ ├── step7_quote.vim │ │ ├── step8_macros.vim │ │ ├── step9_try.vim │ │ ├── stepA_mal.vim │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ ├── types.vim │ │ └── vimextras.c │ ├── wasm/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.wam │ │ ├── debug.wam │ │ ├── env.wam │ │ ├── mem.wam │ │ ├── node_readline.js │ │ ├── package.json │ │ ├── platform_direct.wam │ │ ├── platform_libc.wam │ │ ├── platform_wasi.wam │ │ ├── printer.wam │ │ ├── printf.wam │ │ ├── reader.wam │ │ ├── run │ │ ├── run.js │ │ ├── step0_repl.wam │ │ ├── step1_read_print.wam │ │ ├── step2_eval.wam │ │ ├── step3_env.wam │ │ ├── step4_if_fn_do.wam │ │ ├── step5_tco.wam │ │ ├── step6_file.wam │ │ ├── step7_quote.wam │ │ ├── step8_macros.wam │ │ ├── step9_try.wam │ │ ├── stepA_mal.wam │ │ ├── string.wam │ │ └── types.wam │ ├── wren/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── README.md │ │ ├── core.wren │ │ ├── env.wren │ │ ├── interop.wren │ │ ├── printer.wren │ │ ├── reader.wren │ │ ├── readline.wren │ │ ├── run │ │ ├── step0_repl.wren │ │ ├── step1_read_print.wren │ │ ├── step2_eval.wren │ │ ├── step3_env.wren │ │ ├── step4_if_fn_do.wren │ │ ├── step5_tco.wren │ │ ├── step6_file.wren │ │ ├── step7_quote.wren │ │ ├── step8_macros.wren │ │ ├── step9_try.wren │ │ ├── stepA_mal.wren │ │ ├── tests/ │ │ │ ├── step5_tco.mal │ │ │ └── stepA_mal.mal │ │ ├── types.wren │ │ └── wren-add-gettimeofday.patch │ ├── xslt/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.xslt │ │ ├── env.xslt │ │ ├── printer.xslt │ │ ├── reader.xslt │ │ ├── readline.xslt │ │ ├── run │ │ ├── step0_repl.inc.xslt │ │ ├── step0_repl.xslt │ │ ├── step1_read_print.inc.xslt │ │ ├── step1_read_print.xslt │ │ ├── step2_eval.inc.xslt │ │ ├── step2_eval.xslt │ │ ├── step3_env.inc.xslt │ │ ├── step3_env.xslt │ │ ├── step4_if_fn_do.inc.xslt │ │ ├── step4_if_fn_do.xslt │ │ ├── step6_file.inc.xslt │ │ ├── step6_file.xslt │ │ ├── step7_quote.inc.xslt │ │ ├── step7_quote.xslt │ │ ├── step8_macros.inc.xslt │ │ ├── step8_macros.xslt │ │ ├── step9_try.inc.xslt │ │ ├── step9_try.xslt │ │ ├── stepA_mal.inc.xslt │ │ ├── stepA_mal.xslt │ │ └── test.xslt │ ├── yorick/ │ │ ├── Dockerfile │ │ ├── Makefile │ │ ├── core.i │ │ ├── env.i │ │ ├── hash.i │ │ ├── printer.i │ │ ├── reader.i │ │ ├── run │ │ ├── step0_repl.i │ │ ├── step1_read_print.i │ │ ├── step2_eval.i │ │ ├── step3_env.i │ │ ├── step4_if_fn_do.i │ │ ├── step5_tco.i │ │ ├── step6_file.i │ │ ├── step7_quote.i │ │ ├── step8_macros.i │ │ ├── step9_try.i │ │ ├── stepA_mal.i │ │ ├── tests/ │ │ │ └── stepA_mal.mal │ │ └── types.i │ └── zig/ │ ├── Dockerfile │ ├── Makefile │ ├── README │ ├── build.zig │ ├── core.zig │ ├── env.zig │ ├── error.zig │ ├── hmap.zig │ ├── linked_list.zig │ ├── printer.zig │ ├── reader.zig │ ├── readline.zig │ ├── run │ ├── step0_repl.zig │ ├── step1_read_print.zig │ ├── step2_eval.zig │ ├── step3_env.zig │ ├── step4_if_fn_do.zig │ ├── step5_tco.zig │ ├── step6_file.zig │ ├── step7_quote.zig │ ├── step8_macros.zig │ ├── step9_try.zig │ ├── stepA_mal.zig │ └── types.zig ├── process/ │ ├── guide.md │ ├── step0_repl.txt │ ├── step1_read_print.txt │ ├── step2_eval.txt │ ├── step3_env.txt │ ├── step4_if_fn_do.txt │ ├── step5_tco.txt │ ├── step6_file.txt │ ├── step7_quote.txt │ ├── step8_macros.txt │ ├── step9_try.txt │ ├── stepA_mal.txt │ └── steps.drawio ├── runtest.py └── voom-like-version.sh ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitattributes ================================================ * text=auto eol=lf impls/vbs/*.vbs text eol=crlf ================================================ FILE: .github/pull_request_template.md ================================================ Pull request requirements: - [ ] Commits are well written and well organized. - [ ] Commits for a specific implementation should be prefixed with the implementation name. - [ ] Github Actions CI passes all checks (including self-host) Additional requirements if you are adding a new implementation (see [FAQ](../docs/FAQ.md#add_implementation) for details): - [ ] Follow incremental structure (no common eval code) - [ ] Add `impls//Dockerfile` - [ ] Add `impls//Makefile` - [ ] Update `IMPLS.yml` - [ ] Update `Makefile.impls` - [ ] Update `README.md` ================================================ FILE: .github/workflows/main.yml ================================================ name: Build and Test permissions: contents: read packages: write on: push: {} pull_request: {} workflow_dispatch: inputs: impls: description: 'Space separated list of impls to test (or all)' required: true default: 'all' self-hosted: description: 'Include self-hosted tests' required: true default: 'yes' options: ['yes', 'no'] jobs: get-matrix: runs-on: ubuntu-24.04 outputs: do-linux: ${{ steps.get-matrix-step.outputs.do_linux }} matrix-linux: ${{ steps.get-matrix-step.outputs.linux }} do-macos: ${{ steps.get-matrix-step.outputs.do_macos }} matrix-macos: ${{ steps.get-matrix-step.outputs.macos }} do-windows: ${{ steps.get-matrix-step.outputs.do_windows }} matrix-windows: ${{ steps.get-matrix-step.outputs.windows }} steps: - uses: actions/checkout@v4 - id: files if: ${{ github.event_name != 'workflow_dispatch' }} uses: kanaka/get-changed-files@v4 with: default-base: master - id: get-matrix-step run: | export OVERRIDE_IMPLS="${{ github.event.inputs.impls }}" # " echo "OVERRIDE_IMPLS: ${OVERRIDE_IMPLS}" ./get-ci-matrix.py ${{ steps.files.outputs.all }} > "${GITHUB_OUTPUT}" linux: needs: get-matrix if: ${{ needs.get-matrix.outputs.do-linux == 'true' }} runs-on: ubuntu-24.04 strategy: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-linux) }} steps: - uses: actions/checkout@v4 with: fetch-depth: 0 # Need full history for voom like versions - name: Log in to GitHub Container Registry uses: docker/login-action@v3 with: registry: ghcr.io username: ${{ github.actor }} password: ${{ secrets.GITHUB_TOKEN }} - name: Docker Build/Push run: | export ${{ matrix.IMPL }} ./ci.sh docker-build-push ${IMPL} - name: Build run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - name: Step Tests run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Self-hosted Tests if: ${{ github.event.inputs.self-hosted != 'no' }} run: | export ${{ matrix.IMPL }} if [ -n "${NO_SELF_HOST:-}" ]; then echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" else DO_SELF_HOST=1 ./ci.sh test ${IMPL} # Check that self-hosted mode really ran [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] fi - name: Print debug log if: failure() run: cat *.debug - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: name: logs.${{ matrix.IMPL }} path: | *.log *.debug macos: needs: get-matrix if: ${{ needs.get-matrix.outputs.do-macos == 'true' }} runs-on: macos-12 strategy: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-macos) }} steps: - uses: actions/checkout@v4 - name: Build run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - name: Step Tests run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Self-hosted Tests if: ${{ github.event.inputs.self-hosted != 'no' }} run: | export ${{ matrix.IMPL }} if [ -n "${NO_SELF_HOST:-}" ]; then echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" else DO_SELF_HOST=1 ./ci.sh test ${IMPL} # Check that self-hosted mode really ran [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] fi - name: Print debug log if: failure() run: cat *.debug - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: name: logs.${{ matrix.IMPL }} path: | *.log *.debug windows: needs: get-matrix if: ${{ needs.get-matrix.outputs.do-windows == 'true' }} runs-on: windows-2022 strategy: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-windows) }} steps: - uses: Vampire/setup-wsl@v3 with: distribution: Ubuntu-24.04 - name: Install requirements for WSL shell: wsl-bash {0} run: | sudo apt update -y sudo apt install make -y sudo apt install python3 -y sudo ln -s /usr/bin/python3 /usr/bin/python - uses: actions/checkout@v4 - name: Build shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - name: Step Tests shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Self-hosted Tests if: ${{ github.event.inputs.self-hosted != 'no' }} shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} if [ -n "${NO_SELF_HOST:-}" ]; then echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" else DO_SELF_HOST=1 ./ci.sh test ${IMPL} # Check that self-hosted mode really ran [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] fi - name: Print debug log if: failure() run: cat *.debug - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: name: logs.${{ matrix.IMPL }} path: | *.log *.debug ================================================ FILE: .gitignore ================================================ .DS_Store .bash_history .cache .cargo .config .mal-history .mal_history .crystal .lein .local .m2 .ivy2 .sbt .npm .node-gyp */experiments node_modules */notes GPATH GTAGS GRTAGS logs old tmp/ .xslt_mal_history zig-cache/ ================================================ FILE: .gitmodules ================================================ ================================================ FILE: .travis.yml ================================================ sudo: required # matrix layout based on: # https://github.com/libressl-portable/portable/blob/9e090286b55def5ca2c0cc375c65023a70d8796e/.travis.yml matrix: include: - {env: IMPL=objc NO_DOCKER=1, os: osx, osx_image: xcode7} - {env: IMPL=swift NO_DOCKER=1, os: osx, osx_image: xcode7.3} - {env: IMPL=swift3 NO_DOCKER=1, os: osx, osx_image: xcode8} - {env: IMPL=swift4 NO_DOCKER=1, os: osx, osx_image: xcode10} - {env: IMPL=swift5 NO_DOCKER=1, os: osx, osx_image: xcode11} script: # Build, test, perf - ./ci.sh build ${IMPL} - ./ci.sh test ${IMPL} - STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - ./ci.sh perf ${IMPL} ================================================ FILE: IMPLS.yml ================================================ IMPL: - {IMPL: ada} - {IMPL: ada.2} - {IMPL: awk} - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM - {IMPL: bbc-basic} - {IMPL: c} - {IMPL: c.2} - {IMPL: cpp} - {IMPL: coffee} - {IMPL: cs} - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM - {IMPL: clojure, clojure_MODE: clj} - {IMPL: clojure, clojure_MODE: cljs} - {IMPL: common-lisp} - {IMPL: crystal} - {IMPL: d, d_MODE: gdc} - {IMPL: d, d_MODE: ldc2} - {IMPL: d, d_MODE: dmd} - {IMPL: dart} - {IMPL: elisp} - {IMPL: elixir} - {IMPL: elm} - {IMPL: erlang, NO_SELF_HOST: 1} # step4 silent exit on "(DO 3)" - {IMPL: es6} - {IMPL: factor} - {IMPL: fantom} - {IMPL: fennel} - {IMPL: forth} - {IMPL: fsharp} - {IMPL: go} - {IMPL: groovy} - {IMPL: gnu-smalltalk} - {IMPL: guile} - {IMPL: hare} - {IMPL: haskell} - {IMPL: haxe, haxe_MODE: neko} - {IMPL: haxe, haxe_MODE: python} - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} - {IMPL: haxe, haxe_MODE: js} - {IMPL: hy} - {IMPL: io, NO_SELF_HOST: 1, NO_SELF_HOST_PERF: 1} # invalid pointer, perf OOM - {IMPL: janet} - {IMPL: java} - {IMPL: java-truffle} - {IMPL: jq, NO_SELF_HOST: 1} # start-up failure and other issues - {IMPL: js} - {IMPL: julia} - {IMPL: kotlin} - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} - {IMPL: livescript} - {IMPL: logo} - {IMPL: lua} - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout - {IMPL: nasm, NO_SELF_HOST: 1} # needs memory bump, then fails in step7/quasiquote - {IMPL: nim} - {IMPL: objpascal} - {IMPL: objc} - {IMPL: ocaml} - {IMPL: perl} - {IMPL: perl6} - {IMPL: php} - {IMPL: picolisp} - {IMPL: pike} - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout # - {IMPL: plsql} - {IMPL: prolog} - {IMPL: ps} - {IMPL: powershell, NO_SELF_HOST: 1} # works, but too slow be default enabled - {IMPL: purs} - {IMPL: python2} - {IMPL: python3} - {IMPL: r} - {IMPL: racket} - {IMPL: rexx} - {IMPL: rpython, SLOW: 1} - {IMPL: ruby} - {IMPL: ruby.2} - {IMPL: rust} - {IMPL: scala} - {IMPL: scheme, scheme_MODE: chibi} - {IMPL: scheme, scheme_MODE: kawa} - {IMPL: scheme, scheme_MODE: gauche} - {IMPL: scheme, scheme_MODE: chicken} - {IMPL: scheme, scheme_MODE: sagittarius} - {IMPL: scheme, scheme_MODE: cyclone} # - {IMPL: scheme, scheme_MODE: foment} - {IMPL: skew} - {IMPL: sml, sml_MODE: polyml} - {IMPL: sml, sml_MODE: mlton} - {IMPL: sml, sml_MODE: mosml} - {IMPL: tcl} - {IMPL: ts} - {IMPL: vala} - {IMPL: vb} - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout - {IMPL: vimscript} # no self-host perf for wasm due to mac stack overflow - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - {IMPL: wren} - {IMPL: xslt, NO_SELF_HOST: 1} # step1 fail: "Too many nested template ..." - {IMPL: yorick} - {IMPL: zig} # See .travis.yml (for older osx / xcode tests) - {IMPL: swift3} # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8} - {IMPL: swift4} # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10} - {IMPL: swift6} # - {IMPL: swift6, NO_DOCKER: 1, OS: macos} # works but too expensive in GH Actions - {IMPL: vbs, NO_SELF_HOST: 1, NO_DOCKER: 1, OS: windows} # self-host too slow/expensive in GH Actions ================================================ FILE: LICENSE ================================================ Copyright (C) 2015 Joel Martin Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public License 2.0). The text of the MPL 2.0 license is included below and can be found at https://www.mozilla.org/MPL/2.0/ Many of the implementations run or compile using a line editing library. In some cases, the implementations provide an option in the code to switch between the GNU GPL licensed GNU readline library and the BSD licensed editline (libedit) library. Mozilla Public License Version 2.0 ================================== 1. Definitions -------------- 1.1. "Contributor" means each individual or legal entity that creates, contributes to the creation of, or owns Covered Software. 1.2. "Contributor Version" means the combination of the Contributions of others (if any) used by a Contributor and that particular Contributor's Contribution. 1.3. "Contribution" means Covered Software of a particular Contributor. 1.4. "Covered Software" means Source Code Form to which the initial Contributor has attached the notice in Exhibit A, the Executable Form of such Source Code Form, and Modifications of such Source Code Form, in each case including portions thereof. 1.5. "Incompatible With Secondary Licenses" means (a) that the initial Contributor has attached the notice described in Exhibit B to the Covered Software; or (b) that the Covered Software was made available under the terms of version 1.1 or earlier of the License, but not also under the terms of a Secondary License. 1.6. "Executable Form" means any form of the work other than Source Code Form. 1.7. "Larger Work" means a work that combines Covered Software with other material, in a separate file or files, that is not Covered Software. 1.8. "License" means this document. 1.9. "Licensable" means having the right to grant, to the maximum extent possible, whether at the time of the initial grant or subsequently, any and all of the rights conveyed by this License. 1.10. "Modifications" means any of the following: (a) any file in Source Code Form that results from an addition to, deletion from, or modification of the contents of Covered Software; or (b) any new file in Source Code Form that contains any Covered Software. 1.11. "Patent Claims" of a Contributor means any patent claim(s), including without limitation, method, process, and apparatus claims, in any patent Licensable by such Contributor that would be infringed, but for the grant of the License, by the making, using, selling, offering for sale, having made, import, or transfer of either its Contributions or its Contributor Version. 1.12. "Secondary License" means either the GNU General Public License, Version 2.0, the GNU Lesser General Public License, Version 2.1, the GNU Affero General Public License, Version 3.0, or any later versions of those licenses. 1.13. "Source Code Form" means the form of the work preferred for making modifications. 1.14. "You" (or "Your") means an individual or a legal entity exercising rights under this License. For legal entities, "You" includes any entity that controls, is controlled by, or is under common control with You. For purposes of this definition, "control" means (a) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (b) ownership of more than fifty percent (50%) of the outstanding shares or beneficial ownership of such entity. 2. License Grants and Conditions -------------------------------- 2.1. Grants Each Contributor hereby grants You a world-wide, royalty-free, non-exclusive license: (a) under intellectual property rights (other than patent or trademark) Licensable by such Contributor to use, reproduce, make available, modify, display, perform, distribute, and otherwise exploit its Contributions, either on an unmodified basis, with Modifications, or as part of a Larger Work; and (b) under Patent Claims of such Contributor to make, use, sell, offer for sale, have made, import, and otherwise transfer either its Contributions or its Contributor Version. 2.2. Effective Date The licenses granted in Section 2.1 with respect to any Contribution become effective for each Contribution on the date the Contributor first distributes such Contribution. 2.3. Limitations on Grant Scope The licenses granted in this Section 2 are the only rights granted under this License. No additional rights or licenses will be implied from the distribution or licensing of Covered Software under this License. Notwithstanding Section 2.1(b) above, no patent license is granted by a Contributor: (a) for any code that a Contributor has removed from Covered Software; or (b) for infringements caused by: (i) Your and any other third party's modifications of Covered Software, or (ii) the combination of its Contributions with other software (except as part of its Contributor Version); or (c) under Patent Claims infringed by Covered Software in the absence of its Contributions. This License does not grant any rights in the trademarks, service marks, or logos of any Contributor (except as may be necessary to comply with the notice requirements in Section 3.4). 2.4. Subsequent Licenses No Contributor makes additional grants as a result of Your choice to distribute the Covered Software under a subsequent version of this License (see Section 10.2) or under the terms of a Secondary License (if permitted under the terms of Section 3.3). 2.5. Representation Each Contributor represents that the Contributor believes its Contributions are its original creation(s) or it has sufficient rights to grant the rights to its Contributions conveyed by this License. 2.6. Fair Use This License is not intended to limit any rights You have under applicable copyright doctrines of fair use, fair dealing, or other equivalents. 2.7. Conditions Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted in Section 2.1. 3. Responsibilities ------------------- 3.1. Distribution of Source Form All distribution of Covered Software in Source Code Form, including any Modifications that You create or to which You contribute, must be under the terms of this License. You must inform recipients that the Source Code Form of the Covered Software is governed by the terms of this License, and how they can obtain a copy of this License. You may not attempt to alter or restrict the recipients' rights in the Source Code Form. 3.2. Distribution of Executable Form If You distribute Covered Software in Executable Form then: (a) such Covered Software must also be made available in Source Code Form, as described in Section 3.1, and You must inform recipients of the Executable Form how they can obtain a copy of such Source Code Form by reasonable means in a timely manner, at a charge no more than the cost of distribution to the recipient; and (b) You may distribute such Executable Form under the terms of this License, or sublicense it under different terms, provided that the license for the Executable Form does not attempt to limit or alter the recipients' rights in the Source Code Form under this License. 3.3. Distribution of a Larger Work You may create and distribute a Larger Work under terms of Your choice, provided that You also comply with the requirements of this License for the Covered Software. If the Larger Work is a combination of Covered Software with a work governed by one or more Secondary Licenses, and the Covered Software is not Incompatible With Secondary Licenses, this License permits You to additionally distribute such Covered Software under the terms of such Secondary License(s), so that the recipient of the Larger Work may, at their option, further distribute the Covered Software under the terms of either this License or such Secondary License(s). 3.4. Notices You may not remove or alter the substance of any license notices (including copyright notices, patent notices, disclaimers of warranty, or limitations of liability) contained within the Source Code Form of the Covered Software, except that You may alter any license notices to the extent required to remedy known factual inaccuracies. 3.5. Application of Additional Terms You may choose to offer, and to charge a fee for, warranty, support, indemnity or liability obligations to one or more recipients of Covered Software. However, You may do so only on Your own behalf, and not on behalf of any Contributor. You must make it absolutely clear that any such warranty, support, indemnity, or liability obligation is offered by You alone, and You hereby agree to indemnify every Contributor for any liability incurred by such Contributor as a result of warranty, support, indemnity or liability terms You offer. You may include additional disclaimers of warranty and limitations of liability specific to any jurisdiction. 4. Inability to Comply Due to Statute or Regulation --------------------------------------------------- If it is impossible for You to comply with any of the terms of this License with respect to some or all of the Covered Software due to statute, judicial order, or regulation then You must: (a) comply with the terms of this License to the maximum extent possible; and (b) describe the limitations and the code they affect. Such description must be placed in a text file included with all distributions of the Covered Software under this License. Except to the extent prohibited by statute or regulation, such description must be sufficiently detailed for a recipient of ordinary skill to be able to understand it. 5. Termination -------------- 5.1. The rights granted under this License will terminate automatically if You fail to comply with any of its terms. However, if You become compliant, then the rights granted under this License from a particular Contributor are reinstated (a) provisionally, unless and until such Contributor explicitly and finally terminates Your grants, and (b) on an ongoing basis, if such Contributor fails to notify You of the non-compliance by some reasonable means prior to 60 days after You have come back into compliance. Moreover, Your grants from a particular Contributor are reinstated on an ongoing basis if such Contributor notifies You of the non-compliance by some reasonable means, this is the first time You have received notice of non-compliance with this License from such Contributor, and You become compliant prior to 30 days after Your receipt of the notice. 5.2. If You initiate litigation against any entity by asserting a patent infringement claim (excluding declaratory judgment actions, counter-claims, and cross-claims) alleging that a Contributor Version directly or indirectly infringes any patent, then the rights granted to You by any and all Contributors for the Covered Software under Section 2.1 of this License shall terminate. 5.3. In the event of termination under Sections 5.1 or 5.2 above, all end user license agreements (excluding distributors and resellers) which have been validly granted by You or Your distributors under this License prior to termination shall survive termination. ************************************************************************ * * * 6. Disclaimer of Warranty * * ------------------------- * * * * Covered Software is provided under this License on an "as is" * * basis, without warranty of any kind, either expressed, implied, or * * statutory, including, without limitation, warranties that the * * Covered Software is free of defects, merchantable, fit for a * * particular purpose or non-infringing. The entire risk as to the * * quality and performance of the Covered Software is with You. * * Should any Covered Software prove defective in any respect, You * * (not any Contributor) assume the cost of any necessary servicing, * * repair, or correction. This disclaimer of warranty constitutes an * * essential part of this License. No use of any Covered Software is * * authorized under this License except under this disclaimer. * * * ************************************************************************ ************************************************************************ * * * 7. Limitation of Liability * * -------------------------- * * * * Under no circumstances and under no legal theory, whether tort * * (including negligence), contract, or otherwise, shall any * * Contributor, or anyone who distributes Covered Software as * * permitted above, be liable to You for any direct, indirect, * * special, incidental, or consequential damages of any character * * including, without limitation, damages for lost profits, loss of * * goodwill, work stoppage, computer failure or malfunction, or any * * and all other commercial damages or losses, even if such party * * shall have been informed of the possibility of such damages. This * * limitation of liability shall not apply to liability for death or * * personal injury resulting from such party's negligence to the * * extent applicable law prohibits such limitation. Some * * jurisdictions do not allow the exclusion or limitation of * * incidental or consequential damages, so this exclusion and * * limitation may not apply to You. * * * ************************************************************************ 8. Litigation ------------- Any litigation relating to this License may be brought only in the courts of a jurisdiction where the defendant maintains its principal place of business and such litigation shall be governed by laws of that jurisdiction, without reference to its conflict-of-law provisions. Nothing in this Section shall prevent a party's ability to bring cross-claims or counter-claims. 9. Miscellaneous ---------------- This License represents the complete agreement concerning the subject matter hereof. If any provision of this License is held to be unenforceable, such provision shall be reformed only to the extent necessary to make it enforceable. Any law or regulation which provides that the language of a contract shall be construed against the drafter shall not be used to construe this License against a Contributor. 10. Versions of the License --------------------------- 10.1. New Versions Mozilla Foundation is the license steward. Except as provided in Section 10.3, no one other than the license steward has the right to modify or publish new versions of this License. Each version will be given a distinguishing version number. 10.2. Effect of New Versions You may distribute the Covered Software under the terms of the version of the License under which You originally received the Covered Software, or under the terms of any subsequent version published by the license steward. 10.3. Modified Versions If you create software not governed by this License, and you want to create a new license for such software, you may create and use a modified version of this License if you rename the license and remove any references to the name of the license steward (except to note that such modified license differs from this License). 10.4. Distributing Source Code Form that is Incompatible With Secondary Licenses If You choose to distribute Source Code Form that is Incompatible With Secondary Licenses under the terms of this version of the License, the notice described in Exhibit B of this License must be attached. Exhibit A - Source Code Form License Notice ------------------------------------------- This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at http://mozilla.org/MPL/2.0/. If it is not possible or desirable to put the notice in a particular file, then You may include the notice in a location (such as a LICENSE file in a relevant directory) where a recipient would be likely to look for such a notice. You may add additional accurate notices of copyright ownership. Exhibit B - "Incompatible With Secondary Licenses" Notice --------------------------------------------------------- This Source Code Form is "Incompatible With Secondary Licenses", as defined by the Mozilla Public License, v. 2.0. ================================================ FILE: Makefile ================================================ # Usage/help all help: @echo @echo 'USAGE:' @echo @echo 'Rules/Targets:' @echo @echo 'make "IMPL" # build all steps of IMPL' @echo 'make "build^IMPL" # build all steps of IMPL' @echo 'make "IMPL^STEP" # build STEP of IMPL' @echo 'make "build^IMPL^STEP" # build STEP of IMPL' @echo @echo 'make "test" # test all implementations' @echo 'make "test^IMPL" # test all steps of IMPL' @echo 'make "test^STEP" # test STEP for all implementations' @echo 'make "test^IMPL^STEP" # test STEP of IMPL' @echo @echo 'make "perf" # run microbenchmarks for all implementations' @echo 'make "perf^IMPL" # run microbenchmarks for IMPL' @echo @echo 'make "repl^IMPL" # run stepA of IMPL' @echo 'make "repl^IMPL^STEP" # test STEP of IMPL' @echo @echo 'make "clean" # run 'make clean' for all implementations' @echo 'make "clean^IMPL" # run 'make clean' for IMPL' @echo @echo 'make "stats" # run 'make stats' for all implementations' @echo 'make "stats-lisp" # run 'make stats-lisp' for all implementations' @echo 'make "stats^IMPL" # run 'make stats' for IMPL' @echo 'make "stats-lisp^IMPL" # run 'make stats-lisp' for IMPL' @echo @echo 'Options/Settings:' @echo @echo 'make MAL_IMPL=IMPL "test^mal..." # use IMPL for self-host tests' @echo 'make REGRESS=1 "test..." # test with previous step tests too' @echo 'make DOCKERIZE=1 ... # to dockerize above rules/targets' @echo 'make TEST_OPTS="--opt ..." # options to pass to runtest.py' @echo @echo 'Other:' @echo @echo 'make "docker-build^IMPL" # build docker image for IMPL' @echo @echo 'make "docker-shell^IMPL" # start bash shell in docker image for IMPL' @echo # Implementation specific settings are here: include Makefile.impls # # General command line settings # MAL_IMPL = js # Path to loccount for counting LOC stats LOCCOUNT = loccount # Extra options to pass to runtest.py TEST_OPTS = # Test with previous test files not just the test files for the # current step. Step 0 and 1 tests are special and not included in # later steps. REGRESS = HARD= DEFERRABLE=1 OPTIONAL=1 # Run target/rule within docker image for the implementation DOCKERIZE = # # General settings and utility functions # EXTENSION = .mal step0 = step0_repl step1 = step1_read_print step2 = step2_eval step3 = step3_env step4 = step4_if_fn_do step5 = step5_tco step6 = step6_file step7 = step7_quote step8 = step8_macros step9 = step9_try stepA = stepA_mal argv_STEP = step6_file regress_step0 = step0 regress_step1 = step1 regress_step2 = step2 regress_step3 = $(regress_step2) step3 regress_step4 = $(regress_step3) step4 regress_step5 = $(regress_step4) step5 regress_step6 = $(regress_step5) step6 regress_step7 = $(regress_step6) step7 regress_step8 = $(regress_step7) step8 regress_step9 = $(regress_step8) step9 regress_stepA = $(regress_step9) stepA # Needed some argument munging COMMA = , noop = SPACE = $(noop) $(noop) export FACTOR_ROOTS := . opt_HARD = $(if $(strip $(HARD)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(HARD)),--hard,),) opt_DEFERRABLE = $(if $(strip $(DEFERRABLE)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(DEFERRABLE)),--deferrable,--no-deferrable),--no-deferrable) opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(OPTIONAL)),--optional,--no-optional),--no-optional) # Return list of test files for a given step. If REGRESS is set then # test files will include step 2 tests through tests for the step # being tested. STEP_TEST_FILES = $(strip $(wildcard \ $(foreach s,$(if $(strip $(REGRESS)),\ $(filter-out $(if $(filter $(1),$(step5_EXCLUDES)),step5,),\ $(regress_$(2)))\ ,$(2)),\ impls/$(1)/tests/$($(s))$(EXTENSION) impls/tests/$($(s))$(EXTENSION)))) # DOCKERIZE utility functions lc = $(subst A,a,$(subst B,b,$(subst C,c,$(subst D,d,$(subst E,e,$(subst F,f,$(subst G,g,$(subst H,h,$(subst I,i,$(subst J,j,$(subst K,k,$(subst L,l,$(subst M,m,$(subst N,n,$(subst O,o,$(subst P,p,$(subst Q,q,$(subst R,r,$(subst S,s,$(subst T,t,$(subst U,u,$(subst V,v,$(subst W,w,$(subst X,x,$(subst Y,y,$(subst Z,z,$1)))))))))))))))))))))))))) impl_to_image = ghcr.io/kanaka/mal-test-$(call lc,$(1)):$(shell ./voom-like-version.sh impls/$(1)/Dockerfile) actual_impl = $(if $(filter mal,$(1)),$(patsubst %-mal,%,$(MAL_IMPL)),$(1)) # Takes impl # Returns nothing if DOCKERIZE is not set, otherwise returns the # docker prefix necessary to run make within the docker environment # for this impl get_build_command = $(strip $(foreach mode,$(1)_MODE, \ $(if $(strip $(DOCKERIZE)),\ docker run \ -it --rm -u $(shell id -u) \ -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ -w /mal/impls/$(1) \ $(if $(strip $($(mode))),-e $(mode)=$($(mode)),) \ $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ $(call impl_to_image,$(1)) \ make $(if $(strip $($(mode))),$(mode)=$($(mode)),) \ ,\ $(MAKE) $(if $(strip $($(mode))),$(mode)=$($(mode)),) -C impls/$(impl)))) # Takes impl and step args. Optional env vars and dockerize args # Returns a command prefix (docker command and environment variables) # necessary to launch the given impl and step get_run_prefix = $(strip $(foreach mode,$(call actual_impl,$(1))_MODE, \ $(if $(strip $(DOCKERIZE) $(4)),\ docker run -e STEP=$($2) -e MAL_IMPL=$(MAL_IMPL) \ -it --rm -u $(shell id -u) \ -v $(dir $(abspath $(lastword $(MAKEFILE_LIST)))):/mal \ -w /mal/impls/$(call actual_impl,$(1)) \ $(if $(strip $($(mode))),-e $(mode)=$($(mode)),) \ $(if $(filter factor,$(1)),-e FACTOR_ROOTS=$(FACTOR_ROOTS),) \ $(foreach env,$(3),-e $(env)) \ $(call impl_to_image,$(call actual_impl,$(1))) \ ,\ env STEP=$($2) MAL_IMPL=$(MAL_IMPL) \ $(if $(strip $($(mode))),$(mode)=$($(mode)),) \ $(if $(filter factor,$(1)),FACTOR_ROOTS=$(FACTOR_ROOTS),) \ $(3)))) # Takes impl and step # Returns the runtest command prefix (with runtest options) for testing the given step get_runtest_cmd = $(call get_run_prefix,$(1),$(2),$(if $(filter cs fsharp mal tcl vb,$(1)),RAW=1,)) \ ../../runtest.py $(opt_HARD) $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS) # Takes impl and step # Returns the runtest command prefix (with runtest options) for testing the given step get_argvtest_cmd = $(call get_run_prefix,$(1),$(2)) ../tests/run_argv_test.sh # Derived lists STEPS = $(sort $(filter-out %_EXCLUDES,$(filter step%,$(.VARIABLES)))) DO_IMPLS = $(filter-out $(SKIP_IMPLS),$(IMPLS)) IMPL_TESTS = $(foreach impl,$(DO_IMPLS),test^$(impl)) STEP_TESTS = $(foreach step,$(STEPS),test^$(step)) ALL_TESTS = $(filter-out $(foreach e,$(step5_EXCLUDES),test^$(e)^step5),\ $(strip $(sort \ $(foreach impl,$(DO_IMPLS),\ $(foreach step,$(STEPS),test^$(impl)^$(step)))))) ALL_BUILDS = $(strip $(sort \ $(foreach impl,$(DO_IMPLS),\ $(foreach step,$(STEPS),build^$(impl)^$(step))))) DOCKER_BUILD = $(foreach impl,$(DO_IMPLS),docker-build^$(impl)) DOCKER_SHELL = $(foreach impl,$(DO_IMPLS),docker-shell^$(impl)) IMPL_PERF = $(foreach impl,$(filter-out $(perf_EXCLUDES),$(DO_IMPLS)),perf^$(impl)) IMPL_STATS = $(foreach impl,$(DO_IMPLS),stats^$(impl)) IMPL_REPL = $(foreach impl,$(DO_IMPLS),repl^$(impl)) ALL_REPL = $(strip $(sort \ $(foreach impl,$(DO_IMPLS),\ $(foreach step,$(STEPS),repl^$(impl)^$(step))))) # # Build rules # # Enable secondary expansion for all rules .SECONDEXPANSION: # Build a program in an implementation directory # Make sure we always try and build first because the dependencies are # encoded in the implementation Makefile not here .PHONY: $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))) $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(call $(i)_STEP_TO_PROG,$(s)))): $(foreach impl,$(word 2,$(subst /, ,$(@))),\ $(if $(DOCKERIZE), \ $(call get_build_command,$(impl)) $(patsubst impls/$(impl)/%,%,$(@)), \ $(call get_build_command,$(impl)) $(subst impls/$(impl)/,,$(@)))) # Allow IMPL, build^IMPL, IMPL^STEP, and build^IMPL^STEP $(DO_IMPLS): $$(foreach s,$$(STEPS),$$(call $$(@)_STEP_TO_PROG,$$(s))) $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),build^$(i))): $$(foreach s,$$(STEPS),$$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(s))) $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),$(i)^$(s))): $$(call $$(word 1,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 2,$$(subst ^, ,$$(@)))) $(foreach i,$(DO_IMPLS),$(foreach s,$(STEPS),build^$(i)^$(s))): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) # # Test rules # $(ALL_TESTS): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ $(foreach step,$(word 3,$(subst ^, ,$(@))),\ echo "(call STEP_TEST_FILES,$(impl),$(step)): $(call STEP_TEST_FILES,$(impl),$(step))" && \ cd impls/$(call actual_impl,$(impl)) && \ $(foreach test,$(patsubst impls/%,%,$(call STEP_TEST_FILES,$(impl),$(step))),\ echo '----------------------------------------------' && \ echo 'Testing $@; step file: $+, test file: $(test)' && \ echo 'Running: $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run' && \ $(call get_runtest_cmd,$(impl),$(step)) ../$(test) -- ../$(impl)/run && \ $(if $(filter tests/$(argv_STEP)$(EXTENSION),$(test)),\ echo '----------------------------------------------' && \ echo 'Testing ARGV of $@; step file: $+' && \ echo 'Running: $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run ' && \ $(call get_argvtest_cmd,$(impl),$(step)) ../$(impl)/run && ,\ true && ))\ true)) # Allow test, tests, test^STEP, test^IMPL, and test^IMPL^STEP test: $(ALL_TESTS) tests: $(ALL_TESTS) $(IMPL_TESTS): $$(filter $$@^%,$$(ALL_TESTS)) $(STEP_TESTS): $$(foreach step,$$(subst test^,,$$@),$$(filter %^$$(step),$$(ALL_TESTS))) # # Docker build rules # docker-build: $(DOCKER_BUILD) $(DOCKER_BUILD): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ echo "Running: docker build -t $(call impl_to_image,$(impl)) .:"; \ cd impls/$(impl) && docker build -t $(call impl_to_image,$(impl)) .) # # Docker shell rules # $(DOCKER_SHELL): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ echo "Running: $(call get_run_prefix,$(impl),stepA,,dockerize) bash"; \ $(call get_run_prefix,$(impl),stepA,,dockerize) bash) # # Performance test rules # perf: $(IMPL_PERF) $(IMPL_PERF): @echo "----------------------------------------------"; \ $(foreach impl,$(word 2,$(subst ^, ,$(@))),\ cd impls/$(call actual_impl,$(impl)); \ echo "Performance test for $(impl):"; \ echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal'; \ $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf1.mal; \ echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal'; \ $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf2.mal; \ echo 'Running: $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal'; \ $(call get_run_prefix,$(impl),stepA) ../$(impl)/run ../tests/perf3.mal) # # REPL invocation rules # $(ALL_REPL): $$(call $$(word 2,$$(subst ^, ,$$(@)))_STEP_TO_PROG,$$(word 3,$$(subst ^, ,$$(@)))) @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ $(foreach step,$(word 3,$(subst ^, ,$(@))),\ cd impls/$(call actual_impl,$(impl)); \ echo 'REPL implementation $(impl), step file: $+'; \ echo 'Running: $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS)'; \ $(call get_run_prefix,$(impl),$(step)) ../$(impl)/run $(RUN_ARGS);)) # Allow repl^IMPL^STEP and repl^IMPL (which starts REPL of stepA) $(IMPL_REPL): $$@^stepA # # Stats test rules # # For a concise summary: # make stats | egrep -A1 "^Stats for|^all" | egrep -v "^all|^--" stats: $(IMPL_STATS) $(IMPL_STATS): @$(foreach impl,$(word 2,$(subst ^, ,$(@))),\ echo "Stats for $(impl):"; \ $(LOCCOUNT) -x "[sS]tep[0-9]_.*|[.]md$$|tests|examples|Makefile|package.json|tsconfig.json|Cargo.toml|project.clj|node_modules|getline.cs|terminal.cs|elm-stuff|objpascal/regexpr|rdyncall|swift/templates" impls/$(impl)) # # Utility functions # print-%: @echo "$($(*))" # # Recursive rules (call make FOO in each subdirectory) # define recur_template .PHONY: $(1) $(1): $(2) $(2): @echo "----------------------------------------------"; \ $$(foreach impl,$$(word 2,$$(subst ^, ,$$(@))),\ echo "Running: $$(call get_build_command,$$(impl)) --no-print-directory $(1)"; \ $$(call get_build_command,$$(impl)) --no-print-directory $(1)) endef recur_impls_ = $(filter-out $(foreach impl,$($(1)_EXCLUDES),$(1)^$(impl)),$(foreach impl,$(IMPLS),$(1)^$(impl))) # recursive clean $(eval $(call recur_template,clean,$(call recur_impls_,clean))) # recursive dist $(eval $(call recur_template,dist,$(call recur_impls_,dist))) ================================================ FILE: Makefile.impls ================================================ # HOWTO add a new implementation (named "foo"): # - Add "foo" to the IMPLS variable (alphabetical order) # - Add a new "foo_STEP_TO_PROG" variable. # - Add an "impls/foo/run" script. # - Add an "impls/foo/Makefile" # - Add an "impls/foo/Dockerfile" # - Implement each step in "impls/foo/". # # Implementation specific command line settings # # cbm or qbasic basic_MODE = cbm # clj or cljs (Clojure vs ClojureScript/lumo) clojure_MODE = clj # gdc, ldc2, or dmd d_MODE = gdc # python, js, cpp, or neko haxe_MODE = neko # octave or matlab matlab_MODE = octave # scheme (chibi, kawa, gauche, chicken, sagittarius, cyclone, foment) scheme_MODE = chibi # sml (polyml, mlton, mosml) sml_MODE = polyml # wasmtime wasmer wax node warpy wace_libc direct js wace_fooboot wasm_MODE = wasmtime # # Implementation specific settings # IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \ elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \ guile hare haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python2 python3 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ swift swift3 swift4 swift6 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig step5_EXCLUDES += bash # never completes at 10,000 step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 step5_EXCLUDES += latex3 # no iteration, limited native stack step5_EXCLUDES += make # no TCO capability (iteration or recursion) step5_EXCLUDES += mal # host impl dependent step5_EXCLUDES += matlab # never completes at 10,000 step5_EXCLUDES += plpgsql # too slow for 10,000 step5_EXCLUDES += plsql # too slow for 10,000 step5_EXCLUDES += powershell # too slow for 10,000 step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitly) step5_EXCLUDES += sml # not implemented :( step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 step5_EXCLUDES += xslt # iteration cannot be expressed step5_EXCLUDES += vbs # too slow for 10,000 dist_EXCLUDES += mal # TODO: still need to implement dist dist_EXCLUDES += guile io julia matlab swift # Extra options to pass to runtest.py bbc-basic_TEST_OPTS = --test-timeout 60 guile_TEST_OPTS = --test-timeout 120 io_TEST_OPTS = --test-timeout 120 java-truffle_TEST_OPTS = --start-timeout 30 logo_TEST_OPTS = --start-timeout 60 --test-timeout 120 mal_TEST_OPTS = --start-timeout 60 --test-timeout 120 miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120 perl6_TEST_OPTS = --test-timeout=60 plpgsql_TEST_OPTS = --start-timeout 60 --test-timeout 180 plsql_TEST_OPTS = --start-timeout 120 --test-timeout 120 vimscript_TEST_OPTS = --test-timeout 30 ifeq ($(MAL_IMPL),vimscript) mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 else ifeq ($(MAL_IMPL),powershell) mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 else ifeq ($(MAL_IMPL),vbs) mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 --no-pty endif xslt_TEST_OPTS = --test-timeout 120 vbs_TEST_OPTS = --no-pty # # Implementation specific utility functions # basic_STEP_TO_PROG_cbm = impls/basic/$($(1)).bas basic_STEP_TO_PROG_qbasic = impls/basic/$($(1)) clojure_STEP_TO_PROG_clj = impls/clojure/target/$($(1)).jar clojure_STEP_TO_PROG_cljs = impls/clojure/src/mal/$($(1)).cljc haxe_STEP_TO_PROG_neko = impls/haxe/$($(1)).n haxe_STEP_TO_PROG_python = impls/haxe/$($(1)).py haxe_STEP_TO_PROG_cpp = impls/haxe/cpp/$($(1)) haxe_STEP_TO_PROG_js = impls/haxe/$($(1)).js scheme_STEP_TO_PROG_chibi = impls/scheme/$($(1)).scm scheme_STEP_TO_PROG_kawa = impls/scheme/out/$($(1)).class scheme_STEP_TO_PROG_gauche = impls/scheme/$($(1)).scm scheme_STEP_TO_PROG_chicken = impls/scheme/$($(1)) scheme_STEP_TO_PROG_sagittarius = impls/scheme/$($(1)).scm scheme_STEP_TO_PROG_cyclone = impls/scheme/$($(1)) scheme_STEP_TO_PROG_foment = impls/scheme/$($(1)).scm # Map of step (e.g. "step8") to executable file for that step ada_STEP_TO_PROG = impls/ada/$($(1)) ada.2_STEP_TO_PROG = impls/ada.2/$($(1)) awk_STEP_TO_PROG = impls/awk/$($(1)).awk bash_STEP_TO_PROG = impls/bash/$($(1)).sh basic_STEP_TO_PROG = $(basic_STEP_TO_PROG_$(basic_MODE)) bbc-basic_STEP_TO_PROG = impls/bbc-basic/$($(1)).bas c_STEP_TO_PROG = impls/c/$($(1)) c.2_STEP_TO_PROG = impls/c.2/$($(1)) chuck_STEP_TO_PROG = impls/chuck/$($(1)).ck clojure_STEP_TO_PROG = $(clojure_STEP_TO_PROG_$(clojure_MODE)) coffee_STEP_TO_PROG = impls/coffee/$($(1)).coffee common-lisp_STEP_TO_PROG = impls/common-lisp/$($(1)) cpp_STEP_TO_PROG = impls/cpp/$($(1)) crystal_STEP_TO_PROG = impls/crystal/$($(1)) cs_STEP_TO_PROG = impls/cs/$($(1)).exe d_STEP_TO_PROG = impls/d/$($(1)) dart_STEP_TO_PROG = impls/dart/$($(1)).dart elisp_STEP_TO_PROG = impls/elisp/$($(1)).el elixir_STEP_TO_PROG = impls/elixir/lib/mix/tasks/$($(1)).ex elm_STEP_TO_PROG = impls/elm/$($(1)).js erlang_STEP_TO_PROG = impls/erlang/$($(1)) es6_STEP_TO_PROG = impls/es6/$($(1)).mjs factor_STEP_TO_PROG = impls/factor/$($(1))/$($(1)).factor fantom_STEP_TO_PROG = impls/fantom/lib/fan/$($(1)).pod fennel_STEP_TO_PROG = impls/fennel/$($(1)).fnl forth_STEP_TO_PROG = impls/forth/$($(1)).fs fsharp_STEP_TO_PROG = impls/fsharp/$($(1)).exe go_STEP_TO_PROG = impls/go/$($(1)) groovy_STEP_TO_PROG = impls/groovy/$($(1)).groovy gnu-smalltalk_STEP_TO_PROG = impls/gnu-smalltalk/$($(1)).st guile_STEP_TO_PROG = impls/guile/$($(1)).scm hare_STEP_TO_PROG = impls/hare/$($(1)) haskell_STEP_TO_PROG = impls/haskell/$($(1)) haxe_STEP_TO_PROG = $(haxe_STEP_TO_PROG_$(haxe_MODE)) hy_STEP_TO_PROG = impls/hy/$($(1)).hy io_STEP_TO_PROG = impls/io/$($(1)).io janet_STEP_TO_PROG = impls/janet/$($(1)).janet java_STEP_TO_PROG = impls/java/target/classes/mal/$($(1)).class java-truffle_STEP_TO_PROG = impls/java-truffle/build/classes/java/main/truffle/mal/$($(1)).class js_STEP_TO_PROG = impls/js/$($(1)).js jq_STEP_PROG = impls/jq/$($(1)).jq julia_STEP_TO_PROG = impls/julia/$($(1)).jl kotlin_STEP_TO_PROG = impls/kotlin/$($(1)).jar latex3_STEP_TO_PROG = impls/latex3/$($(1)).tex livescript_STEP_TO_PROG = impls/livescript/$($(1)).js logo_STEP_TO_PROG = impls/logo/$($(1)).lg lua_STEP_TO_PROG = impls/lua/$($(1)).lua make_STEP_TO_PROG = impls/make/$($(1)).mk mal_STEP_TO_PROG = impls/mal/$($(1)).mal matlab_STEP_TO_PROG = impls/matlab/$($(1)).m miniMAL_STEP_TO_PROG = impls/miniMAL/$($(1)).json nasm_STEP_TO_PROG = impls/nasm/$($(1)) nim_STEP_TO_PROG = impls/nim/$($(1)) objc_STEP_TO_PROG = impls/objc/$($(1)) objpascal_STEP_TO_PROG = impls/objpascal/$($(1)) ocaml_STEP_TO_PROG = impls/ocaml/$($(1)) perl_STEP_TO_PROG = impls/perl/$($(1)).pl perl6_STEP_TO_PROG = impls/perl6/$($(1)).pl php_STEP_TO_PROG = impls/php/$($(1)).php picolisp_STEP_TO_PROG = impls/picolisp/$($(1)).l pike_STEP_TO_PROG = impls/pike/$($(1)).pike plpgsql_STEP_TO_PROG = impls/plpgsql/$($(1)).sql plsql_STEP_TO_PROG = impls/plsql/$($(1)).sql powershell_STEP_TO_PROG = impls/powershell/$($(1)).ps1 prolog_STEP_TO_PROG = impls/prolog/$($(1)).pl ps_STEP_TO_PROG = impls/ps/$($(1)).ps purs_STEP_TO_PROG = impls/purs/$($(1)).js python2_STEP_TO_PROG = impls/python2/$($(1)).py python3_STEP_TO_PROG = impls/python3/$($(1)).py r_STEP_TO_PROG = impls/r/$($(1)).r racket_STEP_TO_PROG = impls/racket/$($(1)).rkt rexx_STEP_TO_PROG = impls/rexx/$($(1)).rexxpp rpython_STEP_TO_PROG = impls/rpython/$($(1)) ruby_STEP_TO_PROG = impls/ruby/$($(1)).rb ruby.2_STEP_TO_PROG = impls/ruby.2/$($(1)).rb rust_STEP_TO_PROG = impls/rust/target/release/$($(1)) scala_STEP_TO_PROG = impls/scala/target/scala-2.11/classes/$($(1)).class scheme_STEP_TO_PROG = $(scheme_STEP_TO_PROG_$(scheme_MODE)) skew_STEP_TO_PROG = impls/skew/$($(1)).js sml_STEP_TO_PROG = impls/sml/$($(1)) swift_STEP_TO_PROG = impls/swift/$($(1)) swift3_STEP_TO_PROG = impls/swift3/$($(1)) swift4_STEP_TO_PROG = impls/swift4/$($(1)) swift6_STEP_TO_PROG = impls/swift6/$($(1)) tcl_STEP_TO_PROG = impls/tcl/$($(1)).tcl ts_STEP_TO_PROG = impls/ts/$($(1)).js vala_STEP_TO_PROG = impls/vala/$($(1)) vb_STEP_TO_PROG = impls/vb/$($(1)).exe vbs_STEP_TO_PROG = impls/vbs/$($(1)).vbs vhdl_STEP_TO_PROG = impls/vhdl/$($(1)) vimscript_STEP_TO_PROG = impls/vimscript/$($(1)).vim wasm_STEP_TO_PROG = impls/wasm/$($(1)).wasm wren_STEP_TO_PROG = impls/wren/$($(1)).wren yorick_STEP_TO_PROG = impls/yorick/$($(1)).i xslt_STEP_TO_PROG = impls/xslt/$($(1)) zig_STEP_TO_PROG = impls/zig/$($(1)) ================================================ FILE: README.md ================================================ # mal - Make a Lisp [![Build and Test](https://github.com/kanaka/mal/actions/workflows/main.yml/badge.svg)](https://github.com/kanaka/mal/actions/workflows/main.yml) ## Description **1. Mal is a Clojure inspired Lisp interpreter** **2. Mal is a learning tool** Each implementation of mal is separated into 11 incremental, self-contained (and testable) steps that demonstrate core concepts of Lisp. The last step is capable of self-hosting (running the mal implementation of mal). See the [make-a-lisp process guide](process/guide.md). The make-a-lisp steps are: * [step0_repl](process/guide.md#step-0-the-repl) * [step1_read_print](process/guide.md#step-1-read-and-print) * [step2_eval](process/guide.md#step-2-eval) * [step3_env](process/guide.md#step-3-environments) * [step4_if_fn_do](process/guide.md#step-4-if-fn-do) * [step5_tco](process/guide.md#step-5-tail-call-optimization) * [step6_file](process/guide.md#step-6-files-mutation-and-evil) * [step7_quote](process/guide.md#step-7-quoting) * [step8_macros](process/guide.md#step-8-macros) * [step9_try](process/guide.md#step-9-try) * [stepA_mal](process/guide.md#step-a-metadata-self-hosting-and-interop) Each make-a-lisp step has an associated architectural diagram. That elements that are new for that step are highlighted in red. Here is the final architecture once [step A](process/guide.md#stepA) is complete: ![stepA_mal architecture](process/steps.png) If you are interested in creating a mal implementation (or just interested in using mal for something) you are welcome to to join our [Discord](https://discord.gg/CKgnNbJBpF). In addition to the [make-a-lisp process guide](process/guide.md) there is also a [mal/make-a-lisp FAQ](docs/FAQ.md) where I attempt to answer some common questions. **3. Mal is implemented in 89 languages (95 different implementations and 118 runtime modes)** | Language | Creator | | -------- | ------- | | [Ada](#ada) | [Chris Moore](https://github.com/zmower) | | [Ada #2](#ada2) | [Nicolas Boulenguez](https://github.com/asarhaddon) | | [GNU Awk](#gnu-awk) | [Mitsuru Kariya](https://github.com/kariya-mitsuru) | | [Bash 4](#bash-4) | [Joel Martin](https://github.com/kanaka) | | [BASIC](#basic-c64-and-qbasic) (C64 & QBasic) | [Joel Martin](https://github.com/kanaka) | | [BBC BASIC V](#bbc-basic-v) | [Ben Harris](https://github.com/bjh21) | | [C](#c) | [Joel Martin](https://github.com/kanaka) | | [C #2](#c2) | [Duncan Watts](https://github.com/fungiblecog) | | [C++](#c-1) | [Stephen Thirlwall](https://github.com/sdt) | | [C#](#c-2) | [Joel Martin](https://github.com/kanaka) | | [ChucK](#chuck) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Clojure](#clojure) (Clojure & ClojureScript) | [Joel Martin](https://github.com/kanaka) | | [CoffeeScript](#coffeescript) | [Joel Martin](https://github.com/kanaka) | | [Common Lisp](#common-lisp) | [Iqbal Ansari](https://github.com/iqbalansari) | | [Crystal](#crystal) | [Linda_pp](https://github.com/rhysd) | | [D](#d) | [Dov Murik](https://github.com/dubek) | | [Dart](#dart) | [Harry Terkelsen](https://github.com/hterkelsen) | | [Elixir](#elixir) | [Martin Ek](https://github.com/ekmartin) | | [Elm](#elm) | [Jos van Bakel](https://github.com/c0deaddict) | | [Emacs Lisp](#emacs-lisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Erlang](#erlang) | [Nathan Fiedler](https://github.com/nlfiedler) | | [ES6](#es6-ecmascript-2015) (ECMAScript 2015) | [Joel Martin](https://github.com/kanaka) | | [F#](#f) | [Peter Stephens](https://github.com/pstephens) | | [Factor](#factor) | [Jordan Lewis](https://github.com/jordanlewis) | | [Fantom](#fantom) | [Dov Murik](https://github.com/dubek) | | [Fennel](#fennel) | [sogaiu](https://github.com/sogaiu) | | [Forth](#forth) | [Chris Houser](https://github.com/chouser) | | [GNU Guile](#gnu-guile-21) | [Mu Lei](https://github.com/NalaGinrut) | | [GNU Smalltalk](#gnu-smalltalk) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Go](#go) | [Joel Martin](https://github.com/kanaka) | | [Groovy](#groovy) | [Joel Martin](https://github.com/kanaka) | | [Hare](#hare) | [Lou Woell](http://github.com/einsiedlerspiel) | | [Haskell](#haskell) | [Joel Martin](https://github.com/kanaka) | | [Haxe](#haxe-neko-python-c-and-javascript) (Neko, Python, C++, & JS) | [Joel Martin](https://github.com/kanaka) | | [Hy](#hy) | [Joel Martin](https://github.com/kanaka) | | [Io](#io) | [Dov Murik](https://github.com/dubek) | | [Janet](#janet) | [sogaiu](https://github.com/sogaiu) | | [Java](#java-17) | [Joel Martin](https://github.com/kanaka) | | [Java Truffle](#java-using-truffle-for-graalvm) (Truffle/GraalVM) | [Matt McGill](https://github.com/mmcgill) | | [JavaScript](#javascriptnode) ([Demo](http://kanaka.github.io/mal)) | [Joel Martin](https://github.com/kanaka) | | [jq](#jq) | [Ali MohammadPur](https://github.com/alimpfard) | | [Julia](#julia) | [Joel Martin](https://github.com/kanaka) | | [Kotlin](#kotlin) | [Javier Fernandez-Ivern](https://github.com/ivern) | | [LaTeX3](#latex3) | [Nicolas Boulenguez](https://github.com/asarhaddon) | | [LiveScript](#livescript) | [Jos van Bakel](https://github.com/c0deaddict) | | [Logo](#logo) | [Dov Murik](https://github.com/dubek) | | [Lua](#lua) | [Joel Martin](https://github.com/kanaka) | | [GNU Make](#gnu-make-381) | [Joel Martin](https://github.com/kanaka) | | [mal itself](#mal) | [Joel Martin](https://github.com/kanaka) | | [MATLAB](#matlab-gnu-octave-and-matlab) (GNU Octave & MATLAB) | [Joel Martin](https://github.com/kanaka) | | [miniMAL](#minimal) ([Repo](https://github.com/kanaka/miniMAL), [Demo](https://kanaka.github.io/miniMAL/)) | [Joel Martin](https://github.com/kanaka) | | [NASM](#nasm) | [Ben Dudson](https://github.com/bendudson) | | [Nim](#nim-104) | [Dennis Felsing](https://github.com/def-) | | [Object Pascal](#object-pascal) | [Joel Martin](https://github.com/kanaka) | | [Objective C](#objective-c) | [Joel Martin](https://github.com/kanaka) | | [OCaml](#ocaml-4010) | [Chris Houser](https://github.com/chouser) | | [Perl](#perl-5) | [Joel Martin](https://github.com/kanaka) | | [Perl 6](#perl-6) | [Hinrik Örn Sigurðsson](https://github.com/hinrik) | | [PHP](#php-53) | [Joel Martin](https://github.com/kanaka) | | [Picolisp](#picolisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Pike](#pike) | [Dov Murik](https://github.com/dubek) | | [PL/pgSQL](#plpgsql-postgresql-sql-procedural-language) (PostgreSQL) | [Joel Martin](https://github.com/kanaka) | | [PL/SQL](#plsql-oracle-sql-procedural-language) (Oracle) | [Joel Martin](https://github.com/kanaka) | | [PostScript](#postscript-level-23) | [Joel Martin](https://github.com/kanaka) | | [PowerShell](#powershell) | [Joel Martin](https://github.com/kanaka) | | [Prolog](#prolog-logical-language) | [Nicolas Boulenguez](https://github.com/asarhaddon) | | [PureScript](#purescript) | [mrsekut](https://github.com/mrsekut) | | [Python2](#python2) | [Joel Martin](https://github.com/kanaka) | | [Python3](#python3) | [Gavin Lewis](https://github.com/epylar) | | [RPython](#rpython) | [Joel Martin](https://github.com/kanaka) | | [R](#r) | [Joel Martin](https://github.com/kanaka) | | [Racket](#racket-53) | [Joel Martin](https://github.com/kanaka) | | [Rexx](#rexx) | [Dov Murik](https://github.com/dubek) | | [Ruby](#ruby-19) | [Joel Martin](https://github.com/kanaka) | | [Ruby #2](#ruby) | [Ryan Cook](https://github.com/cookrn) | | [Rust](#rust-138) | [Joel Martin](https://github.com/kanaka) | | [Scala](#scala) | [Joel Martin](https://github.com/kanaka) | | [Scheme (R7RS)](#scheme-r7rs) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Skew](#skew) | [Dov Murik](https://github.com/dubek) | | [Standard ML](#sml) | [Fabian Bergström](https://github.com/fabjan) | | [Swift 3](#swift-3) | [Joel Martin](https://github.com/kanaka) | | [Swift 4](#swift-4) | [陆遥](https://github.com/LispLY) | | [Swift 6](#swift-6) | [Oleg Montak](https://github.com/MontakOleg) | | [Tcl](#tcl-86) | [Dov Murik](https://github.com/dubek) | | [TypeScript](#typescript) | [Masahiro Wakame](https://github.com/vvakame) | | [Vala](#vala) | [Simon Tatham](https://github.com/sgtatham) | | [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) | | [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) | | [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) | | [Visual Basic Script](#visual-basic-script) | [刘百超](https://github.com/OldLiu001) | | [WebAssembly](#webassembly-wasm) (wasm) | [Joel Martin](https://github.com/kanaka) | | [Wren](#wren) | [Dov Murik](https://github.com/dubek) | | [XSLT](#xslt) | [Ali MohammadPur](https://github.com/alimpfard) | | [Yorick](#yorick) | [Dov Murik](https://github.com/dubek) | | [Zig](#zig) | [Josh Tobin](https://github.com/rjtobin) | ## Presentations Mal was presented publicly for the first time in a lightning talk at Clojure West 2014 (unfortunately there is no video). See examples/clojurewest2014.mal for the presentation that was given at the conference (yes, the presentation is a mal program). At Midwest.io 2015, Joel Martin gave a presentation on Mal titled "Achievement Unlocked: A Better Path to Language Learning". [Video](https://www.youtube.com/watch?v=lgyOAiRtZGw), [Slides](http://kanaka.github.io/midwest.io.mal/). More recently Joel gave a presentation on "Make Your Own Lisp Interpreter in 10 Incremental Steps" at LambdaConf 2016: [Part 1](https://www.youtube.com/watch?v=jVhupfthTEk), [Part 2](https://www.youtube.com/watch?v=X5OQBMGpaTU), [Part 3](https://www.youtube.com/watch?v=6mARZzGgX4U), [Part 4](https://www.youtube.com/watch?v=dCO1SYR5kDU), [Slides](http://kanaka.github.io/lambdaconf/). ## Building/running implementations The simplest way to run any given implementation is to use docker. Every implementation has a docker image pre-built with language dependencies installed. You can launch the REPL using a convenient target in the top level Makefile (where IMPL is the implementation directory name and stepX is the step to run): ``` make DOCKERIZE=1 "repl^IMPL^stepX" # OR stepA is the default step: make DOCKERIZE=1 "repl^IMPL" ``` ## External / Alternate Implementations The following implementations are maintained as separate projects: ### HolyC * [by Alexander Bagnalla](https://github.com/bagnalla/holyc_mal) ### Rust * [by Tim Morgan](https://github.com/seven1m/mal-rust) * [by vi](https://github.com/vi/mal-rust-vi) - using [Pest](https://pest.rs/) grammar, not using typical Mal infrastructure (cargo-ized steps and built-in converted tests). ### Swift 2 * [by Keith Rollin](https://github.com/kanaka/mal/tree/fbfe678/impls/swift) - This implementation used to be in the repo. However, Swift 2 is no longer easily buildable/testable. ### Q * [by Ali Mohammad Pur](https://github.com/alimpfard/mal/tree/q/impls/q) - The Q implementation works fine but it requires a proprietary manual download that can't be Dockerized (or integrated into the mal CI pipeline) so for now it remains a separate project. ## Other mal Projects * [malc](https://github.com/dubek/malc) - Mal (Make A Lisp) compiler. Compiles a Mal program to LLVM assembly language, then binary. * [malcc](https://github.com/seven1m/malcc) - malcc is an incremental compiler implementation for the Mal language. It uses the Tiny C Compiler as the compiler backend and has full support for the Mal language, including macros, tail-call elimination, and even run-time eval. ["I Built a Lisp Compiler"](https://mpov.timmorgan.org/i-built-a-lisp-compiler/) post about the process. * [frock](https://github.com/chr15m/frock) - Clojure-flavoured PHP. Uses mal/php to run programs. * [flk](https://github.com/chr15m/flk) - A LISP that runs wherever Bash is * [glisp](https://github.com/baku89/glisp) - Self-bootstrapping graphic design tool on Lisp. [Live Demo](https://baku89.com/glisp/) * [mal2py-compiler](https://github.com/jcguu95/mal2py-compiler) - MAL-to-Python. A fork of the python3 implementation that compiles mal to python with a 16x performance improvement on the perf3 synthetic benchmark. ## Implementation Details ### Ada The Ada implementation was developed with GNAT 4.9 on debian. It also compiles unchanged on windows if you have windows versions of git, GNAT and (optionally) make. There are no external dependencies (readline not implemented). ``` cd impls/ada make ./stepX_YYY ``` ### Ada.2 The second Ada implementation was developed with GNAT 8 and links with the GNU readline library. ``` cd impls/ada make ./stepX_YYY ``` ### GNU awk The GNU awk implementation of mal has been tested with GNU awk 4.1.1. ``` cd impls/gawk gawk -O -f stepX_YYY.awk ``` ### Bash 4 ``` cd impls/bash bash stepX_YYY.sh ``` ### BASIC (C64 and QBasic) The BASIC implementation uses a preprocessor that can generate BASIC code that is compatible with both C64 BASIC (CBM v2) or QBasic. The C64 mode has been tested with [cbmbasic](https://github.com/kanaka/cbmbasic) (the patched version is currently required to fix issues with line input) and the QBasic mode has been tested with [FreeBASIC](freebasic.net). Generate C64 code and run it using cbmbasic: ``` cd impls/basic make MODE=cbm stepX_YYY.bas STEP=stepX_YYY basic_MODE=cbm ./run ``` Generate QBasic code, compile using FreeBASIC, and execute it: ``` cd impls/basic make MODE=qbasic stepX_YYY.bas make MODE=qbasic stepX_YYY ./stepX_YYY ``` Thanks to [Steven Syrek](https://github.com/sjsyrek) for the original inspiration for this implementation. ### BBC BASIC V The BBC BASIC V implementation can run in the Brandy interpreter: ``` cd impls/bbc-basic brandy -quit stepX_YYY.bbc ``` Or in ARM BBC BASIC V under RISC OS 3 or later: ``` *Dir bbc-basic.riscos *Run setup *Run stepX_YYY ``` ### C The C implementation of mal requires the following libraries (lib and header packages): glib, libffi6, libgc, and either the libedit or GNU readline library. ``` cd impls/c make ./stepX_YYY ``` ### C.2 The second C implementation of mal requires the following libraries (lib and header packages): libedit, libgc, libdl, and libffi. ``` cd impls/c.2 make ./stepX_YYY ``` ### C++ The C++ implementation of mal requires g++-4.9 or clang++-3.5 and a readline compatible library to build. See the `cpp/README.md` for more details: ``` cd impls/cpp make # OR make CXX=clang++-3.5 ./stepX_YYY ``` ### C# ### The C# implementation of mal has been tested on Linux using the Mono C# compiler (mcs) and the Mono runtime (version 2.10.8.1). Both are required to build and run the C# implementation. ``` cd impls/cs make mono ./stepX_YYY.exe ``` ### ChucK The ChucK implementation has been tested with ChucK 1.3.5.2. ``` cd impls/chuck ./run ``` ### Clojure For the most part the Clojure implementation requires Clojure 1.5, however, to pass all tests, Clojure 1.8.0-RC4 is required. ``` cd impls/clojure lein with-profile +stepX trampoline run ``` ### CoffeeScript ``` sudo npm install -g coffee-script cd impls/coffee coffee ./stepX_YYY ``` ### Common Lisp The implementation has been tested with SBCL, CCL, CMUCL, GNU CLISP, ECL and Allegro CL on Ubuntu 16.04 and Ubuntu 12.04, see the [README](impls/common-lisp/README.org) for more details. Provided you have the dependencies mentioned installed, do the following to run the implementation ``` cd impls/common-lisp make ./run ``` ### Crystal The Crystal implementation of mal has been tested with Crystal 0.26.1. ``` cd impls/crystal crystal run ./stepX_YYY.cr # OR make # needed to run tests ./stepX_YYY ``` ### D The D implementation of mal was tested with GDC 4.8. It requires the GNU readline library. ``` cd impls/d make ./stepX_YYY ``` ### Dart The Dart implementation has been tested with Dart 1.20. ``` cd impls/dart dart ./stepX_YYY ``` ### Emacs Lisp The Emacs Lisp implementation of mal has been tested with Emacs 24.3 and 24.5. While there is very basic readline editing (`` and `C-d` work, `C-c` cancels the process), it is recommended to use `rlwrap`. ``` cd impls/elisp emacs -Q --batch --load stepX_YYY.el # with full readline support rlwrap emacs -Q --batch --load stepX_YYY.el ``` ### Elixir The Elixir implementation of mal has been tested with Elixir 1.0.5. ``` cd impls/elixir mix stepX_YYY # Or with readline/line editing functionality: iex -S mix stepX_YYY ``` ### Elm The Elm implementation of mal has been tested with Elm 0.18.0 ``` cd impls/elm make stepX_YYY.js STEP=stepX_YYY ./run ``` ### Erlang The Erlang implementation of mal requires [Erlang/OTP R17](http://www.erlang.org/download.html) and [rebar](https://github.com/rebar/rebar) to build. ``` cd impls/erlang make # OR MAL_STEP=stepX_YYY rebar compile escriptize # build individual step ./stepX_YYY ``` ### ES6 (ECMAScript 2015) The ES6 / ECMAScript 2015 implementation uses the [babel](https://babeljs.io) compiler to generate ES5 compatible JavaScript. The generated code has been tested with Node 0.12.4. ``` cd impls/es6 make node build/stepX_YYY.js ``` ### F# ### The F# implementation of mal has been tested on Linux using the Mono F# compiler (fsharpc) and the Mono runtime (version 3.12.1). The mono C# compiler (mcs) is also necessary to compile the readline dependency. All are required to build and run the F# implementation. ``` cd impls/fsharp make mono ./stepX_YYY.exe ``` ### Factor The Factor implementation of mal has been tested with Factor 0.97 ([factorcode.org](http://factorcode.org)). ``` cd impls/factor FACTOR_ROOTS=. factor -run=stepX_YYY ``` ### Fantom The Fantom implementation of mal has been tested with Fantom 1.0.70. ``` cd impls/fantom make lib/fan/stepX_YYY.pod STEP=stepX_YYY ./run ``` ### Fennel The Fennel implementation of mal has been tested with Fennel version 0.9.1 on Lua 5.4. ``` cd impls/fennel fennel ./stepX_YYY.fnl ``` ### Forth ``` cd impls/forth gforth stepX_YYY.fs ``` ### GNU Guile 2.1+ ``` cd impls/guile guile -L ./ stepX_YYY.scm ``` ### GNU Smalltalk The Smalltalk implementation of mal has been tested with GNU Smalltalk 3.2.91. ``` cd impls/gnu-smalltalk ./run ``` ### Go The Go implementation of mal requires that go is installed on on the path. The implementation has been tested with Go 1.3.1. ``` cd impls/go make ./stepX_YYY ``` ### Groovy The Groovy implementation of mal requires Groovy to run and has been tested with Groovy 1.8.6. ``` cd impls/groovy make groovy ./stepX_YYY.groovy ``` ### Hare The hare implementation was tested against Hare 0.25.2. ``` cd impls/hare make ./stepX_YYY ``` ### Haskell The Haskell implementation requires the ghc compiler version 7.10.1 or later and also the Haskell parsec and readline (or editline) packages. ``` cd impls/haskell make ./stepX_YYY ``` ### Haxe (Neko, Python, C++ and JavaScript) The Haxe implementation of mal requires Haxe version 3.2 to compile. Four different Haxe targets are supported: Neko, Python, C++, and JavaScript. ``` cd impls/haxe # Neko make all-neko neko ./stepX_YYY.n # Python make all-python python3 ./stepX_YYY.py # C++ make all-cpp ./cpp/stepX_YYY # JavaScript make all-js node ./stepX_YYY.js ``` ### Hy The Hy implementation of mal has been tested with Hy 0.13.0. ``` cd impls/hy ./stepX_YYY.hy ``` ### Io The Io implementation of mal has been tested with Io version 20110905. ``` cd impls/io io ./stepX_YYY.io ``` ### Janet The Janet implementation of mal has been tested with Janet version 1.12.2. ``` cd impls/janet janet ./stepX_YYY.janet ``` ### Java 1.7 The Java implementation of mal requires maven2 to build. ``` cd impls/java mvn compile mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY # OR mvn -quiet exec:java -Dexec.mainClass=mal.stepX_YYY -Dexec.args="CMDLINE_ARGS" ``` ### Java, using Truffle for GraalVM This Java implementation will run on OpenJDK, but can run as much as 30x faster on GraalVM thanks to the Truffle framework. It's been tested with OpenJDK 11, GraalVM CE 20.1.0, and GraalVM CE 21.1.0. ``` cd impls/java-truffle ./gradlew build STEP=stepX_YYY ./run ``` ### JavaScript/Node ``` cd impls/js npm install node stepX_YYY.js ``` ### Julia The Julia implementation of mal requires Julia 0.4. ``` cd impls/julia julia stepX_YYY.jl ``` ### jq Tested against version 1.6, with a lot of cheating in the IO department ``` cd impls/jq STEP=stepA_YYY ./run # with Debug DEBUG=true STEP=stepA_YYY ./run ``` ### Kotlin The Kotlin implementation of mal has been tested with Kotlin 1.0. ``` cd impls/kotlin make java -jar stepX_YYY.jar ``` ### LaTeX3 The LaTeX3 implementation of mal has been tested with pdfTeX 3.141592653-2.6-1.40.24. Self hosting is too slow for any sensible timeout, and crashes in step4, apparently because of hard-coded limitations. Anybody working on this should uncomment the two lines of (slow) debugging options in the step file, and export DEBUG=1 (for more output than tests accept). ### LiveScript The LiveScript implementation of mal has been tested with LiveScript 1.5. ``` cd impls/livescript make node_modules/.bin/lsc stepX_YYY.ls ``` ### Logo The Logo implementation of mal has been tested with UCBLogo 6.0. ``` cd impls/logo logo stepX_YYY.lg ``` ### Lua The Lua implementation of mal has been tested with Lua 5.3.5 The implementation requires luarocks to be installed. ``` cd impls/lua make # to build and link linenoise.so and rex_pcre.so ./stepX_YYY.lua ``` ### Mal Running the mal implementation of mal involves running stepA of one of the other implementations and passing the mal step to run as a command line argument. ``` cd impls/IMPL IMPL_STEPA_CMD ../mal/stepX_YYY.mal ``` ### GNU Make 3.81 ``` cd impls/make make -f stepX_YYY.mk ``` ### NASM The NASM implementation of mal is written for x86-64 Linux, and has been tested with Linux 3.16.0-4-amd64 and NASM version 2.11.05. ``` cd impls/nasm make ./stepX_YYY ``` ### Nim 1.0.4 The Nim implementation of mal has been tested with Nim 1.0.4. ``` cd impls/nim make # OR nimble build ./stepX_YYY ``` ### Object Pascal The Object Pascal implementation of mal has been built and tested on Linux using the Free Pascal compiler version 2.6.2 and 2.6.4. ``` cd impls/objpascal make ./stepX_YYY ``` ### Objective C The Objective C implementation of mal has been built and tested on Linux using clang/LLVM 3.6. It has also been built and tested on OS X using Xcode 7. ``` cd impls/objc make ./stepX_YYY ``` ### OCaml 4.01.0 ``` cd impls/ocaml make ./stepX_YYY ``` ### MATLAB (GNU Octave and MATLAB) The MatLab implementation has been tested with GNU Octave 4.2.1. It has also been tested with MATLAB version R2014a on Linux. Note that MATLAB is a commercial product. ``` cd impls/matlab ./stepX_YYY octave -q --no-gui --no-history --eval "stepX_YYY();quit;" matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY();quit;" # OR with command line arguments octave -q --no-gui --no-history --eval "stepX_YYY('arg1','arg2');quit;" matlab -nodisplay -nosplash -nodesktop -nojvm -r "stepX_YYY('arg1','arg2');quit;" ``` ### miniMAL [miniMAL](https://github.com/kanaka/miniMAL) is small Lisp interpreter implemented in less than 1024 bytes of JavaScript. To run the miniMAL implementation of mal you need to download/install the miniMAL interpreter (which requires Node.js). ``` cd impls/miniMAL # Download miniMAL and dependencies npm install export PATH=`pwd`/node_modules/minimal-lisp/:$PATH # Now run mal implementation in miniMAL miniMAL ./stepX_YYY ``` ### Perl 5 The Perl 5 implementation should work with perl 5.19.3 and later. For readline line editing support, install Term::ReadLine::Perl or Term::ReadLine::Gnu from CPAN. ``` cd impls/perl perl stepX_YYY.pl ``` ### Perl 6 The Perl 6 implementation was tested on Rakudo Perl 6 2016.04. ``` cd impls/perl6 perl6 stepX_YYY.pl ``` ### PHP 5.3 The PHP implementation of mal requires the php command line interface to run. ``` cd impls/php php stepX_YYY.php ``` ### Picolisp The Picolisp implementation requires libreadline and Picolisp 3.1.11 or later. ``` cd impls/picolisp ./run ``` ### Pike The Pike implementation was tested on Pike 8.0. ``` cd impls/pike pike stepX_YYY.pike ``` ### PL/pgSQL (PostgreSQL SQL Procedural Language) The PL/pgSQL implementation of mal requires a running PostgreSQL server (the "kanaka/mal-test-plpgsql" docker image automatically starts a PostgreSQL server). The implementation connects to the PostgreSQL server and create a database named "mal" to store tables and stored procedures. The wrapper script uses the psql command to connect to the server and defaults to the user "postgres" but this can be overridden with the PSQL_USER environment variable. A password can be specified using the PGPASSWORD environment variable. The implementation has been tested with PostgreSQL 9.4. ``` cd impls/plpgsql ./wrap.sh stepX_YYY.sql # OR PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql ``` ### PL/SQL (Oracle SQL Procedural Language) The PL/SQL implementation of mal requires a running Oracle DB server (the "kanaka/mal-test-plsql" docker image automatically starts an Oracle Express server). The implementation connects to the Oracle server to create types, tables and stored procedures. The default SQL\*Plus logon value (username/password@connect_identifier) is "system/oracle" but this can be overridden with the ORACLE_LOGON environment variable. The implementation has been tested with Oracle Express Edition 11g Release 2. Note that any SQL\*Plus connection warnings (user password expiration, etc) will interfere with the ability of the wrapper script to communicate with the DB. ``` cd impls/plsql ./wrap.sh stepX_YYY.sql # OR ORACLE_LOGON=myuser/mypass@ORCL ./wrap.sh stepX_YYY.sql ``` ### PostScript Level 2/3 The PostScript implementation of mal requires Ghostscript to run. It has been tested with Ghostscript 9.10. ``` cd impls/ps gs -q -dNODISPLAY -I./ stepX_YYY.ps ``` ### PowerShell The PowerShell implementation of mal requires the PowerShell script language. It has been tested with PowerShell 6.0.0 Alpha 9 on Linux. ``` cd impls/powershell powershell ./stepX_YYY.ps1 ``` ### Prolog The Prolog implementation uses some constructs specific to SWI-Prolog, includes readline support and has been tested on Debian GNU/Linux with version 8.2.1. ``` cd impls/prolog swipl stepX_YYY ``` ### PureScript The PureScript implementation requires the spago compiler version 0.20.2. ``` cd impls/purs make node ./stepX_YYY.js ``` ### Python2 This implementation only uses python2 features, but avoids incompatibilities with python3. ### Python3 This implementation is checked for style and types (flake8, pylint, mypy). It reports all errors with details. It demonstrates iterators, decorators, functional tools, chain maps, dataclasses, introspection, match statements, assignement expressions. ### RPython You must have [rpython](https://rpython.readthedocs.org/) on your path (included with [pypy](https://bitbucket.org/pypy/pypy/)). ``` cd impls/rpython make # this takes a very long time ./stepX_YYY ``` ### R The R implementation of mal requires R (r-base-core) to run. ``` cd impls/r make libs # to download and build rdyncall Rscript stepX_YYY.r ``` ### Racket (5.3) The Racket implementation of mal requires the Racket compiler/interpreter to run. ``` cd impls/racket ./stepX_YYY.rkt ``` ### Rexx The Rexx implementation of mal has been tested with Regina Rexx 3.6. ``` cd impls/rexx make rexx -a ./stepX_YYY.rexxpp ``` ### Ruby (1.9+) ``` cd impls/ruby ruby stepX_YYY.rb ``` ### Ruby #2 A second Ruby implementation with the following goals: - No global variables - No modification (monkey-patching) of core Ruby classes - Modularized into the `Mal` module namespace ``` cd impls/ruby.2 ruby stepX_YYY.rb ``` ### Rust (1.38+) The rust implementation of mal requires the rust compiler and build tool (cargo) to build. ``` cd impls/rust cargo run --release --bin stepX_YYY ``` ### Scala ### Install scala and sbt (http://www.scala-sbt.org/0.13/tutorial/Installing-sbt-on-Linux.html): ``` cd impls/scala sbt 'run-main stepX_YYY' # OR sbt compile scala -classpath target/scala*/classes stepX_YYY ``` ### Scheme (R7RS) ### The Scheme implementation of MAL has been tested with Chibi-Scheme 0.10, Kawa 3.1.1, Gauche 0.9.6, CHICKEN 5.1.0, Sagittarius 0.9.7, Cyclone 0.32.0 (Git version) and Foment 0.4 (Git version). You should be able to get it running on other conforming R7RS implementations after figuring out how libraries are loaded and adjusting the `Makefile` and `run` script accordingly. ``` cd impls/scheme # chibi scheme_MODE=chibi ./run # kawa make kawa scheme_MODE=kawa ./run # gauche scheme_MODE=gauche ./run # chicken make chicken scheme_MODE=chicken ./run # sagittarius scheme_MODE=sagittarius ./run # cyclone make cyclone scheme_MODE=cyclone ./run # foment scheme_MODE=foment ./run ``` ### Skew ### The Skew implementation of mal has been tested with Skew 0.7.42. ``` cd impls/skew make node stepX_YYY.js ``` ### Standard ML (Poly/ML, MLton, Moscow ML) The Standard ML implementation of mal requires an [SML97](https://github.com/SMLFamily/The-Definition-of-Standard-ML-Revised) implementation. The Makefile supports Poly/ML, MLton, Moscow ML, and has been tested with Poly/ML 5.8.1, MLton 20210117, and Moscow ML version 2.10. ``` cd impls/sml # Poly/ML make sml_MODE=polyml ./stepX_YYY # MLton make sml_MODE=mlton ./stepX_YYY # Moscow ML make sml_MODE=mosml ./stepX_YYY ``` ### Swift 3 The Swift 3 implementation of mal requires the Swift 3.0 compiler. It has been tested with Swift 3 Preview 3. ``` cd impls/swift3 make ./stepX_YYY ``` ### Swift 4 The Swift 4 implementation of mal requires the Swift 4.0 compiler. It has been tested with Swift 4.2.3 release. ``` cd impls/swift4 make ./stepX_YYY ``` ### Swift 5 The Swift 5 implementation of mal requires the Swift 5.0 compiler. It has been tested with Swift 5.1.1 release. ``` cd impls/swift6 swift run stepX_YYY ``` ### Tcl 8.6 The Tcl implementation of mal requires Tcl 8.6 to run. For readline line editing support, install tclreadline. ``` cd impls/tcl tclsh ./stepX_YYY.tcl ``` ### TypeScript The TypeScript implementation of mal requires the TypeScript 2.2 compiler. It has been tested with Node.js v6. ``` cd impls/ts make node ./stepX_YYY.js ``` ### Vala The Vala implementation of mal has been tested with the Vala 0.40.8 compiler. You will need to install `valac` and `libreadline-dev` or equivalent. ``` cd impls/vala make ./stepX_YYY ``` ### VHDL The VHDL implementation of mal has been tested with GHDL 0.29. ``` cd impls/vhdl make ./run_vhdl.sh ./stepX_YYY ``` ### Vimscript The Vimscript implementation of mal requires Vim 8.0 to run. ``` cd impls/vimscript ./run_vimscript.sh ./stepX_YYY.vim ``` ### Visual Basic.NET ### The VB.NET implementation of mal has been tested on Linux using the Mono VB compiler (vbnc) and the Mono runtime (version 2.10.8.1). Both are required to build and run the VB.NET implementation. ``` cd impls/vb make mono ./stepX_YYY.exe ``` ### Visual Basic Script ### The VBScript implementation of mal has been tested on Windows 10 1909. `install.vbs` can help you install the requirements (.NET 2.0 3.0 3.5). If you havn't install `.NET 2.0 3.0 3.5`, it will popup a window for installation. If you already installed that, it will do nothing. ``` cd impls\vbs install.vbs cscript -nologo stepX_YYY.vbs ``` ### WebAssembly (wasm) ### The WebAssembly implementation is written in [Wam](https://github.com/kanaka/wam) (WebAssembly Macro language) and runs under several different non-web embeddings (runtimes): [node](https://nodejs.org), [wasmtime](https://github.com/CraneStation/wasmtime), [wasmer](https://wasmer.io), [wax](https://github.com/kanaka/wac), [wace](https://github.com/kanaka/wac), [warpy](https://github.com/kanaka/warpy). ``` cd impls/wasm # node make wasm_MODE=node ./run.js ./stepX_YYY.wasm # wasmtime make wasm_MODE=wasmtime wasmtime --dir=./ --dir=../ --dir=/ ./stepX_YYY.wasm # wasmer make wasm_MODE=wasmer wasmer run --dir=./ --dir=../ --dir=/ ./stepX_YYY.wasm # wax make wasm_MODE=wax wax ./stepX_YYY.wasm # wace make wasm_MODE=wace_libc wace ./stepX_YYY.wasm # warpy make wasm_MODE=warpy warpy --argv --memory-pages 256 ./stepX_YYY.wasm ``` ### XSLT The XSLT implementation of mal is written with XSLT 3 and tested on Saxon 9.9.1.6 Home Edition. ``` cd impls/xslt STEP=stepX_YY ./run ``` ### Wren The Wren implementation of mal was tested on Wren 0.2.0. ``` cd impls/wren wren ./stepX_YYY.wren ``` ### Yorick The Yorick implementation of mal was tested on Yorick 2.2.04. ``` cd impls/yorick yorick -batch ./stepX_YYY.i ``` ### Zig The Zig implementation of mal was tested on Zig 0.5. ``` cd impls/zig zig build stepX_YYY ``` ## Running tests The top level Makefile has a number of useful targets to assist with implementation development and testing. The `help` target provides a list of the targets and options: ``` make help ``` ### Functional tests The are almost 800 generic functional tests (for all implementations) in the `tests/` directory. Each step has a corresponding test file containing tests specific to that step. The `runtest.py` test harness launches a Mal step implementation and then feeds the tests one at a time to the implementation and compares the output/return value to the expected output/return value. * To run all the tests across all implementations (be prepared to wait): ``` make test ``` * To run all tests against a single implementation: ``` make "test^IMPL" # e.g. make "test^clojure" make "test^js" ``` * To run tests for a single step against all implementations: ``` make "test^stepX" # e.g. make "test^step2" make "test^step7" ``` * To run tests for a specific step against a single implementation: ``` make "test^IMPL^stepX" # e.g make "test^ruby^step3" make "test^ps^step4" ``` ### Self-hosted functional tests * To run the functional tests in self-hosted mode, you specify `mal` as the test implementation and use the `MAL_IMPL` make variable to change the underlying host language (default is JavaScript): ``` make MAL_IMPL=IMPL "test^mal^step2" # e.g. make "test^mal^step2" # js is default make MAL_IMPL=ruby "test^mal^step2" make MAL_IMPL=python3 "test^mal^step2" ``` ### Starting the REPL * To start the REPL of an implementation in a specific step: ``` make "repl^IMPL^stepX" # e.g make "repl^ruby^step3" make "repl^ps^step4" ``` * If you omit the step, then `stepA` is used: ``` make "repl^IMPL" # e.g make "repl^ruby" make "repl^ps" ``` * To start the REPL of the self-hosted implementation, specify `mal` as the REPL implementation and use the `MAL_IMPL` make variable to change the underlying host language (default is JavaScript): ``` make MAL_IMPL=IMPL "repl^mal^stepX" # e.g. make "repl^mal^step2" # js is default make MAL_IMPL=ruby "repl^mal^step2" make MAL_IMPL=python3 "repl^mal" ``` ### Performance tests Warning: These performance tests are neither statistically valid nor comprehensive; runtime performance is a not a primary goal of mal. If you draw any serious conclusions from these performance tests, then please contact me about some amazing oceanfront property in Kansas that I'm willing to sell you for cheap. * To run performance tests against a single implementation: ``` make "perf^IMPL" # e.g. make "perf^js" ``` * To run performance tests against all implementations: ``` make "perf" ``` ### Generating language statistics * To report line and byte statistics for a single implementation: ``` make "stats^IMPL" # e.g. make "stats^js" ``` ## Dockerized testing Every implementation directory contains a Dockerfile to create a docker image containing all the dependencies for that implementation. In addition, the top-level Makefile contains support for running the tests target (and perf, stats, repl, etc) within a docker container for that implementation by passing *"DOCKERIZE=1"* on the make command line. For example: ``` make DOCKERIZE=1 "test^js^step3" ``` Existing implementations already have docker images built and pushed to the docker registry. However, if you wish to build or rebuild a docker image locally, the toplevel Makefile provides a rule for building docker images: ``` make "docker-build^IMPL" ``` **Notes**: * Docker images are named *"ghcr.io/kanaka/mal-test-IMPL"* * JVM-based language implementations (Groovy, Java, Clojure, Scala): you will probably need to run this command once manually first `make DOCKERIZE=1 "repl^IMPL"` before you can run tests because runtime dependencies need to be downloaded to avoid the tests timing out. These dependencies are downloaded to dot-files in the /mal directory so they will persist between runs. ## License Mal (make-a-lisp) is licensed under the MPL 2.0 (Mozilla Public License 2.0). See LICENSE.txt for more details. ================================================ FILE: ci.sh ================================================ #!/usr/bin/env bash set -ex ACTION=${1} IMPL=${2} die() { local ret=$1; shift; echo >&2 "${*}"; exit $ret; } # Environment variable configuration BUILD_IMPL=${BUILD_IMPL:-${IMPL}} if [ "${DO_SELF_HOST}" ]; then MAL_IMPL=${IMPL} IMPL=mal fi if [ "${DO_HARD}" ]; then TEST_OPTS="${TEST_OPTS} --hard" fi raw_mode_var=${MAL_IMPL:-${IMPL}}_MODE mode_var=${raw_mode_var/-/__} mode_var=${mode_var/./__} mode_val=${!mode_var} log_prefix="${ACTION}${REGRESS:+-regress}-${IMPL}${mode_val:+-${mode_val}}${MAL_IMPL:+-${MAL_IMPL}}" TEST_OPTS="${TEST_OPTS} -vv --debug-file ../../${log_prefix}.debug" TEST_OPTS="${TEST_OPTS} --continue-after-fail" step_summary() { echo "${*}" if [ "${GITHUB_STEP_SUMMARY}" ]; then echo "${*}" >> "${GITHUB_STEP_SUMMARY}" fi } img_base="${MAL_IMPL:-${IMPL}}" img_impl="${img_base%%-mal}" img_name="mal-test-$(echo "${img_impl}" | tr '[:upper:]' '[:lower:]')" img_ver=$(./voom-like-version.sh impls/${img_impl}/Dockerfile) IMAGE="ghcr.io/kanaka/${img_name}:${img_ver}" # If NO_DOCKER is blank then run make in a docker image MAKE="make ${mode_val:+${mode_var}=${mode_val}}" if [ -z "${NO_DOCKER}" ]; then # We could just use make DOCKERIZE=1 instead but that does add # non-trivial startup overhead for each step. MAKE="docker run -i -u $(id -u) -v `pwd`:/mal ${IMAGE} ${MAKE}" fi # Log everything below this point: exec &> >(tee ./${log_prefix}.log) if [ "${NO_PERF}" -a "${ACTION}" = "perf" ]; then die 0 "Skipping perf test" fi if [ "${NO_SELF_HOST}" -a "${DO_SELF_HOST}" ]; then die 0 "Skipping ${ACTION} of ${MAL_IMPL} self-host" fi if [ "${NO_SELF_HOST_PERF}" -a "${DO_SELF_HOST}" -a "${ACTION}" = "perf" ]; then die 0 "Skipping only perf test for ${MAL_IMPL} self-host" fi echo "ACTION: ${ACTION}" echo "IMPL: ${IMPL}" echo "BUILD_IMPL: ${BUILD_IMPL}" echo "MAL_IMPL: ${MAL_IMPL}" echo "TEST_OPTS: ${TEST_OPTS}" echo "IMAGE: ${IMAGE}" echo "MAKE: ${MAKE}" case "${ACTION}" in docker-build-push) if ! docker pull ${IMAGE}; then step_summary "${BUILD_IMPL} - building ${IMAGE}" make "docker-build^${BUILD_IMPL}" step_summary "${BUILD_IMPL} - built ${IMAGE}" if [ "${GITHUB_REPOSITORY}" = "kanaka/mal" ] && [ "${GITHUB_REF}" = "refs/heads/master" ]; then docker push ${IMAGE} step_summary "${BUILD_IMPL} - pushed ${IMAGE}" fi fi ;; build) # rpython often fails on step9 in compute_vars_longevity # so build step9, then continue with the full build if [ "${BUILD_IMPL}" = "rpython" ]; then ${MAKE} -C "impls/${BUILD_IMPL}" step9_try || true fi ${MAKE} -C "impls/${BUILD_IMPL}" ;; test|perf) [ "${ACTION}" = "perf" ] && STEP= if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \ ${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \ ${REGRESS:+REGRESS=${REGRESS}} \ ${HARD:+HARD=${HARD}} \ ${DEFERRABLE:+DEFERRABLE=${DEFERRABLE}} \ ${OPTIONAL:+OPTIONAL=${OPTIONAL}} \ ${ACTION}^${IMPL}${STEP:+^${STEP}}; then # show debug-file path on error echo "Full debug log is at: ${log_prefix}.debug" false fi ;; esac ================================================ FILE: docs/FAQ.md ================================================ # Mal/Make-a-Lisp FAQ ### Why did you create mal/make-a-lisp? ### OR Why the name "mal"? ### OR Why? ### OR Wat? In November of 2013, Alan Dipert gave a [lightning talk at Clojure/conj](https://www.youtube.com/watch?v=bmHTFo2Rf2w#t=28m55s) about [gherkin](https://github.com/alandipert/gherkin), a Lisp implemented in bash. His presentation led me to ask myself the question of whether a Lisp could be created using the GNU Make macro language. As you have probably guessed, the answer to that question is yes. Interestingly, the current pedagogical/educational purpose of mal happened due to a semantic naming accident (naming is such a fraught task in computer science). If I am remembering correctly, the name "mal" original meant "MAke Lisp". I do not remember precisely why I continued to create more implementations, apart from the fact that it was a fun challenge, but after the make implementation, many of the others were relatively easy. At some point during that process, I realized that the multiple implementations and incremental steps (which was originally just for my own clarity) was a useful learning tool and so the "mal" name became a double entendre for "Make, A Lisp" and "make-a-lisp" (and eventually just the latter given that the make implementation is now just a small part of the whole). ### Why is some code split into steps and some code not? The split between code that goes in steps and code that goes into other files is not completely arbitrary (a bit arbitrary, but not completely). My rule of thumb is something like this: if the code is specific and necessary for implementing a Lisp then it belongs in the step files. If the purpose of the code is for implementing new dynamic data-types/objects and the functions or methods that operate on those types, then it goes in separate files. If the target language has types and functions that resemble mal types, then those files tend to be very small or non-existent. Examples: * the mal implementation has no types, reader, printer files and has a trivial core file (just to hoist underlying functions) * the Clojure implementation has no types file and a fairly trivial core file * ruby types and the functions that operate on them are very "Lispy" so the Ruby types file and core file are very small. The env file is somewhat more arbitrary, however, it is a self-contained module that is implemented early and changes very little after that, so I decided to separate it. Also, for languages that have hierarchical maps/dictionaries (e.g. Javascript objects/prototype chain), you do not necessarily need an env file. Another way of summarizing this answer is that the step files represent the core of what makes something a Lisp, the rest of the modules are just language specific details (they may be the harder than the Lisp part, but that is due to the nature of the target language not because of Lisp functionality per se). ### Why are the mal/make-a-lisp steps structured the way they are? ### OR Why is X functionality in step Y instead of step Z? There is no single consistent rule that I have used to determine which functionality goes in which step and the arrangement has changed numerous times since the beginning of the project. There are several different goals that I try and balance in determining which functionality goes into which step: * **Optimize Lisp learning**: I want developers who are unfamiliar with Lisp to be able to use the project and guide to learn about Lisp without becoming overwhelmed. In many Lisp introductions, concepts like quoting and homoiconicity (i.e. a user exposed eval function) are introduced early. But these are fairly foreign to most other languages so they are introduced in later steps in mal. I also try to not to concentrate too many Lisp concepts in a single step. So many steps contain one or two Lisp concepts plus some core function additions that support those concepts. * **Optimize implementation language learning (equal-ish step sizing)**: I try to structure the steps so that the target implementation can be learned incrementally. This goal is the one that has caused me to refactor the steps the most. Different languages have different areas that they optimize and make simple for the developer. For example, in Java (prior to 8) and PostScript creating the equivalent of anonymous functions and function closures is painful. In other languages, function closures are trivial, but IO and error handling are tedious when you are first learning the language (I am looking at you Haskell). So this goal is really about trying to balance step size across multiple languages. * **Practical results early and continuous feedback**: it is a scientific fact that many small rewards are more motivating than a single large reward (citation intentionally omitted, get a small reward by googling it yourself). Each step in mal adds new functionality that can actually be exercised by the implementer and, just as importantly, easily tested. Also, the step structure of mal/make-a-lisp is not perfect. It never will be perfect, but there are some areas that could be improved. The most glaring problem is that step1 is on the heavy/large size because in most languages you have to implement a good portion of the reader/printer before you can begin using/testing the step. The compromise I have settled on for now is to put extra detail in the process guide for step1 and to be clear that many of the types are deferrable until later. But I am always open to suggestions. ### Will you add my new implementation? Absolutely! I want mal to have a idiomatic implementation in every programming language. Here is a quick checklist of what you need to do to merge a new implementation: - Follow the incremental layout (no extracted eval code) - Dockerfile that defines requirements for building and running you implementation and has this LABEL and ``` LABEL org.opencontainers.image.source=https://github.com/kanaka/mal ``` - Makefile: if it is a compiled/built implementation then add rules for building each step and a clean rule. - Add your implementation to IMPLS.yml - if takes a long time to build add `SLOW: 1` - Add implemenation to `Makefile.impls` - Add to `IMPLS` variable (alphabetical order) - Add a `*_STEP_TO_PROG` line for resolving artifacts to build and run (if not compiled, just point to the step file itself) - Update the top-level README.md: - Increment the implementation and runtime counts - Add to the table of implementations - Add a build/run notes sub-section to the `Implementation Details` section - Create a pull request (this will trigger CI and allow review) - Make sure that CI passes for your implementation including self-hosting (some esoteric languages can have an exception to this) Here are more detailed guidelines for getting your implementation accepted into the main repository: * Your implementation should follow the existing mal steps and structure: Lisp-centric code (eval, eval_ast, quasiquote, macroexpand) in the step files, other code in reader, printer, env, and core files. See [code layout rationale](#code_split) above. I encourage you to create implementations that take mal in new directions for your own learning and experimentation, but for it to be included in the main repository I ask that it follows the steps and structure. * Your implementation should stick as much as possible to the accepted idioms and conventions in that language. Try to create an implementation that will not make an expert in that language say "Woah, that's a strange way of doing things". And on that topic, I make no guarantees that the existing implementations are particularly idiomatic in their target languages (improvements are welcome). However, if it is clear to me that your implementation is not idiomatic in a given language then I will probably ask you to improve it first. * Your implementation needs to be complete enough to self-host. This means that all the mandatory tests should pass in both direct and self-hosted modes: ```bash make "test^[IMPL_NAME]" make MAL_IMPL=[IMPL_NAME] "test^mal" ``` You do not need to pass the final optional tests for stepA that are marked as optional and not needed for self-hosting (except for the `time-ms` function which is needed to run the micro-benchmark tests). * Create a `Dockerfile` in your directory that installs all the packages necessary to build and run your implementation. In order to integrate fully with the Github Actions CI workflow, the `Dockerfile` needs to include the following boilerplate (with your name, email, and implementation filled in): ``` MAINTAINER Your Name LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: Your_Implementation" ``` In addition, the docker image should provide python3 (with a python symlink to it) to enable running tests using the image. Here is the typical `Dockerfile` template you should use if your implementation does not require a special base distro: ``` FROM ubuntu:24.04 MAINTAINER Your Name LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: Your_Implementation" ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -sf /usr/bin/python3 /usr/bin/python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## ... Your packages ... ``` * Build and tag your docker image. The image tag will have the form `ghcr.io/kanaka/mal-test-[IMPL_NAME]:[VOOM_VERSION]`. ``` make "docker-build^[IMPL_NAME]" * The top-level Makefile has support for building/testing using the docker image with the `DOCKERIZE` flag: ```bash make DOCKERIZE=1 "test^[IMPL_NAME]" make DOCKERIZE=1 MAL_IMPL=[IMPL_NAME] "test^mal" ``` * Make sure the CI build and test scripts pass locally: ```bash ./ci.sh build [IMPL_NAME] ./ci.sh test [IMPL_NAME] ``` * Push your code to a branch and make sure that the automated Github Actions CI passes for your implementation. * If you are creating a new implementation for an existing implementation (or somebody beats you to the punch while you are working on it), there is still a chance I will merge your implementation. If you can make a compelling argument that your implementation is more idiomatic or significantly better in some way than the existing implementation then I may replace the existing one. However, if your approach is different or unique from the existing implementation, there is still a good chance I will merge your implementation side-by-side with the existing one. At the very least, even if I decide not to merge your implementation, I am certainly willing to link to you implementation once it is completed. * You do not need to implement line editing (i.e. readline) functionality for your implementation, however, it is a nice convenience for users of your implementation and I personally find it saves a lot of time when I am creating a new implementation to have line edit support early in the process. ### Why do some mal forms end in "\*" or "!" (swap!, def!, let\*, etc)? The forms that end in a bang mutate something: * **def!** mutates the current environment * **swap!** and **reset!** mutate an atom to refer to a new value The forms that end in a star are similar to similar Clojure forms but are more limited in functionality: * **fn\*** does not do parameter destructuring and only supports a single body form. * **let\*** does not do parameter destructuring * **try\*** and **catch\*** do not support type matching of exceptions ================================================ FILE: docs/Hints.md ================================================ # Mal/Make-a-Lisp Implementation Hints ### How do I get milliseconds since epoch for the "time-ms" function? ### Does the "time-ms" function have to return millisecond since epoch? Most languages usually have some way to do this natively even though it might be buried deeply in the language. If you are having trouble finding how to do this in your target language, consider asking the question on stackoverflow (if it has not been asked already) or asking on a discussion channel for your language because there is a good chance somebody there knows how and will answer quickly (if there is a native way at all). As a last resort you can always shell out and call the date command like this: ``` date +%s%3N ``` There are currently two implementations where this method was necessary (probably): bash and make. Unfortunately this method is limited to Linux/UNIX. Also, "time-ms" technically just needs to return accurate milliseconds since some arbitrary point in time (even program start) in order to be used correctly for timing/benchmarking. For consistency it is best if it returns epoch milliseconds, but this is not strictly required if you language limitations make it difficult (e.g. size limit of integers). ### How do I implement core/native functions if my language does not have any sort of function references (function pointers, closures, lambdas, etc)? ### How do I implement mal functions in step4 if I do not have function references? There are very few language that do not have any sort of function references so I suggest asking about the specific problem you are having on stackoverflow or a discussion channel for your language. In the rare case where you have a language without some sort of function reference abstraction, then you may have to implement a single function with a large switch statement (or equivalent) that calls out to the appropriate native core function ("+", "list", "throw", etc). In other words, you create a function that implements "function references" rather than using a feature of your language. You will still need to store the symbol names for those function in the base REPL environment but you will have some sort of tagging or marker that will indicate to the `EVAL` function that it should call your "big switch" function. In addition, if your language has no sort of closure/anonymous function capability (note that with sufficient object oriented features you can implement closure like functionality), then in step4 you will need to borrow the way that functions are implemented from step5. In other words, functions become a normal data type that stores the function body (AST), the parameter list and the environment at the time the function is defined. When the function is invoked, `EVAL` will then evaluate these stored items rather than invoking a function closure. It is less convenient to have to do this at step4, but the bright side is that step5 will be simpler because you just have to implement the TCO loop because you have already refactored how functions are stored in step4. ### How do I implement terminal input and output in a language which does not have standard I/O capabilities? If your target language has some way to get data in and out while it is running (even if it is not standard terminal or file I/O) then you will need to create some sort of wrapper script (see `vimscript/run_vimscript.sh`) or call out to a shell script (see `make/readline.mk` and `make/util.mk`) or implement some other "appropriate" hack to to get the data in and out. As long as your implementation can be used with the test runner and the hack is just for working around I/O limitations in your target language, it is considered legitimate for upstream inclusion. ### How do I read the command-line arguments if my language runtime doesn't support access to them? Most languages give access to the command-line arguments that were passed to the program, either as an argument to the `main` function (like `argc` and `argv` in C) or as a global variable (like `sys.argv` in Python). If your target language doesn't have such mechanisms, consider adding a wrapper script that will read the command-line arguments that were passed to the script and pass them to the program in a way that the program can read. This might be through an environment variable (if the target language allows reading from environment variables) or through a temporary file. ### How can I implement the reader without using a mutable object? You do not need a mutable object, but you do need someway of keeping track of the current position in the token list. One way to implement this is to pass both the token list and the current position to the reader functions (read_form, read_list, read_atom, etc) and return both the parsed AST and the new token list position. If your language does not allow multiple values to be returned from functions then you may need to define a data structure to return both the new position and the parsed AST together. In other words, the pseudo-code would look something like this: ``` ast, position = read_list(tokens, position) ``` --- Answers for the following questions are TBD. ### How do I implement slurp in a language without the ability to read raw file data? ### How do I support raising/throwing arbitrary objects in a language that does not support that? ### What do I do if my implementation language only supports string exceptions? ================================================ FILE: docs/TODO ================================================ General: * update language graph code and data - pull from GHA instead of Travis * Add self-hosted CI mode/variable * Go through PRs. Close or update. * Add quick checklist for merging upstream to FAQ: * Add PR template/checklist. * Update diagrams to reflect the merged eval-ast/macroexpand process. * Check that implementations are actually running self-hosted. Check for "mal-user>" prompt or something. * update language graph code and data * pull from GHA instead of Travis * update get-changed-files * use GITHUB_OUTPUT instead of set-output * update version of node - Fix self-hosted implementations #662 - Fix wasm modes wax and wace_libc - Fix wasm perf3 hang/OOM All/multiple Implementations: - Add step3 and step4 tests. Fix powershell, jq, and xslt with binding/closures. https://github.com/kanaka/mal/issues/645 --------------------------------------------- Other ideas for All: - redefine (defmacro!) as (def! foo (macro*)) - Fix/implement interop in more implementations - propagate/print errors when self-hosted - metadata on symbols (as per Clojure) - metadata as a map only. ^ merges metadata in the reader itself. Line numbers in metadata from reader. - protocols! - https://github.com/pixie-lang/pixie - http://www.toccata.io/2015/01/Mapping/ - namespaces - environments first class: *ENV*, *outer* defined by env-new - namespaces is *namespaces* map in environment which maps namespace names to other environments. - def! become an alias for (env-set! *ENV* 'sym value) - Namespace lookup: go up the environment hierarchy until a *namespaces* map is found with the namespace name being looked up. Then the symbol would be looked up starting in the namespace environment. Need protocols first probably. - multi-line REPL read - explicit recur in loops (for error checking) - gensym reader inside quasiquote - standalone executables --------------------------------------------- Bash: - explore using ${!prefix*} syntax (more like make impl) - GC - maybe make it work more like basic/wasm C: - come up with better way to do 20 vararg code C#: - accumulates line breaks with mal/clojurewest2014.mal - interop: http://www.ckode.dk/programming/eval-in-c-yes-its-possible/ CoffeeScript: - make target to compile to JS Go: - consider variable arguments in places where it makes sense https://gobyexample.com/variadic-functions Haskell: - TCO using seq/bang patterns: http://stackoverflow.com/questions/9149183/tail-optimization-guarantee-loop-encoding-in-haskell - immediately exits mal/clojurewest2014.mal ("\/" exception) Java: - build step, don't use mvn in run script - Use gradle instead of mvn http://blog.paralleluniverse.co/2014/05/01/modern-java/ Javascript: - interop: adopt techniques from miniMAL Make: - allow '_' in make variable names - hash-map with space in key string - errors should propagate up from within load-file - GC: explore using "undefine" directive in Make 3.82 Mal: - line numbers in errors - step5_tco miniMAL: - figure out why {} literals are "static"/persistent ObjPascal: - verify that GC/reference counting works - fix comment by itself error at REPL plpgsql: - maybe combine wrap.sh and run Perl: - fix metadata on native functions - fix extra line breaks at REPL Postscript: - add negative numbers - fix blank line after comments - fix command line arg processing (doesn't run file specified) Powershell: - convert function with "abc_def" to "abc-def" - remove extraneous return statements at end of functions - remove unnecessary semi-colons - use ArrayList instead of Array for performance - new test to test Keys/keys as hash-map key - test *? predicates with nil R: - tracebacks in errors - fix running from different directory Racket - metadata on collections Rust: - fix 'make all' invocation of cargo build Scala - readline - fix exception when finished running something on command line VHDL: - combine run_vhdl.sh and run vimscript: - combine run_vimscript.sh and run ================================================ FILE: docs/cheatsheet.html ================================================

Make-A-Lisp Cheatsheet

Step 1 Step 6 
reader.EXT:
  Reader(tokens) object: position, next(), peek()
  tokenize:  /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/
  read_atom: int, float, string (escaped), keyword, nil, true, false, symbol
  read_list: repeatedly read_form until end token (EOF is error)
  read_form: expand reader macros, read_list (vector/maps too), or read_atom
  read_str:  tokenize, error if no tokens, call read_form(Reader(tokens))
printer.EXT:
  pr_str(ast, print_readably):
    - map pr_str across collections
    - unescape strings if print_readably
step1_read_print.EXT:
  main(args): loop: writeline PRINT(EVAL(READ(readline()), ""))

core.EXT:
  read-string: call reader.read_str
  slurp: return file content as a string
  atom, atom?, deref, reset!, swap!: atom functions
step6_file.EXT:
  main(args):
    - add eval and *ARGV* to repl_env
    - define load-file using rep
    - if args, set *ARGV* to rest(args) and call load-file with args[0]
   
Step 2 Step 7 
step2_eval.EXT:
  eval_ast(ast, env): lookup symbols in env, map EVAL across collections
  EVAL(ast, env):
    - if not list?(ast), return eval_ast(ast, env)
    - otherwise apply (ast is a list):
      el = eval_ast(ast, env)
      return el[0](rest(el))
  main(args): loop: writeline PRINT(EVAL(READ(readline()), {+: add, ...}))




core.EXT:
  cons, concat: sequence functions
step7_quote.EXT:
  quasiquote(ast):
    - ast is empty or not a list   -> (quote ast)
    - (unquote FOO)                -> FOO
    - ((splice-unquote FOO) BAR..) -> (concat FOO quasiquote(BAR...))
    - (FOO BAR...)                 -> (cons FOO quasiquote(BAR...))
  EVAL(ast, env):
    - quote      -> return ast[1]
    - quasiquote -> set ast to quasiquote(ast[1]), loop
   
Step 3 Step 8 
env.EXT:
  Env(outer) object: data, set(k, v), find(k), get(k)
step3_env.EXT:
  eval_ast(ast, env): switch to env.get for symbol lookup
  EVAL(ast, env):
    - def!  -> return env.set(ast[1], EVAL(ast[2], env))
    - let*  -> create new env let_env
               for each ODD/EVEN pair in ast[1]:
                 let_env.set(ODD, EVAL(EVEN, let_env))
               return EVAL(ast[2], let_env)
  main(args): populate repl_env with numeric functions using repl_env.set

core.EXT:
  nth, first, rest: sequence functions
step8_macros.EXT:
  macroexpand(ast, env):
    - while env.get(ast[0]) is a macro: ast = env.get(ast[0])(rest(ast))
  EVAL(ast, env):
    - before apply section, add ast = macroexpand(ast, env)
    - defmacro!   -> same as def!, but set mal function macro flag
    - macroexpand -> return macroexpand(ast[1], env)
   
Step 4 Step 9 
env.EXT:
  Env(outer, binds, exprs) object: map binds to exprs, handle "&" as variadic
core.EXT:
  =: recursive compare of collections
  pr-str, str: return pr_str(arg, true) join " ", pr_str(arg, false) join ""
  prn, println: print pr_str(arg, true) join "", pr_str(arg, false) join ""
  <, <=, >, >=, +, -, *, /: numeric comparison and numeric operations
  list, list?, empty?, count: sequence functions
step4_do_if_fn.EXT:
  EVAL(ast, env):
    - do  -> return last element of eval_ast(ast, env)
    - if  -> if EVAL(ast[1], env): return EVAL(ast[2], env)
             else                : return EVAL(ast[3], env)
    - fn* -> return closure:
               (args) -> EVAL(ast[2], new Env(env, ast[1], args))
  main(args): populate repl_env with core functions, define not using rep()

core.EXT:
  throw: raise mal value as exception (maybe wrap in native exception)
  vector, vector?: sequence functions
  hash-map, get, contains?, keys, vals: hash-map functions
  assoc, dissoc: immutable hash-map transform functions
  apply(f, args..., last): return f(concat(args, last))
  map(f, args): return list of mapping f on each args
step9_try.EXT:
  EVAL(ast, env):
    - try* -> try EVAL(ast[1], env)
                catch exception exc (unwrap if necessary):
                  new err_env with ast[2][1] symbol bound to exc
                  EVAL(ast[2][2], err_env)
   
Step 5 Step A 
step5_tco.EXT:
  EVAL(ast, env):
    - top level loop in EVAL
    - let*  -> set env to let_env, set ast to ast[2], loop
    - do    -> eval_ast of middle elements, sets ast to last element, loop
    - if    -> set ast to ast[2] or ast[3] (or nil) depending condition, loop
    - fn*   -> return new mal function type f with:
                f.ast=ast[2], f.params=ast[1], f.env=env
    - apply -> el = eval_ast(ast, env)
               f = el[0]
               if f is a mal function: ast = f.ast and env = f.env, loop
               else                  : return el[0](rest(el))


core.EXT:
  string?: true if string
  readline: prompt and read a line of input (synchronous)
  time-ms: return milliseconds since epoch (1970-1-1)
  conj, seq: type specific sequence functions
  meta, with-meta: metadata functions
step9_try.EXT:
  EVAL(ast, env):
    - set *host-language* in repl_env to host language name
  main(args): rep("(println (str \"Mal [\" *host-language* \"]\"))")
   
================================================ FILE: docs/exercises.md ================================================ # Exercises to learn MAL The process introduces LISP by describing the internals of selected low-level constructs. As a complementary and more traditional approach, you may want to solve the following exercises in the MAL language itself, using any of the existing implementations. You are encouraged to use the shortcuts defined in the step files (`not`...) and `the `lib/` subdirectory (`reduce`...) whenever you find that they increase the readability. The difficulty is progressive in each section, but they focus on related topics and it is recommended to start them in parallel. Some solutions are given in the `examples` directory. Feel free to submit new solutions, or new exercises. ## Replace parts of the process with native constructs Once you have a working implementation, you may want to implement parts of the process inside the MAL language itself. This has no other purpose than learning the MAL language. Once it exists, a built-in implementation will always be more efficient than a native implementation. Also, the functions described in MAL process are selected for educative purposes, so portability accross implementations does not matter much. You may easily check your answers by passing them directly to the interpreter. They will hide the built-in functions carrying the same names, and the usual tests will check them. ``` make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' test^IMPL^stepA ``` - Implement `nil?`, `true?`, `false?`, `empty?` and `sequential` with another built-in function. - Implement `>`, `<=` and `>=` with `<`. - Implement `list`, `vec`, `prn`, `hash-map` and `swap!` as non-recursive functions. - Implement `count`, `nth`, `map`, `concat` and `conj` with the empty constructor `()`, `empty?`, `cons`, `first` and `rest`. You may use `or` to make the definition of `nth` a bit less ugly, but avoid `cond` because its definition refers to `nth`. Let `count` and `nth` benefit from tail call optimization. Try to replace explicit recursions with calls to `reduce` and `foldr`. Once you have tested your solution, you should comment at least `nth`. Many implementations, for example `foldr` in `core.mal`, rely on an efficient `nth` built-in function. - Implement the `do` special as a non-recursive function. The special form will hide your implementation, so in order to test it, you will need to give it another name and adapt the test accordingly. - Implement quoting with macros. The same remark applies. - Implement most of `let*` as a macro that uses `fn*` and recursion. The same remark applies. A macro is necessary because a function would attempt to evaluate the first argument. Once your answer passes most tests and you understand which part is tricky, you should search for black magic recipes on the web. Few of us mortals are known to have invented a full solution on their own. - Implement `apply`. - Implement maps using lists. - Recall how maps must be evaluated. - In the tests, you may want to replace `{...}` with `(hash-map ...)`. - An easy solution relies on lists alterning keys and values, so that the `hash-map` is only a list in reverse order so that the last definition takes precedence during searches. - As a more performant solution will use lists to construct trees, and ideally keep them balanced. You will find examples in most teaching material about functional languages. - Recall that `dissoc` is an optional feature. One you can implement dissoc is by assoc'ing a replacement value that is a magic delete keyword (e.g.: `__..DELETED..__`) which allows you to shadow values in the lower levels of the structure. The hash map functions have to detect that and do the right thing. e.g. `(keys ...)` might have to keep track of deleted values as it is scanning the tree and not add those keys when it finds them further down the tree. - Implement macros within MAL. ## More folds - Compute the sum of a sequence of numbers. - Compute the product of a sequence of numbers. - Compute the logical conjunction ("and") and disjunction ("or") of a sequence of MAL values interpreted as boolean values. For example, `(conjunction [true 1 0 "" "a" nil true {}])` should evaluate to `false` or `nil` because of the `nil` element. Why are folds not the best solution here, in terms of average performances? - Does "-2-3-4" translate to `(reduce - 0 [2 3 4])`? - Suggest better solutions for `(reduce str "" xs)` and `(reduce concat [] xs)`. - What does `(reduce (fn* [acc _] acc) xs)` nil answer? - The answer is `(fn* [xs] (reduce (fn* [_ x] x) nil xs))`. What was the question? - What is the intent of `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)`? Why is it the wrong answer? - Though `(sum (map count xs))` or `(count (apply concat xs))` can be considered more readable, implement the same effect with a single loop. - Compute the maximal length in a list of lists. - How would you name `(fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs))`? ================================================ FILE: docs/graph/README.md ================================================ # Mal Implementation Stats Graph ## Updating the data * Install prerequisites: For ubuntu: ``` sudo apt-get install gh sudo apt-get golang ``` For macos: ``` brew install gh brew install go ``` * Create logs dir and enter graph dir: ``` mkdir -p docs/graph/logs cd docs/graph/logs ``` * Install npm deps ``` npm install ``` * Clone and build loccount: ``` git clone https://gitlab.com/esr/loccount make -C loccount ``` * Auth with github: ``` gh auth login ``` * Download artifacts from a recent full and successful workflow run: ``` # list workflow runs $ gh run list --repo kanaka/mal # Download recent full successful run: $ gh run download 10598199016 --repo kanaka/mal ``` * Run the [StackOverflow tags query](https://data.stackexchange.com/stackoverflow/query/edit/1013465) and then download the CSV link: ``` curl https://data.stackexchange.com/stackoverflow/csv/2267200 -o so-tags.csv ``` * Remove/clean all generated files: ``` ( cd ../.. && git ls-files --others impls/ | xargs rm ) ``` * Download GitHub and StackOverflow data and generate the final combined data set: ``` PATH=$PATH:$(pwd)/loccount time VERBOSE=1 node ./collect_data.js logs/ all_data.json ``` ================================================ FILE: docs/graph/all_data.json ================================================ { "ada": { "dir": "ada", "name": "Ada", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 10, "perf2": 44, "perf3": 974, "pull_count": 261, "pull_rank": 66, "push_count": 19718, "push_rank": 60, "star_count": 554, "star_rank": 68, "sloc": 3547, "files": 19, "author_name": "Chris Moore", "author_url": "https://github.com/zmower", "so_count": 2416, "so_rank": 57, "lloc": 2199 }, "ada.2": { "dir": "ada.2", "name": "Ada #2", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 1, "perf3": 84457, "pull_count": 261, "pull_rank": 67, "push_count": 19718, "push_rank": 61, "star_count": 554, "star_rank": 69, "sloc": 2277, "files": 30, "author_name": "Nicolas Boulenguez", "author_url": "https://github.com/asarhaddon", "so_count": 2416, "so_rank": 58, "lloc": 1437 }, "awk": { "dir": "awk", "name": "GNU Awk", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 7, "perf2": 24, "perf3": 1356, "pull_count": 2, "pull_rank": 71, "push_count": null, "push_rank": null, "star_count": 13346, "star_rank": 54, "sloc": 2203, "files": 7, "author_name": "Miutsuru Kariya", "author_url": "https://github.com/kariya-mitsuru", "so_count": 33144, "so_rank": 30, "lloc": 0 }, "bash": { "dir": "bash", "name": "Bash 4", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 787, "perf2": 3465, "perf3": 11, "pull_count": 921358, "pull_rank": 16, "push_count": 3851409, "push_rank": 16, "star_count": 2264769, "star_rank": 18, "sloc": 1110, "files": 7, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 156259, "so_rank": 17, "lloc": 0 }, "basic": { "dir": "basic", "name": "BASIC", "syntax": "OTHER", "type_check": "Static", "modes": [ "cbm", "qbasic" ], "perf1": 6, "perf2": 19, "perf3": 1675, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1960, "files": 13, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 858, "so_rank": 65, "lloc": 1697 }, "bbc-basic": { "dir": "bbc-basic", "name": "BBC BASIC V", "syntax": "OTHER", "type_check": "Static", "modes": [], "perf1": 60, "perf2": 290, "perf3": 149, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1355, "files": 7, "author_name": "Ben Harris", "author_url": "https://github.com/bjh21", "so_count": 9, "so_rank": 85, "lloc": 1353 }, "c": { "dir": "c", "name": "C", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 36416, "pull_count": 1411773, "pull_rank": 13, "push_count": 5888004, "push_rank": 11, "star_count": 4085282, "star_rank": 10, "sloc": 1990, "files": 15, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 405875, "so_rank": 10, "lloc": 1069 }, "c.2": { "dir": "c.2", "name": "C #2", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 3, "perf3": 15820, "pull_count": 1411773, "pull_rank": 14, "push_count": 5888004, "push_rank": 12, "star_count": 4085282, "star_rank": 11, "sloc": 3326, "files": 16, "author_name": "Duncan Watts", "author_url": "https://github.com/fungiblecog", "so_count": 405875, "so_rank": 11, "lloc": 1677 }, "cpp": { "dir": "cpp", "name": "C++", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 33490, "pull_count": 2960837, "pull_rank": 7, "push_count": 10016021, "push_rank": 8, "star_count": 5571338, "star_rank": 8, "sloc": 2021, "files": 19, "author_name": "Stephen Thirlwall", "author_url": "https://github.com/sdt", "so_count": 887548, "so_rank": 7, "lloc": 945 }, "cs": { "dir": "cs", "name": "C#", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 4, "perf2": 5, "perf3": 24285, "pull_count": 1264911, "pull_rank": 15, "push_count": 4838573, "push_rank": 14, "star_count": 2687097, "star_rank": 17, "sloc": 1185, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 1652013, "so_rank": 5, "lloc": 582 }, "chuck": { "dir": "chuck", "name": "ChucK", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 24, "perf2": 70, "perf3": 142, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 2509, "files": 87, "author_name": "Vasilij Schneidermann", "author_url": "https://github.com/wasamasa", "so_count": 22, "so_rank": 83, "lloc": 963 }, "clojure": { "dir": "clojure", "name": "Clojure", "syntax": "Lisp", "type_check": "Dynamic", "modes": [ "clj", "cljs" ], "perf1": 10, "perf2": 34, "perf3": 7675, "pull_count": 118302, "pull_rank": 27, "push_count": 556345, "push_rank": 26, "star_count": 296560, "star_rank": 25, "sloc": 408, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 17703, "so_rank": 37, "lloc": 0 }, "coffee": { "dir": "coffee", "name": "CoffeeScript", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 2, "perf2": 6, "perf3": 33096, "pull_count": 135423, "pull_rank": 26, "push_count": 596268, "push_rank": 25, "star_count": 587936, "star_rank": 21, "sloc": 447, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 9742, "so_rank": 42, "lloc": 0 }, "common-lisp": { "dir": "common-lisp", "name": "Common Lisp", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 2, "perf3": 35135, "pull_count": 9583, "pull_rank": 49, "push_count": 85811, "push_rank": 44, "star_count": 52545, "star_rank": 39, "sloc": 1000, "files": 11, "author_name": "Iqbal Ansari", "author_url": "https://github.com/iqbalansari", "so_count": 6341, "so_rank": 49, "lloc": 0 }, "crystal": { "dir": "crystal", "name": "Crystal", "syntax": "OTHER", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 1, "perf3": 64175, "pull_count": 11247, "pull_rank": 48, "push_count": 35005, "push_rank": 52, "star_count": 29422, "star_rank": 47, "sloc": 944, "files": 8, "author_name": "Linda_pp", "author_url": "https://github.com/rhysd", "so_count": 662, "so_rank": 67, "lloc": 0 }, "d": { "dir": "d", "name": "D", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 0, "perf3": 41431, "pull_count": 8541, "pull_rank": 52, "push_count": 71800, "push_rank": 49, "star_count": 23317, "star_rank": 48, "sloc": 1281, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 2644, "so_rank": 56, "lloc": 549 }, "dart": { "dir": "dart", "name": "Dart", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 5, "perf2": 10, "perf3": 17398, "pull_count": 182518, "pull_rank": 22, "push_count": 245271, "push_rank": 34, "star_count": 280006, "star_rank": 26, "sloc": 935, "files": 8, "author_name": "Harry Terkelsen", "author_url": "https://github.com/hterkelsen", "so_count": 94667, "so_rank": 23, "lloc": 467 }, "elixir": { "dir": "elixir", "name": "Elixir", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 17, "perf2": 43, "perf3": 839, "pull_count": 118076, "pull_rank": 28, "push_count": 266735, "push_rank": 33, "star_count": 216415, "star_rank": 27, "sloc": 669, "files": 10, "author_name": "Martin Ek", "author_url": "https://github.com/ekmartin", "so_count": 9601, "so_rank": 44, "lloc": 0 }, "elm": { "dir": "elm", "name": "Elm", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 19, "perf2": 55, "perf3": 1971, "pull_count": 12978, "pull_rank": 46, "push_count": 59552, "push_rank": 51, "star_count": 38261, "star_rank": 43, "sloc": 2404, "files": 13, "author_name": "Jos van Bakel", "author_url": "https://github.com/c0deaddict", "so_count": 1895, "so_rank": 61, "lloc": 0 }, "elisp": { "dir": "elisp", "name": "Emacs Lisp", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 14, "perf3": 5600, "pull_count": 69374, "pull_rank": 34, "push_count": 366344, "push_rank": 29, "star_count": 207304, "star_rank": 30, "sloc": 725, "files": 7, "author_name": "Vasilij Schneidermann", "author_url": "https://github.com/wasamasa", "so_count": 3771, "so_rank": 54, "lloc": 0 }, "erlang": { "dir": "erlang", "name": "Erlang", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 32, "perf2": 62, "perf3": 344, "pull_count": 79420, "pull_rank": 31, "push_count": 285722, "push_rank": 31, "star_count": 149139, "star_rank": 31, "sloc": 1130, "files": 8, "author_name": "Nathan Fiedler", "author_url": "https://github.com/nlfiedler", "so_count": 9674, "so_rank": 43, "lloc": 0 }, "es6": { "dir": "es6", "name": "ES6", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 3, "perf3": 30500, "pull_count": 6754454, "pull_rank": 2, "push_count": 24043941, "push_rank": 2, "star_count": 25547072, "star_rank": 2, "sloc": 474, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 519108, "so_rank": 8, "lloc": 0 }, "fsharp": { "dir": "fsharp", "name": "F#", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 6, "perf2": 6, "perf3": 35952, "pull_count": 32510, "pull_rank": 37, "push_count": 145642, "push_rank": 38, "star_count": 44240, "star_rank": 42, "sloc": 1074, "files": 11, "author_name": "Peter Stephens", "author_url": "https://github.com/pstephens", "so_count": 18116, "so_rank": 36, "lloc": 2 }, "fennel": { "dir": "fennel", "name": "Fennel", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 2301, "perf2": 7241, "perf3": 4, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1, "files": 1, "author_name": "sogaiu", "author_url": "https://github.com/sogaiu", "so_count": 3, "so_rank": 88, "lloc": 0 }, "factor": { "dir": "factor", "name": "Factor", "syntax": "Stack", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 2, "perf3": 40360, "pull_count": 421, "pull_rank": 63, "push_count": 10507, "push_rank": 66, "star_count": 100, "star_rank": 71, "sloc": 394, "files": 8, "author_name": "Jordan Lewis", "author_url": "https://github.com/jordanlewis", "so_count": 65, "so_rank": 78, "lloc": 0 }, "fantom": { "dir": "fantom", "name": "Fantom", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 7, "perf2": 16, "perf3": 109845, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 733, "files": 9, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 63, "so_rank": 79, "lloc": 0 }, "forth": { "dir": "forth", "name": "Forth", "syntax": "Stack", "type_check": "OTHER", "modes": [], "perf1": 37, "perf2": 147, "perf3": 291, "pull_count": 32, "pull_rank": 69, "push_count": 1926, "push_rank": 68, "star_count": 632, "star_rank": 67, "sloc": 1415, "files": 8, "author_name": "Chris Houser", "author_url": "https://github.com/chouser", "so_count": 299, "so_rank": 72, "lloc": 0 }, "guile": { "dir": "guile", "name": "GNU Guile", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 2, "perf3": 15138, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 735, "files": 9, "author_name": "Mu Lei", "author_url": "https://github.com/NalaGinrut", "so_count": 262, "so_rank": 73, "lloc": 0 }, "gnu-smalltalk": { "dir": "gnu-smalltalk", "name": "GNU Smalltalk", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 7, "perf2": 21, "perf3": 1709, "pull_count": 13447, "pull_rank": 44, "push_count": 69848, "push_rank": 50, "star_count": 4823, "star_rank": 61, "sloc": 1005, "files": 10, "author_name": "Vasilij Schneidermann", "author_url": "https://github.com/wasamasa", "so_count": 115, "so_rank": 75, "lloc": 0 }, "go": { "dir": "go", "name": "Go", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 0, "perf3": 72067, "pull_count": 2795669, "pull_rank": 8, "push_count": 5100633, "push_rank": 13, "star_count": 7730404, "star_rank": 7, "sloc": 1412, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 73691, "so_rank": 24, "lloc": 673 }, "groovy": { "dir": "groovy", "name": "Groovy", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 64, "perf2": 127, "perf3": 1685, "pull_count": 141340, "pull_rank": 24, "push_count": 473823, "push_rank": 28, "star_count": 148765, "star_rank": 32, "sloc": 672, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 30295, "so_rank": 31, "lloc": 0 }, "haskell": { "dir": "haskell", "name": "Haskell", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 6, "perf3": 6558, "pull_count": 114458, "pull_rank": 29, "push_count": 732765, "push_rank": 23, "star_count": 334357, "star_rank": 24, "sloc": 712, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 51449, "so_rank": 27, "lloc": 0 }, "haxe": { "dir": "haxe", "name": "Haxe", "syntax": "C", "type_check": "Static", "modes": [ "neko", "python", "cpp", "js" ], "perf1": 2, "perf2": 4, "perf3": 62403, "pull_count": 13654, "pull_rank": 43, "push_count": 74768, "push_rank": 48, "star_count": 33782, "star_rank": 44, "sloc": 1089, "files": 11, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 1635, "so_rank": 62, "lloc": 454 }, "hy": { "dir": "hy", "name": "Hy", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 10, "perf2": 37, "perf3": 1030, "pull_count": 8, "pull_rank": 70, "push_count": null, "push_rank": null, "star_count": 308, "star_rank": 70, "sloc": 388, "files": 7, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 101, "so_rank": 76, "lloc": 0 }, "io": { "dir": "io", "name": "Io", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 113, "perf2": 423, "perf3": 78, "pull_count": 72, "pull_rank": 68, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 538, "files": 7, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 17620, "so_rank": 38, "lloc": 0 }, "java": { "dir": "java", "name": "Java", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 2, "perf2": 10, "perf3": 182169, "pull_count": 4219162, "pull_rank": 5, "push_count": 15173396, "push_rank": 5, "star_count": 9695699, "star_rank": 5, "sloc": 1511, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 1919299, "so_rank": 4, "lloc": 696 }, "java-truffle": { "dir": "java-truffle", "name": "Java Truffle", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 5, "perf2": 13, "perf3": 163894, "pull_count": 4219162, "pull_rank": 6, "push_count": 15173396, "push_rank": 6, "star_count": 9695699, "star_rank": 6, "sloc": 5827, "files": 12, "author_name": "Matt McGill", "author_url": "https://github.com/mmcgill", "so_count": 897, "so_rank": 64, "lloc": 2811 }, "js": { "dir": "js", "name": "JavaScript", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 4, "perf3": 43462, "pull_count": 6754454, "pull_rank": 1, "push_count": 24043941, "push_rank": 1, "star_count": 25547072, "star_rank": 1, "sloc": 856, "files": 10, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 4346255, "so_rank": 1, "lloc": 0 }, "jq": { "dir": "jq", "name": "jq", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": null, "perf2": null, "perf3": 0, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 88, "files": 2, "author_name": "Ali MohammadPur", "author_url": "https://github.com/alimpfard", "so_count": 6778, "so_rank": 48, "lloc": 0 }, "janet": { "dir": "janet", "name": "Janet", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 7, "perf2": 26, "perf3": 1846, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1, "files": 1, "author_name": "sogaiu", "author_url": "https://github.com/sogaiu", "so_count": 3, "so_rank": 89, "lloc": 0 }, "julia": { "dir": "julia", "name": "Julia", "syntax": "Algol", "type_check": "Dynamic", "modes": [], "perf1": 115, "perf2": 13, "perf3": 8375, "pull_count": 41276, "pull_rank": 36, "push_count": 174375, "push_rank": 36, "star_count": 54307, "star_rank": 38, "sloc": 560, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 12754, "so_rank": 40, "lloc": 0 }, "kotlin": { "dir": "kotlin", "name": "Kotlin", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 8, "perf2": 19, "perf3": 114806, "pull_count": 368780, "pull_rank": 20, "push_count": 853297, "push_rank": 21, "star_count": 577249, "star_rank": 22, "sloc": 741, "files": 8, "author_name": "Javier Fernandez-Ivern", "author_url": "https://github.com/ivern", "so_count": 96732, "so_rank": 21, "lloc": 0 }, "latex3": { "dir": "latex3", "name": "LaTeX3", "syntax": "Other", "type_check": "Dynamic", "modes": [], "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1131, "files": 7, "author_name": "Nicolas Boulenguez", "author_url": "https://github.com/asarhaddon", "so_count": 11509, "so_rank": 41, "lloc": 0 }, "livescript": { "dir": "livescript", "name": "LiveScript", "syntax": "ML", "type_check": "Dynamic", "modes": [], "perf1": 4, "perf2": 10, "perf3": 16804, "pull_count": 327, "pull_rank": 64, "push_count": 8343, "push_rank": 67, "star_count": 9631, "star_rank": 56, "sloc": 783, "files": 8, "author_name": "Jos van Bakel", "author_url": "https://github.com/c0deaddict", "so_count": 66, "so_rank": 77, "lloc": 0 }, "logo": { "dir": "logo", "name": "Logo", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 179, "perf2": 777, "perf3": 48, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 805, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 47, "so_rank": 81, "lloc": 0 }, "lua": { "dir": "lua", "name": "Lua", "syntax": "Algol", "type_check": "Dynamic", "modes": [], "perf1": 3931, "perf2": 16211, "perf3": 2, "pull_count": 149093, "pull_rank": 23, "push_count": 765952, "push_rank": 22, "star_count": 386542, "star_rank": 23, "sloc": 925, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 22832, "so_rank": 34, "lloc": 0 }, "make": { "dir": "make", "name": "GNU Make", "syntax": "OTHER", "type_check": "OTHER", "modes": [], "perf1": 270, "perf2": 1329, "perf3": 18, "pull_count": 97160, "pull_rank": 30, "push_count": 286234, "push_rank": 30, "star_count": 101953, "star_rank": 34, "sloc": 798, "files": 12, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 25601, "so_rank": 33, "lloc": 0 }, "mal": { "dir": "mal", "name": "mal itself", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 72, "perf2": 321, "perf3": 156, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 206, "files": 4, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 0, "so_rank": 91, "lloc": 0 }, "matlab": { "dir": "matlab", "name": "MATLAB", "syntax": "Algol", "type_check": "Dynamic", "modes": [], "perf1": 598, "perf2": 2036, "perf3": 17, "pull_count": 6111, "pull_rank": 54, "push_count": 130167, "push_rank": 39, "star_count": 17596, "star_rank": 51, "sloc": 1103, "files": 17, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 94997, "so_rank": 22, "lloc": 0 }, "miniMAL": { "dir": "miniMAL", "name": "miniMAL", "syntax": "JSON", "type_check": "Dynamic", "modes": [], "perf1": 144, "perf2": 524, "perf3": 72, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 727, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 0, "so_rank": 92, "lloc": 0 }, "nasm": { "dir": "nasm", "name": "NASM", "syntax": "OTHER", "type_check": "OTHER", "modes": [], "perf1": 1, "perf2": 3, "pull_count": 14978, "pull_rank": 41, "push_count": 126728, "push_rank": 40, "star_count": 54612, "star_rank": 37, "sloc": 6166, "files": 9, "author_name": "Ben Dudson", "author_url": "https://github.com/bendudson", "so_count": 5255, "so_rank": 52, "lloc": 0 }, "nim": { "dir": "nim", "name": "Nim", "syntax": "Python", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 56321, "pull_count": 5093, "pull_rank": 55, "push_count": 17440, "push_rank": 62, "star_count": 16110, "star_rank": 52, "sloc": 625, "files": 7, "author_name": "Dennis Felsing", "author_url": "https://github.com/def-", "so_count": 687, "so_rank": 66, "lloc": 0 }, "objpascal": { "dir": "objpascal", "name": "Object Pascal", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 3, "perf2": 12, "perf3": 3596, "pull_count": 9438, "pull_rank": 50, "push_count": 95092, "push_rank": 42, "star_count": 48783, "star_rank": 40, "sloc": 1553, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 67138, "so_rank": 26, "lloc": 967 }, "objc": { "dir": "objc", "name": "Objective C", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 5, "perf2": 19, "perf3": 1958, "pull_count": 290475, "pull_rank": 21, "push_count": 1326999, "push_rank": 19, "star_count": 3444492, "star_rank": 14, "sloc": 1121, "files": 16, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 292176, "so_rank": 13, "lloc": 511 }, "ocaml": { "dir": "ocaml", "name": "OCaml", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 39621, "pull_count": 71286, "pull_rank": 33, "push_count": 242743, "push_rank": 35, "star_count": 131717, "star_rank": 33, "sloc": 541, "files": 7, "author_name": "Chris Houser", "author_url": "https://github.com/chouser", "so_count": 7644, "so_rank": 47, "lloc": 0 }, "perl": { "dir": "perl", "name": "Perl", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 3, "perf2": 12, "perf3": 3315, "pull_count": 138992, "pull_rank": 25, "push_count": 720857, "push_rank": 24, "star_count": 210224, "star_rank": 29, "sloc": 836, "files": 9, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 68197, "so_rank": 25, "lloc": 418 }, "perl6": { "dir": "perl6", "name": "Perl 6", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 55, "perf2": 147, "perf3": 311, "pull_count": 4302, "pull_rank": 56, "push_count": 24807, "push_rank": 57, "star_count": 1314, "star_rank": 65, "sloc": 460, "files": 7, "author_name": "Hinrik Örn Sigurðsson", "author_url": "https://github.com/hinrik", "so_count": 2054, "so_rank": 60, "lloc": 155 }, "php": { "dir": "php", "name": "PHP", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 2, "perf3": 12551, "pull_count": 2791184, "pull_rank": 9, "push_count": 10165121, "push_rank": 7, "star_count": 4379644, "star_rank": 9, "sloc": 951, "files": 10, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 1467322, "so_rank": 6, "lloc": 524 }, "picolisp": { "dir": "picolisp", "name": "Picolisp", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 3, "perf3": 10702, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 561, "files": 9, "author_name": "Vasilij Schneidermann", "author_url": "https://github.com/wasamasa", "so_count": 8, "so_rank": 86, "lloc": 0 }, "pike": { "dir": "pike", "name": "Pike", "syntax": "C", "type_check": "OTHER", "modes": [], "perf1": 2, "perf2": 6, "perf3": 7568, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1, "files": 1, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 14, "so_rank": 84, "lloc": 0 }, "plpgsql": { "dir": "plpgsql", "name": "PL/pgSQL", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 324, "perf2": 1673, "perf3": 28, "pull_count": 16616, "pull_rank": 40, "push_count": 111156, "push_rank": 41, "star_count": 29471, "star_rank": 46, "sloc": 1883, "files": 11, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 4386, "so_rank": 53, "lloc": 0 }, "plsql": { "dir": "plsql", "name": "PL/SQL", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": null, "perf2": null, "perf3": 0, "pull_count": 7172, "pull_rank": 53, "push_count": 31314, "push_rank": 55, "star_count": 6361, "star_rank": 59, "sloc": 2223, "files": 11, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 29113, "so_rank": 32, "lloc": 0 }, "powershell": { "dir": "powershell", "name": "PowerShell", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 624, "perf2": 2076, "perf3": 17, "pull_count": 75193, "pull_rank": 32, "push_count": 284307, "push_rank": 32, "star_count": 210859, "star_rank": 28, "sloc": 812, "files": 7, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 118255, "so_rank": 19, "lloc": 0 }, "prolog": { "dir": "prolog", "name": "Prolog", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 15, "perf2": 68, "perf3": 648, "pull_count": 638, "pull_rank": 62, "push_count": 34091, "push_rank": 53, "star_count": 4179, "star_rank": 62, "sloc": 591, "files": 8, "author_name": "Nicolas Boulenguez", "author_url": "https://github.com/asarhaddon", "so_count": 13462, "so_rank": 39, "lloc": 237 }, "ps": { "dir": "ps", "name": "PostScript", "syntax": "Stack", "type_check": "Dynamic", "modes": [], "perf1": 11, "perf2": 54, "perf3": 963, "pull_count": 1816, "pull_rank": 61, "push_count": 13598, "push_rank": 64, "star_count": 1272, "star_rank": 66, "sloc": 1245, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 535, "so_rank": 69, "lloc": 0 }, "purs": { "dir": "purs", "name": "PureScript", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 41, "perf2": 110, "perf3": 1758, "pull_count": 12980, "pull_rank": 45, "push_count": 23297, "push_rank": 59, "star_count": 15237, "star_rank": 53, "sloc": 13, "files": 2, "author_name": "mrsekut", "author_url": "https://github.com/mrsekut", "so_count": 601, "so_rank": 68, "lloc": 0 }, "python2": { "dir": "python2", "name": "Python2", "syntax": "Python", "type_check": "Dynamic", "modes": [], "perf1": 3, "perf2": 11, "perf3": 4088, "pull_count": 6523874, "pull_rank": 3, "push_count": 19048234, "push_rank": 3, "star_count": 12495438, "star_rank": 3, "sloc": 552, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 2301019, "so_rank": 3, "lloc": 0 }, "python3": { "dir": "python3", "name": "Python3", "syntax": "Python", "type_check": "Dynamic", "modes": [], "perf1": 4, "perf2": 12, "perf3": 2834, "pull_count": 6523874, "pull_rank": 4, "push_count": 19048234, "push_rank": 4, "star_count": 12495438, "star_rank": 4, "sloc": 867, "files": 7, "author_name": "Gavin Lewis", "author_url": "https://github.com/epylar", "so_count": 2549011, "so_rank": 2, "lloc": 0 }, "rpython": { "dir": "rpython", "name": "RPython", "syntax": "Python", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 219999, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1004, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 62, "so_rank": 80, "lloc": 0 }, "r": { "dir": "r", "name": "R", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 37, "perf2": 114, "perf3": 376, "pull_count": 53300, "pull_rank": 35, "push_count": 522906, "push_rank": 27, "star_count": 95252, "star_rank": 35, "sloc": 736, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 508699, "so_rank": 9, "lloc": 0 }, "racket": { "dir": "racket", "name": "Racket", "syntax": "Lisp", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 4, "perf3": 9695, "pull_count": 2247, "pull_rank": 60, "push_count": 27140, "push_rank": 56, "star_count": 8941, "star_rank": 58, "sloc": 495, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 5880, "so_rank": 50, "lloc": 0 }, "rexx": { "dir": "rexx", "name": "Rexx", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 81, "perf2": 340, "perf3": 121, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1237, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 174, "so_rank": 74, "lloc": 0 }, "ruby": { "dir": "ruby", "name": "Ruby", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 1, "perf2": 6, "perf3": 7021, "pull_count": 2750926, "pull_rank": 10, "push_count": 6646427, "push_rank": 9, "star_count": 3577810, "star_rank": 12, "sloc": 442, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 229218, "so_rank": 15, "lloc": 0 }, "ruby.2": { "dir": "ruby.2", "name": "Ruby #2", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 7, "perf2": 28, "perf3": 1498, "pull_count": 2750926, "pull_rank": 11, "push_count": 6646427, "push_rank": 10, "star_count": 3577810, "star_rank": 13, "sloc": 1249, "files": 8, "author_name": "Ryan Cook", "author_url": "https://github.com/cookrn", "so_count": 229218, "so_rank": 16, "lloc": 0 }, "rust": { "dir": "rust", "name": "Rust", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 66511, "pull_count": 427223, "pull_rank": 19, "push_count": 988782, "push_rank": 20, "star_count": 1016188, "star_rank": 19, "sloc": 1118, "files": 7, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 42120, "so_rank": 28, "lloc": 212 }, "scala": { "dir": "scala", "name": "Scala", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 11, "perf2": 28, "perf3": 83454, "pull_count": 648787, "pull_rank": 17, "push_count": 1623883, "push_rank": 17, "star_count": 593810, "star_rank": 20, "sloc": 829, "files": 7, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 112669, "so_rank": 20, "lloc": 0 }, "scheme": { "dir": "scheme", "name": "Scheme (R7RS)", "syntax": "Lisp", "type_check": "Dynamic", "modes": [ "chibi", "kawa", "gauche", "chicken", "sagittarius", "cyclone", "foment" ], "perf1": 4, "perf2": 16, "perf3": 2647, "pull_count": 3192, "pull_rank": 58, "push_count": 89139, "push_rank": 43, "star_count": 32255, "star_rank": 45, "sloc": 895, "files": 8, "author_name": "Vasilij Schneidermann", "author_url": "https://github.com/wasamasa", "so_count": 8168, "so_rank": 45, "lloc": 0 }, "skew": { "dir": "skew", "name": "Skew", "syntax": "OTHER", "type_check": "Static", "modes": [], "perf1": 2, "perf2": 6, "perf3": 68779, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 704, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 386, "so_rank": 70, "lloc": 0 }, "sml": { "dir": "sml", "name": "Standard ML", "syntax": "ML", "type_check": "Static", "modes": [], "perf1": 0, "perf2": 1, "perf3": 42241, "pull_count": 3494, "pull_rank": 57, "push_count": 15782, "push_rank": 63, "star_count": 3521, "star_rank": 63, "sloc": 553, "files": 10, "author_name": "Fabian Bergström", "author_url": "https://github.com/fabjan", "so_count": 2099, "so_rank": 59, "lloc": 0 }, "swift5": { "dir": "swift5", "name": "Swift 5", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 5, "perf2": 22, "perf3": 1884, "pull_count": 441064, "pull_rank": 18, "push_count": 1361391, "push_rank": 18, "star_count": 2778564, "star_rank": 16, "sloc": 1232, "files": 11, "author_name": "Oleg Montak", "author_url": "https://github.com/MontakOleg", "so_count": 343733, "so_rank": 12, "lloc": 0 }, "tcl": { "dir": "tcl", "name": "Tcl", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": 10, "perf2": 32, "perf3": 1057, "pull_count": 2760, "pull_rank": 59, "push_count": 33537, "push_rank": 54, "star_count": 6233, "star_rank": 60, "sloc": 1083, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 8074, "so_rank": 46, "lloc": 0 }, "ts": { "dir": "ts", "name": "TypeScript", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 3, "perf3": 61159, "pull_count": 2152989, "pull_rank": 12, "push_count": 4497441, "push_rank": 15, "star_count": 3141436, "star_rank": 15, "sloc": 1244, "files": 8, "author_name": "Masahiro Wakame", "author_url": "https://github.com/vvakame", "so_count": 239371, "so_rank": 14, "lloc": 0 }, "vala": { "dir": "vala", "name": "Vala", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 3, "perf2": 12, "perf3": 4062, "pull_count": 12061, "pull_rank": 47, "push_count": 80233, "push_rank": 47, "star_count": 45712, "star_rank": 41, "sloc": 2248, "files": 8, "author_name": "Simon Tatham", "author_url": "https://github.com/sgtatham", "so_count": 1006, "so_rank": 63, "lloc": 1114 }, "vhdl": { "dir": "vhdl", "name": "VHDL", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 4, "perf2": 16, "perf3": 2593, "pull_count": 284, "pull_rank": 65, "push_count": 23377, "push_rank": 58, "star_count": 9567, "star_rank": 57, "sloc": 1925, "files": 9, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 5811, "so_rank": 51, "lloc": 0 }, "vimscript": { "dir": "vimscript", "name": "Vimscript", "syntax": "Algol", "type_check": "Dynamic", "modes": [], "perf1": 101, "perf2": 436, "perf3": 98, "pull_count": null, "pull_rank": null, "push_count": 965, "push_rank": 69, "star_count": 1547, "star_rank": 64, "sloc": 969, "files": 10, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 41, "so_rank": 82, "lloc": 12 }, "vb": { "dir": "vb", "name": "Visual Basic.NET", "syntax": "Algol", "type_check": "Static", "modes": [], "perf1": 2, "perf2": 3, "perf3": 33311, "pull_count": 22562, "pull_rank": 38, "push_count": 80494, "push_rank": 46, "star_count": 19848, "star_rank": 50, "sloc": 1451, "files": 8, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 140396, "so_rank": 18, "lloc": 0 }, "vbs": { "dir": "vbs", "name": "Visual Basic Script", "syntax": "Algol", "type_check": "Dynamic", "modes": [], "perf1": 2716, "perf2": 13072, "perf3": 3, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 2109, "files": 8, "author_name": "刘百超", "author_url": "https://github.com/OldLiu001", "so_count": 18658, "so_rank": 35, "lloc": 0 }, "wasm": { "dir": "wasm", "name": "WebAssembly", "syntax": "Lisp", "type_check": "Static", "modes": [ "wace_libc", "node", "warpy" ], "pull_count": 9341, "pull_rank": 51, "push_count": 11939, "push_rank": 65, "star_count": 10628, "star_rank": 55, "sloc": 3024, "files": 16, "author_name": "Joel Martin", "author_url": "https://github.com/kanaka", "so_count": 3002, "so_rank": 55, "lloc": 0 }, "wren": { "dir": "wren", "name": "Wren", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 2, "perf2": 5, "perf3": 7236, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1, "files": 1, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 4, "so_rank": 87, "lloc": 0 }, "xslt": { "dir": "xslt", "name": "XSLT", "syntax": "OTHER", "type_check": "Dynamic", "modes": [], "perf1": null, "perf2": null, "perf3": 0, "pull_count": 14834, "pull_rank": 42, "push_count": 83261, "push_rank": 45, "star_count": 22225, "star_rank": 49, "sloc": 132, "files": 1, "author_name": "Ali MohammadPur", "author_url": "https://github.com/alimpfard", "so_count": 38679, "so_rank": 29, "lloc": 0 }, "yorick": { "dir": "yorick", "name": "Yorick", "syntax": "C", "type_check": "Dynamic", "modes": [], "perf1": 53, "perf2": 248, "perf3": 184, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1013, "files": 8, "author_name": "Dov Murik", "author_url": "https://github.com/dubek", "so_count": 1, "so_rank": 90, "lloc": 108 }, "zig": { "dir": "zig", "name": "Zig", "syntax": "C", "type_check": "Static", "modes": [], "perf1": 1, "perf2": 2, "perf3": 9556, "pull_count": null, "pull_rank": null, "push_count": null, "push_rank": null, "star_count": null, "star_rank": null, "sloc": 1, "files": 1, "author_name": "Josh Tobin", "author_url": "https://github.com/rjtobin", "so_count": 378, "so_rank": 71, "lloc": 0 } } ================================================ FILE: docs/graph/base_data.yaml ================================================ headers: - [dir , name , syntax , type_check , modes] languages: - [ada , Ada , Algol , Static , []] - [ada.2 , "Ada #2" , Algol , Static , []] - [awk , GNU Awk , C , Dynamic , []] - [bash , Bash 4 , OTHER , Dynamic , []] - [basic , BASIC , OTHER , Static , [cbm, qbasic]] - [bbc-basic , BBC BASIC V , OTHER , Static , []] - [c , C , C , Static , []] - [c.2 , "C #2" , C , Static , []] - [cpp , C++ , C , Static , []] - [cs , C# , C , Static , []] - [chuck , ChucK , C , Static , []] - [clojure , Clojure , Lisp , Dynamic , [clj, cljs]] - [coffee , CoffeeScript , OTHER , Dynamic , []] - [common-lisp , Common Lisp , Lisp , Dynamic , []] - [crystal , Crystal , OTHER , Static , []] - [d , D , C , Static , []] - [dart , Dart , C , Static , []] - [elixir , Elixir , OTHER , Dynamic , []] - [elm , Elm , ML , Static , []] - [elisp , Emacs Lisp , Lisp , Dynamic , []] - [erlang , Erlang , OTHER , Dynamic , []] - [es6 , ES6 , C , Dynamic , []] - [fsharp , F# , ML , Static , []] - [fennel , "Fennel" , Lisp , Dynamic , []] - [factor , Factor , Stack , Dynamic , []] - [fantom , Fantom , C , Static , []] - [forth , Forth , Stack , OTHER , []] - [guile , GNU Guile , Lisp , Dynamic , []] - [gnu-smalltalk , GNU Smalltalk , OTHER , Dynamic , []] - [go , Go , C , Static , []] - [groovy , Groovy , C , Dynamic , []] - [haskell , Haskell , ML , Static , []] - [haxe , Haxe , C , Static , [neko,python,cpp,js]] - [hy , Hy , Lisp , Dynamic , []] - [io , Io , OTHER , Dynamic , []] - [java , Java , C , Static , []] - [java-truffle , "Java Truffle" , C , Static , []] - [js , JavaScript , C , Dynamic , []] - [jq , jq , OTHER , Dynamic , []] - [janet , "Janet" , Lisp , Dynamic , []] - [julia , Julia , Algol , Dynamic , []] - [kotlin , Kotlin , C , Static , []] - [latex3 , LaTeX3 , Other , Dynamic , []] - [livescript , LiveScript , ML , Dynamic , []] - [logo , Logo , OTHER , Dynamic , []] - [lua , Lua , Algol , Dynamic , []] - [make , GNU Make , OTHER , OTHER , []] - [mal , mal itself , Lisp , Dynamic , []] - [matlab , MATLAB , Algol , Dynamic , []] - [miniMAL , miniMAL , JSON , Dynamic , []] - [nasm , NASM , OTHER , OTHER , []] - [nim , Nim , Python , Static , []] - [objpascal , Object Pascal , Algol , Static , []] - [objc , Objective C , C , Static , []] - [ocaml , OCaml , ML , Static , []] - [perl , Perl , C , Dynamic , []] - [perl6 , Perl 6 , C , Dynamic , []] - [php , PHP , C , Dynamic , []] - [picolisp , Picolisp , Lisp , Dynamic , []] - [pike , Pike , C , OTHER , []] - [plpgsql , PL/pgSQL , Algol , Static , []] - [plsql , PL/SQL , Algol , Static , []] - [powershell , PowerShell , OTHER , Dynamic , []] - [prolog , Prolog , OTHER , Dynamic , []] - [ps , PostScript , Stack , Dynamic , []] - [purs , PureScript , ML , Static , []] - [python2 , Python2 , Python , Dynamic , []] - [python3 , Python3 , Python , Dynamic , []] - [rpython , RPython , Python , Static , []] - [r , R , C , Dynamic , []] - [racket , Racket , Lisp , Dynamic , []] - [rexx , Rexx , OTHER , Dynamic , []] - [ruby , Ruby , OTHER , Dynamic , []] - [ruby.2 , "Ruby #2" , OTHER , Dynamic , []] - [rust , Rust , C , Static , []] - [scala , Scala , C , Static , []] - [scheme , Scheme (R7RS) , Lisp , Dynamic , [chibi,kawa,gauche,chicken,sagittarius,cyclone,foment]] - [skew , Skew , OTHER , Static , []] - [sml , "Standard ML" , ML , Static , []] - [swift6 , "Swift 6" , C , Static , []] - [tcl , Tcl , OTHER , Dynamic , []] - [ts , TypeScript , C , Static , []] - [vala , Vala , C , Static , []] - [vhdl , VHDL , Algol , Static , []] - [vimscript , Vimscript , Algol , Dynamic , []] - [vb , Visual Basic.NET , Algol , Static , []] - [vbs , Visual Basic Script , Algol , Dynamic , []] - [wasm , WebAssembly , Lisp , Static , [wace_libc,node,warpy]] - [wren , Wren , C , Dynamic , []] - [xslt , XSLT , OTHER , Dynamic , []] - [yorick , Yorick , C , Dynamic , []] - [zig , Zig , C , Static , []] ================================================ FILE: docs/graph/collect_data.js ================================================ #!/usr/bin/env python const { promisify } = require('util') const readFile = promisify(require('fs').readFile) const writeFile = promisify(require('fs').writeFile) const readdir = promisify(require('fs').readdir) const path = require('path') const yaml = require('js-yaml') const csv = require('csvtojson') const request = require('request-promise-native') const exec = promisify(require('child_process').exec) const VERBOSE = process.env['VERBOSE'] || false const BASE_PATH = process.env['BASE_PATH'] || 'base_data.yaml' const README_PATH = process.env['README_PATH'] || '../../README.md' const MAL_PATH = process.env['MAL_PATH'] || '../../' // Refresh this file using this Query page: // https://data.stackexchange.com/stackoverflow/query/edit/1013465 const SO_TAGS_PATH = process.env['SO_TAGS_PATH'] || 'so-tags.csv' // GitHut 2.0 Pull Requests const GITHUT_PULL_URL = process.env['GITHUT_PULL_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-pull-request.json' // GitHut 2.0 Pushes const GITHUT_PUSH_URL = process.env['GITHUT_PUSH_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-push-event.json' // GitHut 2.0 Stars const GITHUT_STAR_URL = process.env['GITHUT_STAR_URL'] || 'https://raw.githubusercontent.com/madnight/githut/master/src/data/gh-star-event.json' const ignoreLanguages = {"Swift 2":1, "Swift 3":1, "Swift 4":1} const githutToNames = { 'Awk': ['GNU Awk'], 'Ada': ['Ada', 'Ada #2'], 'C': ['C', 'C #2'], 'Shell': ['Bash 4'], 'Java': ['Java', 'Java Truffle'], 'JavaScript': ['JavaScript', 'ES6'], 'Makefile': ['GNU Make'], 'Matlab': ['MATLAB'], 'Assembly': ['NASM'], 'Pascal': ['Object Pascal'], 'Objective-C': ['Objective C'], 'PLpgSQL': ['PL/pgSQL'], 'PLSQL': ['PL/SQL'], 'Python': ['Python2', 'Python3'], 'Ruby': ['Ruby', 'Ruby #2'], 'Scheme': ['Scheme (R7RS)'], 'Smalltalk': ['GNU Smalltalk'], 'Swift': ['Swift 5'], 'Vim script': ['Vimscript'], 'Visual Basic': ['Visual Basic.NET'], } const dirToSOTags = { 'ada.2': ['ada'], 'bbc-basic': ['bbc-micro'], 'cpp': ['c++', 'c++98', 'c++11', 'c++14', 'c++17'], 'coffee': ['coffeescript'], 'crystal': ['crystal-lang'], 'cs': ['c#', 'c#-2.0', 'c#-3.0', 'c#-4.0'], 'c.2': ['c'], 'es6': ['ecmascript-6', 'es6-promise', 'es6-modules', 'es6-class', 'reactjs'], 'fsharp': ['f#', 'f#-interactive', 'f#-data', 'f#-3.0'], 'factor': ['factor-lang'], 'java-truffle': ['graalvm'], 'js': ['javascript', 'node.js', 'jquery', 'angular'], 'latex3': ['latex'], 'logo': ['logo-lang'], 'make': ['makefile'], 'nim': ['nim-lang'], 'objpascal': ['delphi', 'freepascal', 'delphi-7', 'delphi-2007', 'delphi-2009', 'delphi-2010', 'delphi-xe', 'delphi-xe2', 'delphi-xe3', 'delphi-xe4', 'delphi-xe5', 'delphi-xe7'], 'objc': ['objective-c'], 'perl6': ['raku'], 'purs': ['purescript'], 'python2': ['python', 'python-2.7'], 'python3': ['python', 'python-3.x'], 'ruby.2': ['ruby'], 'swift5': ['swift', 'swift4', 'swift5'], 'ts': ['typescript', 'typescript-generics', 'typescript2.0'], 'vimscript': ['viml'], 'vb': ['vb.net'], 'vbs': ['vbscript'], 'wasm': ['webassembly'], } const soMapOverrides = { 'mal': 0, // StackOverflow mal is something else 'miniMAL': 0, 'bbc-micro': 9, // outside 50,000 query limit 'fennel': 3, // outside 50,000 query limit 'janet': 3, // outside 50,000 query limit 'picolisp': 8, // outside 50,000 query limit 'wren': 4, // outside 50,000 query limit 'yorick': 1, // outside 50,000 query limit } function vlog(...args) { if (VERBOSE) { console.log(...args) } } function die(code, ...args) { console.error(...args) process.exit(code) } async function main() { const logsPath = path.resolve(process.argv[2]) const outPath = path.resolve(process.argv[3]) vlog(`Loading base data yaml from '${BASE_PATH}`) const baseYaml = yaml.safeLoad(await readFile(BASE_PATH, 'utf8')) vlog(`Loading README text from '${README_PATH}`) const readmeLines = (await readFile(README_PATH, 'utf8')).split(/\n/) vlog(`Downloading GitHut Pulls HTML from '${GITHUT_PULL_URL}`) const githutPullText = (await request(GITHUT_PULL_URL)) vlog(`Downloading GitHut Pushes HTML from '${GITHUT_PUSH_URL}`) const githutPushText = (await request(GITHUT_PUSH_URL)) vlog(`Downloading GitHut Stars HTML from '${GITHUT_STAR_URL}`) const githutStarText = (await request(GITHUT_STAR_URL)) vlog(`Loading StackOverflow Tags CSV from '${SO_TAGS_PATH}`) const soTagList = await csv().fromFile(SO_TAGS_PATH) vlog(`Loading log data from '${logsPath}'`) const logDirs = (await readdir(logsPath)).sort() let logData = [] for (const d of logDirs) { let dir = /IMPL=([^ ]*)/.exec(d)[1] if (!dir) { console.log("ignoring log dir:", d); continue } let logPath = `${logsPath}/${d}` const logFiles = (await readdir(logPath)) .filter(f => /^perf-.*\.log/.exec(f)) const path = `${logPath}/${logFiles[0]}` logData.push([await readFile(path, 'utf8'), path, dir]) } let dirs = [] let names = [] let dataList = [] let dataByDir = {} let dataByName = {} vlog(`Processing base data`) for (let d of baseYaml['languages']) { let data = {'dir': d[0], 'name': d[1], 'syntax': d[2], 'type_check': d[3], 'modes': d[4], 'perf1': null, 'perf2': null, 'perf3': 0, 'pull_count': null, 'pull_rank': null, 'push_count': null, 'push_rank': null, 'star_count': null, 'star_rank': null, 'sloc': 0, 'files': 0} dirs.push(d[0]) names.push(d[1]) dataList.push(data) dataByDir[d[0]] = data dataByName[d[1]] = data } vlog(`Processing README implementations table`) const readme_re = /^\| \[([^\[]*)\].* \| \[([^|]*)\]\(([^|]*)\) *\| *$/ for (let row of readmeLines.filter(l => /^\| [\[]/.exec(l))) { t = readme_re.exec(row) if (t) { if (t[1] in ignoreLanguages) { vlog(` ${t[1]}: ignoring (in ignoreLanguages list)`) } else if (t[1] in dataByName) { let data = dataByName[t[1]] data.author_name = t[2] data.author_url = t[3] } else { die(1, `README language '${t[1]}' not found in base data`) } } else { die(1, `No match for README table row: ${row}`) } } vlog(`Processing StackOverflow tag data`) const soMap = { ...soTagList .reduce((m,d) => (m[d.TagName] = parseInt(d.Rate), m), {}), ...soMapOverrides } for (let dir of dirs) { if (!('so_count' in dataByDir[dir])) { dataByDir[dir]['so_count'] = 0 } let tags = dirToSOTags[dir] if (!tags) { if (dir in soMap) { tags = [dir] } else { vlog(` ${dir} not found as StackOverflow tag`) tags = [] } } for (let tag of tags) { if (tag in soMap) { dataByDir[dir]['so_count'] += soMap[tag] //vlog(` ${dir} count: ${count}`) } else { die(1, `${tag} not found in soMap`) } } } let curRank = 1 let soSort = Object.values(dataByDir).sort((a,b) => b.so_count - a.so_count) for (let data of soSort) { data.so_rank = curRank vlog(` ${data.dir} so_count: ${data.so_count}, rank: ${curRank}`) curRank += 1 } const maxSORank = curRank vlog(`Processing log file data`) const perf_run_re = /Running:.*\.\.\/tests\/(perf[0-9])\.mal/ const perf_num_re = /Elapsed time: ([0-9.]+) msecs|iters over 10 seconds: ([0-9]+)/ for (let [log, file, dir] of logData) { const data = dataByDir[dir] // if (data.perf1 !== null) { // vlog(` ${dir} already has perf data, ignoring ${file}`) // continue // } const perfs = {} const logLines = log.split(/\n/) for (let i = 0; i < logLines.length; i++) { const match_run = perf_run_re.exec(logLines[i]) if (match_run) { // Find the result line let match_num = null do { i += 1 match_num = perf_num_re.exec(logLines[i]) if (match_num) { num = parseFloat(match_num[1] || match_num[2], 10) perfs[match_run[1]] = num } } while ((!match_num) && i < logLines.length) } } if ((!data.perf3) || (perfs.perf3 > data.perf3)) { data.perf1 = perfs.perf1 data.perf2 = perfs.perf2 data.perf3 = perfs.perf3 vlog(` ${dir}: ${perfs.perf1}, ${perfs.perf2}, ${perfs.perf3}`) } else { vlog(` ${dir}: ${perfs.perf1}, ${perfs.perf2}, ${perfs.perf3} (perf3 is worse, ignoring log ${file})`) } } function githutProcess(textData, kind) { const gMap = JSON.parse(textData) .reduce((m, d) => (m[d.name] = parseInt(d.count) + (m[d.name] || 0), m), {}) const gdata = Object.entries(gMap) .sort(([k1,v1],[k2,v2]) => v2 - v1) let curRank = 1 for (let [gname, gcount] of gdata) { const names = githutToNames[gname] || [gname] for (let name of names) { if (name in dataByName) { dataByName[name][kind + '_count'] = gcount dataByName[name][kind + '_rank'] = curRank vlog(` ${dataByName[name].dir} count: ${gcount}, rank: ${curRank}`) curRank += 1 } else if (gname in githutToNames) { vlog(` ignoring known GitHut language ${name} (${gname})`) } else { //vlog(` ignoring GitHut language ${name}`) } } } for (let name in dataByName) { if (!dataByName[name][kind + '_count']) { vlog(` ${dataByName[name].dir} no GitHut data`) } } return curRank; } vlog(`Processing GitHut Pull Request data`) githutProcess(githutPullText, 'pull') vlog(`Processing GitHut Push data`) githutProcess(githutPushText, 'push') vlog(`Processing GitHut Stars data`) githutProcess(githutStarText, 'star') vlog(`Gathering LOC stats`) const stat_re = /SLOC=([0-9]+).*LLOC=([0-9]+).*in ([0-9]+) files/ process.chdir(MAL_PATH) for (let data of dataList) { const { stdout, stderr } = await exec(`make "stats^${data.dir}"`) const match = stat_re.exec(stdout.split(/\n/)[1]) data.sloc = parseInt(match[1], 10) data.lloc = parseInt(match[2], 10) data.files = parseInt(match[3], 10) vlog(` ${data.dir}: sloc: ${data.sloc}, lloc: ${data.lloc}, files: ${data.files}`) } vlog(`Writing full lanaguage data to ${outPath}`) await writeFile(outPath, JSON.stringify(dataByDir, null, 2)) process.exit(0) } main() ================================================ FILE: docs/graph/graph_languages.js ================================================ const malColors = [ "#1f77b4","#bf7f0e","#4cb00c","#b62728","#9467bd","#bc664b","#b377c2","#0fbf6f","#bcbd22","#17beef", "#1f6784","#8f7f0e","#4c800c","#862728","#54678d","#8c564b","#8377c2","#0f8f6f","#8c8d22","#178eef", "#1f97d4","#ff7f0e","#4cf00c","#f62728","#c467fd","#fc764b","#f377c2","#0fff6f","#fcfd22","#17feef", ] const axisMap = { 'pull_rank': 'GH PRs', 'push_rank': 'GH Pushes', 'star_rank': 'GH Stars', 'so_rank': 'SO Tags', 'perf1': 'Perf 1', 'perf2': 'Perf 2', 'perf3': 'Perf 3', 'sloc': 'SLOC size', 'files': 'File count', } const colorMap = { 'syntax': 'Syntax Style', 'type_check': 'Type Discipline', 'author_name': 'Author', } const axisKeySet = new Set(Object.keys(axisMap)) const colorKeySet = new Set(['type_check', 'syntax', 'author_name']) const perfSet = new Set(['perf1', 'perf2', 'perf3']) const invertSet = new Set(['pull_rank', 'push_rank', 'star_rank', 'so_rank', 'perf1', 'perf2']) const perfLogSet = new Set(['perf1', 'perf2', 'sloc', 'files']) let cfg = { ckey: 'syntax', xkey: 'so_rank', ykey: 'perf3', skey: 'sloc', xlog: false, ylog: true, } let allData let graphData = [] let chart // // Util functions // function malExtent(data, key) { let extent = d3.extent(Object.values(data), d => d[key]) // pad the bottom rank so it's not on the opposite axis line if (key.endsWith('_rank')) { extent[0] = 0.99 // Setting this to 1 breaks log scale render extent[extent.length-1] += 1 } // Replace 0's with 0.01 to prevent divide by zero errors if (extent[0] === 0) { extent[0] = 0.0001 } if (extent[extent.length-1] === 0) { extent[extent.length-1] = 0.0001 } // For rankings, perf1, and perf2 reverse the Axis range if (invertSet.has(key)) { extent.reverse() } return extent } function malScale(log) { return log ? d3.scale.log() : d3.scale.linear() } function malTickValues(key, log) { if (log && perfSet.has(key)) { return [1, 10, 100, 1000, 10000, 100000] } else { return null } } function malCircleSize(key, min, max, val) { let size = (val || 0.01) - (min - 0.01) if (invertSet.has(key)) { size = (max + 0.01) - size } // if (perfLogSet.has(key)) { // size = Math.log(size) // } // console.log(key, max, val, size) return size } // // UI / Axis Data / query parameters // // Parser query string and update cfg map with valid config options (function parseQuery(q) { const pairs = (q[0] === '?' ? q.substr(1) : q).split('&') for (const [p1, p2] of pairs.map(p => p.split('='))) { let k = decodeURIComponent(p1).toLowerCase() let v = p2 ? decodeURIComponent(p2) : true if (v in {"true":1,"1":1,"yes":1}) { v = true } if (v in {"false":1,"0":1,"no":1}) { v = false } if (k in cfg && (axisKeySet.has(v) || colorKeySet.has(v))) { cfg[k] = v } if ((new Set(['xlog', 'ylog'])).has(k) && typeof v === 'boolean') { cfg[k] = v } } })(location.search) // Generate the control buttons and set the checked elements based on // the cfg function ctlChange(evt) { if (new Set(['xlog', 'ylog']).has(evt.target.name)) { cfg[evt.target.name] = evt.target.checked } else { cfg[evt.target.name] = evt.target.value } const query = Object.entries(cfg).map(([k,v]) => k + "=" + v).join('&') history.pushState(null, '', '?' + query) updateGraphData() } for (let key of ['ckey', 'xkey', 'ykey', 'skey']) { const parent = document.getElementById(key + '-controls') const ctlMap = ({ 'ckey': colorMap, 'xkey': Object.assign({}, axisMap, {'xlog': 'Log Scale'}), 'ykey': Object.assign({}, axisMap, {'ylog': 'Log Scale'}), 'skey': axisMap, })[key] for (let [val, name] of Object.entries(ctlMap)) { const log = (new Set(['xlog', 'ylog']).has(val)) ? val : false const ctl = document.createElement('input') ctl.class = 'selects' ctl.type = log ? 'checkbox' : 'radio' ctl.name = log ? log : key ctl.value = log ? true : val if ((log && cfg[val] === true) || cfg[key] === val) { ctl.checked = true } ctl.addEventListener('change', ctlChange) parent.appendChild(ctl) parent.appendChild(document.createTextNode(name)) } } // // Graph rendering / updating // function updateGraphData() { let xMax = 0 let yMax = 0 let sMin = null let sMax = null const colorSet = new Set(Object.values(allData).map(d => d[cfg.ckey])) const colorList = Array.from(colorSet.values()) // empty the graphData without recreating it while (graphData.length > 0) { graphData.pop() } graphData.push(...colorList.map(t => ({key: t, values: []}))) for (let dir of Object.keys(allData)) { const impl = allData[dir] if (impl[cfg.xkey] > xMax) { xMax = impl[cfg.xkey] } if (impl[cfg.ykey] > yMax) { yMax = impl[cfg.ykey] } if (sMin === null) { sMin = impl[cfg.skey] } if (impl[cfg.skey] < sMin) { sMin = impl[cfg.skey] } if (impl[cfg.skey] > sMax) { sMax = impl[cfg.skey] } } for (let dir of Object.keys(allData)) { const impl = allData[dir] // Invert size for inverted data graphData[colorList.indexOf(impl[cfg.ckey])].values.push({ x: impl[cfg.xkey] || 0, y: impl[cfg.ykey] || 0, size: malCircleSize(cfg.skey, sMin, sMax, impl[cfg.skey]), shape: 'circle', label: impl.name, impl: impl, }) } // Update the axes domain, scale and tick values chart.xDomain(malExtent(allData, cfg.xkey)) chart.yDomain(malExtent(allData, cfg.ykey)) chart.xScale(malScale(cfg.xlog)) chart.yScale(malScale(cfg.ylog)) chart.xAxis.tickValues(malTickValues(cfg.xkey, cfg.xlog)) chart.yAxis.tickValues(malTickValues(cfg.ykey, cfg.ylog)) chart.xAxis.axisLabel(axisMap[cfg.xkey]) chart.yAxis.axisLabel(axisMap[cfg.ykey]) // Update the graph d3.select('#mal svg') .data([graphData]) .transition().duration(350).ease('linear') .call(chart) chart.update() nv.utils.windowResize(chart.update) } nv.addGraph(function() { chart = nv.models.scatterChart() .showDistX(true) .showDistY(true) .showLabels(true) .duration(300) .color(malColors) chart.dispatch.on('renderEnd', function() { //console.log('render complete') }) chart.dispatch.on('stateChange', function(e) { nv.log('New State:', JSON.stringify(e)) }) chart.tooltip.contentGenerator(function(obj) { const i = obj.point.impl return '

' + i.name + '

' + '
    ' + '
  • Syntax Style: ' + i.syntax + '
  • Type Discipline: ' + i.type_check + '
  • GitHub:' + '
      ' + '
    • PR Count: ' + (i.pull_count || 'unknown') + '
    • PR Rank: ' + i.pull_rank + '
    • Push Count: ' + (i.push_count || 'unknown') + '
    • Push Rank: ' + i.push_rank + '
    • Star Count: ' + (i.star_count || 'unknown') + '
    • Star Rank: ' + i.star_rank + '
    ' + '
  • StackOverflow:' + '
      ' + '
    • Tag Count: ' + (i.so_count || 'unknown') + '
    • Tag Rank: ' + i.so_rank + '
    ' + '

  • ' + '
  • Perf 1: ' + i.perf1 + ' ms
    ' + '
  • Perf 2: ' + i.perf2 + ' ms
    ' + '
  • Perf 3: ' + i.perf3 + ' iters / 10 sec
    ' + '
  • SLOC: ' + i.sloc + ' lines
    ' + '
  • Author: ' + i.author_name + '
    ' + '    ' + i.author_url.replace(/https?:\/\//, '') + '
' }) // Load and mangle the data d3.json("all_data.json", function (error, data) { allData = data console.log(`Filling in missing data attributes`) const dataList = Object.values(allData) // leave a gap between ranked impls and those with no rank const rankGap = 10 const maxPullRank = Math.max(...dataList.map(d => d.pull_rank)) const maxPushRank = Math.max(...dataList.map(d => d.push_rank)) const maxStarRank = Math.max(...dataList.map(d => d.star_rank)) const maxSORank = Math.max(...dataList.map(d => d.so_rank)) const maxPerf1 = dataList.reduce((a, d) => d.perf1 > a ? d.perf1 : a, 0) const maxPerf2 = dataList.reduce((a, d) => d.perf2 > a ? d.perf1 : a, 0) for (let d of dataList) { if (d.pull_rank === null) { d.pull_rank = maxPullRank + rankGap console.log(` set pull_rank to ${d.pull_rank} for ${d.dir}`) } if (d.push_rank === null) { d.push_rank = maxPushRank + rankGap console.log(` set push_rank to ${d.push_rank} for ${d.dir}`) } if (d.star_rank === null) { d.star_rank = maxStarRank + rankGap console.log(` set star_rank to ${d.star_rank} for ${d.dir}`) } if (d.so_count === 0) { d.so_rank = maxSORank + rankGap console.log(` set so_rank to ${d.so_rank} for ${d.dir}`) } if (d.perf1 === null) { d.perf1 = maxPerf1 console.log(` set perf1 to ${maxPerf1} for ${d.dir}`) } if (d.perf2 === null) { d.perf2 = maxPerf2 console.log(` set perf2 to ${maxPerf2} for ${d.dir}`) } } console.log(`Adjusting perf numbers to avoid 0`) for (let d of dataList) { if (d.perf1 === 0) { d.perf1 = 0.9 } if (d.perf2 === 0) { d.perf2 = 0.9 } if (d.perf3 === 0) { d.perf3 = 0.01 } } // NOTE: TODO: major hack to workaround bug with switching // to/from logarithmic mode. Seems to require at least one // value to be less than 1 for it to work allData.rpython.perf2 = 0.9 updateGraphData() }) return chart }) ================================================ FILE: docs/graph/index.html ================================================

Mal Implementation Stats

Important Caveats:

The data on this graph is very specific to Mal. Do not use this data to directly compare programming languages.

  • Bad takeaway: "Language X is faster than language Y"
  • Good takeway: "The mal impl in language X is faster than the one in language Y for the 'perf 3' microbenchmark"

Here are some reasons (non-exhaustive) why this data should be taken with a grain of salt:

  • The focus of the make-a-lisp process is on learning (either Lisp or the target language). The resulting implementations have a common structure that is intended for understandability and consistency between implementations. They are not structured or intended to have optimal runtime performance or code concision.
  • Mal implementations are created by different authors and the authors have varying levels of experience with the target language and they often created a mal implementation with the goal of learning the target language.
  • While the overall structure of each mal implementation is similar, the implementation details are up to the author.
  • There are hundreds of tests that each implementation must pass before being accepted into the tree. However, the mal language has no formal specification so authors make choices about whether and how to handle edge cases that are not covered by the tests. For example, mal implementations have different levels of runtime error checking.
  • The performance benchmarks are very narrow in focus and these numbers should not be extrapolated casually. For example, the 'perf 3' microbenchmark repeats a macro and data structure manipulation test repeatedly for 10 seconds and counts the number of iterations through the test. Languages with runtime optimization (e.g. JIT) tend to do particularly well at this benchmark (RPython, JVM-based, etc).

Other Notes:

  • Syntax style and type discipline are best effort and based on Wikipedia information and personal experience. There are also other aspects to type discipline (strong, gradual, duck, etc) that are not currently included.
  • The GitHub information was gathered by the GitHut 2.0 project and then translated into a ordinal ranking of implementations relative to each other.
  • The StackOverflow information was generated by a tag count query and then translated into a ordinal ranking of implementations relative to each other.
  • Not all languages have GitHub or StackOverflow data so a gap of 10 ticks is introduced between the ranked languages and the languages with no data.
 Color data:
X-Axis data:
Y-Axis data:
Circle size:
================================================ FILE: docs/graph/package.json ================================================ { "name": "mal_graph", "version": "0.0.1", "description": "Graph Mal Languages", "dependencies": { "js-yaml": "3.13.1", "csvtojson": "2.0.8", "request": "2.88.0", "request-promise-native": "1.0.7" } } ================================================ FILE: docs/graph/so-tags.csv ================================================ Rate,TagName "2532623","javascript" "2205901","python" "1919299","java" "1620836","c#" "1467322","php" "1419124","android" "1188879","html" "1034208","jquery" "810400","c++" "806359","css" "688094","ios" "673281","sql" "661830","mysql" "508699","r" "479715","reactjs" "473356","node.js" "417506","arrays" "405875","c" "374706","asp.net" "361025","json" "343110","python-3.x" "339673",".net" "338275","ruby-on-rails" "335747","sql-server" "334941","swift" "312746","django" "306068","angular" "292176","objective-c" "288497","excel" "288305","pandas" "262606","angularjs" "260613","regex" "233158","typescript" "229218","ruby" "227898","linux" "221724","ajax" "220561","iphone" "215414","vba" "214973","xml" "212693","laravel" "211908","spring" "201292","asp.net-mvc" "195197","database" "192135","wordpress" "184749","string" "178977","flutter" "177876","postgresql" "176089","mongodb" "169898","wpf" "168390","windows" "159813","amazon-web-services" "159792","xcode" "156259","bash" "153110","git" "152311","oracle" "149763","spring-boot" "147126","dataframe" "143815","firebase" "142273","azure" "141881","list" "140679","multithreading" "140396","vb.net" "139125","docker" "138101","react-native" "124939","eclipse" "121178","algorithm" "118255","powershell" "118073","macos" "115734","visual-studio" "114584","numpy" "114135","image" "113687","forms" "112669","scala" "111504","function" "108146","vue.js" "103062","twitter-bootstrap" "102573","performance" "100414","selenium" "99255","winforms" "96732","kotlin" "96589","loops" "95744","express" "95222","hibernate" "95118","python-2.7" "95093","sqlite" "94997","matlab" "94667","dart" "94558","api" "92871","shell" "92623","rest" "92369","apache" "91885","entity-framework" "90681","android-studio" "90480","csv" "88966","maven" "86630","linq" "86273","qt" "86235","dictionary" "85732","unit-testing" "85537","facebook" "83634","asp.net-core" "82905","tensorflow" "82661","apache-spark" "81612","file" "81367","swing" "79894","class" "77183","sorting" "77028","unity-game-engine" "76975","date" "76077","authentication" "74257","symfony" "73691","go" "73460","opencv" "73384","t-sql" "73085",".htaccess" "72761","google-chrome" "72579","matplotlib" "72036","for-loop" "71268","datetime" "69528","codeigniter" "68358","http" "68197","perl" "67699","validation" "66618","sockets" "66067","google-maps" "65127","object" "64404","uitableview" "62697","xaml" "62318","oop" "62222","if-statement" "61584","cordova" "61010","ubuntu" "60154","visual-studio-code" "59886","web-services" "59490","email" "59129","android-layout" "58654","spring-mvc" "58605","elasticsearch" "58402","github" "58157","kubernetes" "57861","selenium-webdriver" "57856","ms-access" "57637","parsing" "57566","user-interface" "56993","ggplot2" "56850","pointers" "56741","c++11" "56583","security" "56146","machine-learning" "55938","ruby-on-rails-3" "55743","flask" "55663","google-sheets" "55590","nginx" "55376","templates" "55020","google-apps-script" "53957","variables" "53780","exception" "53745","sql-server-2008" "52689","listview" "52660","debugging" "52596","gradle" "52563","tkinter" "52193","jpa" "52128","delphi" "51935","jsp" "51895","asynchronous" "51705","pdf" "51449","haskell" "51406","web-scraping" "51354","ssl" "50962","amazon-s3" "50858","jenkins" "50848","xamarin" "50769","wcf" "50607","testing" "50401","batch-file" "50383","google-cloud-platform" "50243","npm" "50003","generics" "48643","ionic-framework" "47653","unix" "47274","recursion" "47116","google-app-engine" "46877","mongoose" "46559","visual-studio-2010" "45686","android-fragments" "45564",".net-core" "44881","animation" "44709","assembly" "44412","hadoop" "44400","session" "44388","math" "44218","web" "44195","svg" "43951","curl" "43899","intellij-idea" "43848","django-models" "43721","laravel-5" "43703","join" "43554","heroku" "43522","url" "43319","http-redirect" "43224","winapi" "43141","tomcat" "42960","next.js" "42849","google-cloud-firestore" "42781","webpack" "42738","inheritance" "42500","keras" "42368","image-processing" "42345","asp.net-mvc-4" "42120","rust" "41867","gcc" "41752","dom" "41726","logging" "41261","matrix" "41120","actionscript-3" "40884","pyspark" "40821","post" "40748","button" "40153","firebase-realtime-database" "39887","swiftui" "39852","optimization" "39720","jquery-ui" "39623","cocoa" "39505","xpath" "39495","iis" "39352","d3.js" "38979","internet-explorer" "38955","firefox" "38742","javafx" "38679","xslt" "38446","caching" "38331","asp.net-mvc-3" "38276","select" "38253","networking" "38109","opengl" "38082","asp.net-web-api" "38082","events" "37903","plot" "37508","magento" "37311","search" "37299","dplyr" "37251","encryption" "37147","stored-procedures" "37088","amazon-ec2" "36756","ruby-on-rails-4" "36412","memory" "36155","canvas" "36093","audio" "35780","jsf" "35636","multidimensional-array" "35548","random" "35433","redux" "35346","vector" "35290","cookies" "35170","input" "35129","facebook-graph-api" "34893","flash" "34715","xamarin.forms" "34621","ipad" "34594","arraylist" "34507","cocoa-touch" "34469","indexing" "34109","video" "34062","data-structures" "33597","model-view-controller" "33489","serialization" "33425","jdbc" "33342","apache-kafka" "33314","razor" "33298","routes" "33188","servlets" "33148","mod-rewrite" "33144","awk" "33127","woocommerce" "32801","iframe" "32798","beautifulsoup" "32406","filter" "32313","docker-compose" "32245","azure-devops" "32167","design-patterns" "32117","excel-formula" "32115","aws-lambda" "31946","text" "31942","django-rest-framework" "31737","visual-c++" "31670","cakephp" "31153","mobile" "30937","android-intent" "30841","react-hooks" "30662","struct" "30474","methods" "30299","mvvm" "30295","groovy" "30228","ssh" "30116","lambda" "29981","ecmascript-6" "29973","checkbox" "29899","time" "29874","grails" "29828","google-chrome-extension" "29703","installation" "29535","sharepoint" "29355","jakarta-ee" "29327","android-recyclerview" "29215","core-data" "29158","shiny" "29113","plsql" "29097","spring-security" "29086","meteor" "29045","android-activity" "28983","cmake" "28898","types" "28882","sed" "28851","bootstrap-4" "28751","graph" "28715","activerecord" "28655","websocket" "28378","replace" "28317","scikit-learn" "28233","file-upload" "28157","vim" "28085","group-by" "28082","junit" "27930","boost" "27855","deep-learning" "27746","import" "27625","sass" "27603","memory-management" "27481","error-handling" "27403","async-await" "27362","dynamic" "27319","eloquent" "27290","soap" "27145","silverlight" "26975","charts" "26939","layout" "26922","apache-spark-sql" "26907","dependency-injection" "26812","browser" "26796","gridview" "26730","svn" "26706","deployment" "26489","while-loop" "26409","vuejs2" "26212","google-bigquery" "26147","highcharts" "26097","dll" "26087","ffmpeg" "26085","view" "25796","foreach" "25795","c#-4.0" "25732","cmd" "25696","plugins" "25626","reporting-services" "25624","redis" "25601","makefile" "25243","server" "25240","merge" "25189","https" "25187","unicode" "25175","jupyter-notebook" "25126","google-maps-api-3" "25124","reflection" "25120","twitter" "24884","extjs" "24715","axios" "24643","mysqli" "24572","oauth-2.0" "24500","terminal" "24484","split" "24389","django-views" "24369","encoding" "24319","pytorch" "24260","pip" "24147","netbeans" "24111","collections" "24110","database-design" "24056","hash" "23985","ember.js" "23913","data-binding" "23902","automation" "23897","pdo" "23828","tcp" "23821","apache-flex" "23768","build" "23694","sqlalchemy" "23492","command-line" "23360","printing" "23255","spring-data-jpa" "23236","react-redux" "23233","java-8" "23164","service" "23115","jestjs" "23107","concurrency" "23088","html-table" "22993","neo4j" "22894","entity-framework-core" "22893","visual-studio-2012" "22876","ansible" "22876","parameters" "22832","lua" "22792","module" "22777","material-ui" "22716","promise" "22676","enums" "22596","webview" "22543","outlook" "22539","web-applications" "22521","flexbox" "22516","jquery-mobile" "22487","uwp" "22399","firebase-authentication" "22371","utf-8" "22277","datatable" "22118","python-requests" "22015","drop-down-menu" "21932","scroll" "21925","colors" "21920","hive" "21854","tfs" "21829","parallel-processing" "21682","count" "21660","scipy" "21612","syntax" "21456","twitter-bootstrap-3" "21453","ms-word" "21371","google-analytics" "21315","ssis" "21196","fonts" "21176","three.js" "21140","file-io" "21138","constructor" "21125","graphql" "21096","paypal" "21051","rxjs" "20930","discord" "20919","cassandra" "20914","socket.io" "20791","gwt" "20746","datatables" "20707","graphics" "20608","compiler-errors" "20605","nlp" "20597","backbone.js" "20587","solr" "20566","url-rewriting" "20554","react-router" "20492","powerbi" "20475","memory-leaks" "20429","datagridview" "20363","oracle11g" "20360","drupal" "20357","zend-framework" "20343","oauth" "20266","knockout.js" "20213","neural-network" "20200","django-forms" "20112","interface" "20037","triggers" "20002","google-api" "19997","casting" "19947","linked-list" "19904","angular-material" "19869","terraform" "19846","jmeter" "19731","proxy" "19689","django-templates" "19689","timer" "19678","path" "19621","parse-platform" "19611","visual-studio-2015" "19589","windows-phone-7" "19583","directory" "19560","cron" "19555","orm" "19451","arduino" "19441","push-notification" "19367","conditional-statements" "19343","primefaces" "19147","functional-programming" "19084","model" "18955","jar" "18858","xamarin.android" "18763","hyperlink" "18727","visual-studio-2013" "18709","uiview" "18658","vbscript" "18496","download" "18428","swift3" "18418","gitlab" "18384","google-cloud-functions" "18381","azure-active-directory" "18353","sql-server-2005" "18316","process" "18265","jwt" "18263","rspec" "18208","properties" "18196","configuration" "18186","windows-phone-8" "18182","callback" "18166","combobox" "18085","pygame" "17916","safari" "17860","scrapy" "17827","permissions" "17799","pagination" "17769","scripting" "17768","linux-kernel" "17767","emacs" "17736","raspberry-pi" "17703","clojure" "17652","scope" "17620","io" "17543","angularjs-directive" "17521","nhibernate" "17511","mongodb-query" "17477","responsive-design" "17468","x86" "17453","request" "17420","compilation" "17342","bluetooth" "17328","dns" "17317","binding" "17293","reference" "17290","playframework" "17286","discord.js" "17275","3d" "17237","architecture" "17234","doctrine-orm" "17231","version-control" "17202","pyqt" "17141","get" "17113","package" "17102","sql-server-2012" "17039","pycharm" "17029","rubygems" "17019","f#" "16869","autocomplete" "16840","kendo-ui" "16835","datepicker" "16798","tree" "16785","azure-functions" "16763","yii" "16718","openssl" "16692","controller" "16687","jackson" "16655","xamarin.ios" "16646","expo" "16584","grep" "16573","nested" "16481","static" "16415","statistics" "16359","datagrid" "16350","null" "16334","transactions" "16323","active-directory" "16320","phpmyadmin" "16310","uiviewcontroller" "16227","webforms" "16160","discord.py" "16140","notifications" "16135","dockerfile" "16080","sas" "16008","youtube" "15991","nullpointerexception" "15988","duplicates" "15937","mocking" "15869","computer-vision" "15868","menu" "15721","bitmap" "15719","yaml" "15642","asp.net-mvc-5" "15629","visual-studio-2008" "15626","sum" "15614","jsf-2" "15562","stream" "15550","yii2" "15526","android-listview" "15502","time-series" "15484","electron" "15481","stl" "15445","css-selectors" "15399","ant" "15339","floating-point" "15297","hashmap" "15279","character-encoding" "15245","frontend" "15235","cryptography" "15198","jboss" "15193","msbuild" "15178","sdk" "15113","google-drive-api" "15082","joomla" "15065","selenium-chromedriver" "15026","devise" "14983","anaconda" "14965","asp.net-core-mvc" "14950","navigation" "14886","background" "14842","binary" "14818","camera" "14809","pyqt5" "14772","linq-to-sql" "14745","multiprocessing" "14677","onclick" "14675","cors" "14675","ios7" "14674","blazor" "14667","iterator" "14548","cuda" "14536","plotly" "14516","mariadb" "14508","android-asynctask" "14456","rabbitmq" "14417","laravel-4" "14377","tabs" "14369","uicollectionview" "14368","insert" "14250","amazon-dynamodb" "14195","linker" "14193","upload" "14190","coldfusion" "14181","environment-variables" "14171","xsd" "14170","console" "14152","ftp" "14108","textview" "14052","continuous-integration" "14044","opengl-es" "14031","microsoft-graph-api" "13920","xml-parsing" "13907","localization" "13899","operating-system" "13866","mockito" "13857","formatting" "13832","json.net" "13811","kivy" "13769","macros" "13747","type-conversion" "13728","calendar" "13719","data.table" "13710","timestamp" "13639","integer" "13603","vuejs3" "13598","segmentation-fault" "13578","android-ndk" "13462","prolog" "13454","drag-and-drop" "13406","char" "13398","android-jetpack-compose" "13386","jasmine" "13384","crash" "13288","automated-tests" "13253","itext" "13239","header" "13215","sprite-kit" "13211","dependencies" "13181","geometry" "13174","nosql" "13173","android-gradle-plugin" "13164","mfc" "13160","attributes" "13126","fortran" "13087","format" "13082","nuxt.js" "13080","firebase-cloud-messaging" "13024","jquery-plugins" "12973","leaflet" "12907","flutter-layout" "12892","db2" "12890","jenkins-pipeline" "12865","event-handling" "12842","annotations" "12841","odoo" "12825","nestjs" "12762","keyboard" "12762","postman" "12754","julia" "12732","textbox" "12688","visual-studio-2017" "12684","gulp" "12660","libgdx" "12593","arm" "12590","crystal-reports" "12590","xampp" "12564","synchronization" "12550","dom-events" "12515","uiscrollview" "12491","timezone" "12474","wso2" "12474","azure-pipelines" "12472","sequelize.js" "12465","aggregation-framework" "12465","swagger" "12465","android-emulator" "12461","namespaces" "12403","stripe-payments" "12400","centos" "12391","azure-web-app-service" "12382","jvm" "12382","chart.js" "12368","geolocation" "12368","webdriver" "12353","com" "12346","subprocess" "12320","uikit" "12258","html5-canvas" "12257","dialog" "12217","garbage-collection" "12214","widget" "12206","numbers" "12190","windows-10" "12177","concatenation" "12166","mapreduce" "12151","sql-update" "12139","ionic2" "12114","set" "12096","android-edittext" "12087","tuples" "12077","rotation" "12070","spring-data" "12068","modal-dialog" "12068","qml" "12065","smtp" "12062","google-sheets-formula" "12039","radio-button" "12034","doctrine" "12033","http-headers" "11995","grid" "11993","xmlhttprequest" "11979","sonarqube" "11975","lucene" "11921","nuget" "11869","java-stream" "11842","listbox" "11828","internationalization" "11813","components" "11808","initialization" "11806","switch-statement" "11797","apache-camel" "11793","google-play" "11782","snowflake-cloud-data-platform" "11777","boolean" "11726","ios5" "11724","ldap" "11716","serial-port" "11660","return" "11640","eclipse-plugin" "11635","youtube-api" "11613","frameworks" "11595","pivot" "11594","tags" "11540","gdb" "11509","latex" "11464","asp-classic" "11447","dataset" "11435","containers" "11433","compiler-construction" "11413","label" "11409","subquery" "11408","foreign-keys" "11404","network-programming" "11390","uinavigationcontroller" "11362","delegates" "11356","copy" "11355","struts2" "11319","protractor" "11298","sql-server-2008-r2" "11290","google-cloud-storage" "11284","base64" "11275","uibutton" "11254","find" "11251","migration" "11248","queue" "11184","append" "11182","arguments" "11177","composer-php" "11156","jaxb" "11151","c++17" "11133","zip" "11083","stack" "11070","cucumber" "11065","autolayout" "11029","embedded" "10979","entity-framework-6" "10969","ide" "10966","popup" "10959","windows-7" "10920","github-actions" "10915","iteration" "10845","vb6" "10837","r-markdown" "10835","jqgrid" "10801","ssl-certificate" "10801","gmail" "10793","hover" "10769","android-viewpager" "10756","airflow" "10753","command" "10732","passwords" "10713","udp" "10695","g++" "10693","range" "10685","vue-component" "10682","uiwebview" "10644","ios4" "10627","twig" "10612","uiimageview" "10608","salesforce" "10607","conv-neural-network" "10543","clang" "10534","authorization" "10523","local-storage" "10519","twilio" "10473","bots" "10468","pytest" "10454","angular-ui-router" "10415","jersey" "10388","wix" "10369","constants" "10368","polymorphism" "10363","ionic3" "10309","gps" "10307","user-controls" "10296","connection" "10272","debian" "10271","time-complexity" "10264","compare" "10263","windows-8" "10237","django-admin" "10232","localhost" "10200","slider" "10187","google-oauth" "10184","tidyverse" "10163","cocos2d-iphone" "10130","python-imaging-library" "10125","tailwind-css" "10104","admob" "10098","ado.net" "10058","certificate" "10047","phpunit" "10031","save" "10016","azure-sql-database" "9999","mono" "9977","jframe" "9971","sbt" "9959","pipe" "9934","cypress" "9918","fetch" "9879","cypher" "9877","output" "9866","fullcalendar" "9861","mapping" "9860","imageview" "9851","runtime-error" "9842","timeout" "9832","apache-poi" "9830","gson" "9798","include" "9786","java-native-interface" "9777","babeljs" "9742","coffeescript" "9741","hex" "9740","drupal-7" "9728","seaborn" "9710","signalr" "9703","jinja2" "9697","substring" "9690","web-crawler" "9675","bluetooth-lowenergy" "9674","erlang" "9665","typo3" "9663","icons" "9653","observable" "9647","command-line-interface" "9647","odbc" "9646","filesystems" "9633","location" "9633","int" "9623","cocoapods" "9616","export" "9607","log4j" "9601","elixir" "9581","syntax-error" "9576","printf" "9567","window" "9560","regression" "9532","dax" "9529","treeview" "9506","telerik" "9505","key" "9501","storyboard" "9492","maps" "9490","realm" "9479","thread-safety" "9467","azure-data-factory" "9460","iis-7" "9440","logic" "9428","build.gradle" "9418","ruby-on-rails-5" "9412","botframework" "9411","kernel" "9375","click" "9375","in-app-purchase" "9351","wordpress-theming" "9345","asp.net-core-webapi" "9345","amazon-elastic-beanstalk" "9339","microservices" "9338","imagemagick" "9335","jsx" "9330","resources" "9317","compression" "9310","malloc" "9299","thymeleaf" "9296","ip" "9282","ios8" "9271","ckeditor" "9271","wsdl" "9266","vuetify.js" "9256","position" "9256","resize" "9247","uiimage" "9242","cloud" "9239","state" "9215","dojo" "9183","repository" "9169","webrtc" "9152","gpu" "9131","where-clause" "9127","celery" "9106","actionscript" "9103","office365" "9076","cross-browser" "9073","max" "9070","asp.net-identity" "9067","angularjs-ng-repeat" "9060","gruntjs" "9035","azure-blob-storage" "9029","windows-services" "9028","escaping" "9008","closures" "9008","jquery-selectors" "9004","google-visualization" "8990","shopify" "8979","pthreads" "8974","markdown" "8962","constraints" "8953","windows-installer" "8940","angularjs-scope" "8933","pattern-matching" "8921","artificial-intelligence" "8920","google-chrome-devtools" "8896","locking" "8892","android-actionbar" "8873","styles" "8866","global-variables" "8863","backend" "8859","swift2" "8839","applescript" "8820","try-catch" "8815",".net-4.0" "8800","many-to-many" "8799","match" "8767","gitlab-ci" "8765","qt5" "8762","amazon-redshift" "8755","alignment" "8752","http-post" "8724","windows-runtime" "8704","pandas-groupby" "8700","web-config" "8681","ios6" "8680","video-streaming" "8658","zend-framework2" "8657","logstash" "8646","material-design" "8645","singleton" "8622","task" "8612","data-science" "8589","spring-batch" "8578","react-navigation" "8568","sh" "8568","c++14" "8567","operator-overloading" "8562","retrofit" "8536","gtk" "8528","vagrant" "8523","ef-code-first" "8521","uitextfield" "8520","jtable" "8510","bitbucket" "8493","mocha.js" "8458","internet-explorer-8" "8455","language-lawyer" "8450","jasper-reports" "8450","controls" "8448","testng" "8447","sharepoint-2010" "8430","asp.net-mvc-2" "8395","broadcastreceiver" "8394","bar-chart" "8385","aws-cloudformation" "8384","aggregate" "8361","language-agnostic" "8359","double" "8347","blackberry" "8298","hdfs" "8295","conda" "8294","left-join" "8289","android-sqlite" "8278","tinymce" "8271","pivot-table" "8270","polymer" "8260","virtual-machine" "8258","mercurial" "8245","client" "8238","webserver" "8219","case" "8216","glsl" "8214","akka" "8208","out-of-memory" "8208","comparison" "8206","devops" "8204","themes" "8172","databricks" "8168","scheme" "8166","overriding" "8156","deserialization" "8148","app-store" "8147","momentjs" "8143","fragment" "8136","query-optimization" "8132","parameter-passing" "8131","accessibility" "8091","jupyter" "8087","shared-libraries" "8074","apple-push-notifications" "8074","tcl" "8064","keycloak" "8059","mule" "8026","spring-integration" "8024","puppeteer" "8018","html5-video" "8017","usb" "8011","media-queries" "8009","full-text-search" "7995","bigdata" "7986","apache2" "7985","refactoring" "7976","bit-manipulation" "7954","apk" "7951","tableview" "7933","google-colaboratory" "7909","dynamics-crm" "7908","cygwin" "7904","rstudio" "7889","seo" "7889","appium" "7878","aws-api-gateway" "7867","httprequest" "7859","angular6" "7858","runtime" "7854","classification" "7840","apache-flink" "7839","boto3" "7834","operators" "7824","protocol-buffers" "7820","react-router-dom" "7815","byte" "7799","typeerror" "7797","row" "7793","character" "7791","filtering" "7787","coding-style" "7783","adb" "7783","single-sign-on" "7770","python-asyncio" "7755","air" "7753","vuex" "7748","bootstrap-modal" "7740","openshift" "7729","sharedpreferences" "7728","jax-rs" "7723","asp.net-web-api2" "7723","requirejs" "7722","token" "7719","blob" "7713","glassfish" "7707","visual-studio-2019" "7703","handlebars.js" "7696","rss" "7695","windows-phone-8.1" "7695","sql-order-by" "7694","expression" "7689","azure-cosmosdb" "7678","css-animations" "7668","odata" "7644","ocaml" "7634","oracle-sqldeveloper" "7632","decimal" "7631","jms" "7620","grouping" "7609","progress-bar" "7605","sms" "7604","schema" "7600","phantomjs" "7599","2d" "7588","jpanel" "7581","phpstorm" "7569","retrofit2" "7567","ssms" "7565","maui" "7546","pdf-generation" "7541","virtualenv" "7537","report" "7536","signals" "7522","nunit" "7501","kendo-grid" "7495","android-webview" "7472","laravel-blade" "7472","scanf" "7457","firefox-addon" "7446","webkit" "7440","applet" "7421","pine-script" "7415","data-visualization" "7413","streaming" "7406","amazon-cognito" "7393","registry" "7393","angular-cli" "7373","console-application" "7365","entity-framework-4" "7338","aes" "7333","focus" "7308","xna" "7301","laravel-8" "7301","google-cloud-messaging" "7298","less" "7290","nativescript" "7285","jenkins-plugins" "7271","firebase-storage" "7266","devexpress" "7250","wxpython" "7245","jetty" "7237","tooltip" "7236","database-connection" "7229","google-calendar-api" "7229","ipython" "7228","google-cloud-datastore" "7228","google-play-services" "7224","scheduled-tasks" "7218","x86-64" "7205","notepad++" "7202","javascript-objects" "7190","powerpoint" "7176","load" "7161","fastapi" "7151","content-management-system" "7140","list-comprehension" "7140","flask-sqlalchemy" "7123","nltk" "7116","nsstring" "7116","mpi" "7115","oracle10g" "7112","websphere" "7112","buffer" "7109","amazon-rds" "7101","size" "7087","uilabel" "7083","sapui5" "7077","android-room" "7049","integration-testing" "7049","mysql-workbench" "7043","scrollview" "7041","flutter-dependencies" "7037","oracle-apex" "7035","uml" "7031","shader" "7027","http-status-code-404" "7021","rendering" "7018","google-kubernetes-engine" "7014","extract" "7007","visualization" "7007","prometheus" "7006","lisp" "7006","homebrew" "7003","lodash" "6987","vaadin" "6983","cursor" "6976","ascii" "6975","windows-store-apps" "6969","playframework-2.0" "6967","ruby-on-rails-3.2" "6966","rx-java" "6966","passport.js" "6965","eslint" "6961","overloading" "6948","rsa" "6947","hbase" "6912","version" "6911","pymongo" "6910","httpclient" "6890","robotframework" "6887","domain-driven-design" "6870","linq-to-entities" "6869","subset" "6863","processing" "6855","big-o" "6846","django-queryset" "6845","mingw" "6844","coordinates" "6840","undefined" "6837","relational-database" "6833","gnuplot" "6830","binary-tree" "6816","blockchain" "6816","ethereum" "6816","storage" "6815","png" "6807","ibm-cloud" "6787","jsoup" "6783","webgl" "6782","google-compute-engine" "6781","port" "6778","jq" "6776","vectorization" "6774","windows-phone" "6772","grpc" "6766","pyinstaller" "6762","jquery-validate" "6761","histogram" "6733","android-volley" "6731","text-files" "6729","vite" "6727","xhtml" "6708","android-service" "6707","node-modules" "6706","solidity" "6701","fork" "6700","gis" "6700","ejb" "6680","vsto" "6680","inner-join" "6666","wildfly" "6654","heap-memory" "6631","automapper" "6628","openmp" "6603","azure-storage" "6598","karma-jasmine" "6590","awt" "6582","structure" "6573","mapbox" "6573","linear-regression" "6571","sails.js" "6566","llvm" "6550","android-camera" "6539","angular5" "6535","client-server" "6521","dropdown" "6519","ejs" "6514","scrollbar" "6513","uitabbarcontroller" "6505","chef-infra" "6490","avfoundation" "6487","java.util.scanner" "6487","liferay" "6482","generator" "6477","metadata" "6464","sitecore" "6464","entity" "6446","mqtt" "6439","combinations" "6422","textarea" "6399","binary-search-tree" "6395","kibana" "6383","overflow" "6382","pug" "6378","cross-domain" "6378","spring-webflux" "6375","kubernetes-helm" "6375","powerquery" "6369","bootstrap-5" "6350","sublimetext3" "6348","aws-sdk" "6344","jekyll" "6341","common-lisp" "6338","this" "6335","css-position" "6331","slice" "6313","comments" "6311","ocr" "6310","touch" "6307","css-grid" "6304","css-transitions" "6295","lstm" "6292","formula" "6291","element" "6279","verilog" "6274","task-parallel-library" "6267","carousel" "6263","nodes" "6261","line" "6255","mouseevent" "6246","telegram" "6238","excel-2010" "6232","cluster-analysis" "6231","interface-builder" "6228","osgi" "6225","docusignapi" "6224","hyperledger-fabric" "6218","fetch-api" "6218","prepared-statement" "6216","vue-router" "6216","height" "6215","uinavigationbar" "6204","config" "6194","sparql" "6183","google-sheets-api" "6176","uri" "6172","c++-cli" "6168","unique" "6165","ssrs-2008" "6161","azure-ad-b2c" "6157","instagram" "6154","couchdb" "6151","app-store-connect" "6150","associations" "6147","navbar" "6139","tdd" "6139","zsh" "6137","jquery-animate" "6118","swt" "6116","xcode6" "6114","gzip" "6111","64-bit" "6105","posix" "6102","xslt-1.0" "6097","std" "6091","android-manifest" "6086","teamcity" "6077","alamofire" "6074","sequence" "6073","width" "6072","adobe" "6071","zooming" "6070","profiling" "6070","cross-platform" "6070","ios-simulator" "6067","ibm-mobilefirst" "6061","networkx" "6052","background-image" "6048","driver" "6044","python-import" "6043","svelte" "6043","ms-access-2010" "6038","html-parsing" "6035","weblogic" "6030","editor" "6027","transform" "6014","apply" "6014","lazy-loading" "5993","html-lists" "5983","ms-office" "5979","wifi" "5979","mapkit" "5968","windows-subsystem-for-linux" "5964","css-float" "5962","grafana" "5959","etl" "5957","exec" "5949","drawing" "5942","capybara" "5942","mips" "5939","jira" "5939","toggle" "5936",".net-3.5" "5935","xmpp" "5931","javafx-8" "5930","field" "5928","directx" "5923","border" "5923",".net-6.0" "5919","multiple-columns" "5916","gatsby" "5914","signal-processing" "5914","response" "5908","c-preprocessor" "5900","textures" "5897","create-react-app" "5897","chat" "5894","warnings" "5892","sympy" "5880","racket" "5875","aggregate-functions" "5873","prestashop" "5849","preg-replace" "5843","average" "5822","uitextview" "5811","vhdl" "5810","moq" "5800","subdomain" "5799","navigation-drawer" "5795","backup" "5790","interop" "5769","hook" "5763","tensorflow2.0" "5757","opencl" "5751","echo" "5749","underscore.js" "5746","java-me" "5744","reactive-programming" "5739","hosting" "5738","wpf-controls" "5732","activemq-classic" "5730","android-widget" "5723","office-js" "5720","android-alertdialog" "5712","converters" "5696","pipeline" "5695","ssas" "5694","maven-2" "5693","dynamic-programming" "5672","listener" "5669","swift4" "5661","virtualbox" "5656","relationship" "5651","openid-connect" "5647","c++20" "5645","eclipse-rcp" "5641","user-input" "5639","font-awesome" "5638","openpyxl" "5636","android-animation" "5634","progressive-web-apps" "5632","amazon-iam" "5625","jquery-select2" "5623","addition" "5621","python-3.6" "5618","teradata" "5616","win-universal-app" "5616","spark-streaming" "5614","protocols" "5604","pyqt4" "5592","phpmailer" "5592","cordova-plugins" "5582","ionic4" "5574","rounding" "5573","keyboard-shortcuts" "5572","httpwebrequest" "5571","extjs4" "5563","firebase-security" "5551","internet-explorer-11" "5547","stm32" "5543","google-cloud-dataflow" "5539","cluster-computing" "5510","webstorm" "5510","hashtable" "5507","performance-testing" "5506","wamp" "5504","bundle" "5504","exe" "5501","rename" "5494","codeigniter-3" "5494","dialogflow-es" "5492","fluent-nhibernate" "5487","push" "5482","ember-data" "5480","jstl" "5478","settings" "5478","tomcat7" "5478","cxf" "5472","lxml" "5471","branch" "5468","amazon-ecs" "5467","microsoft-teams" "5464","workflow" "5455","xpages" "5448","fft" "5447","npm-install" "5446","prototype" "5424","identityserver4" "5418","instance" "5417","tableau-api" "5397","single-page-application" "5395","speech-recognition" "5394","cpanel" "5391","xcode4" "5388","code-coverage" "5383","refresh" "5382","linkedin-api" "5381","xquery" "5370","knitr" "5368","settimeout" "5365","preg-match" "5361","sinatra" "5352","e-commerce" "5346","google-maps-markers" "5341","cython" "5337","nsarray" "5335","union" "5333","simulation" "5331","abstract-class" "5331","titanium" "5324","render" "5321","facebook-javascript-sdk" "5319","pom.xml" "5319","opencart" "5313","apache-nifi" "5311","parent-child" "5307","nsmutablearray" "5307","export-to-csv" "5303","permutation" "5300","octave" "5298","servicestack" "5298","asp.net-ajax" "5293","qt4" "5292","locale" "5288","counter" "5280","es6-promise" "5277","submit" "5275","load-balancing" "5271","antd" "5267","interpolation" "5263","transition" "5255","nasm" "5241","fancybox" "5239","maven-3" "5236","ruby-on-rails-3.1" "5218","reverse-proxy" "5213","jakarta-mail" "5212","spring-cloud" "5211","angular7" "5196","apache-pig" "5192","memcached" "5190","jquery-events" "5187","spyder" "5186","sftp" "5181","html-select" "5180","cgi" "5179","blazor-server-side" "5177","openlayers" "5167","distinct" "5166","telegram-bot" "5166","legend" "5160","html-email" "5155","silverlight-4.0" "5152","query-string" "5151","spinner" "5150","sql-insert" "5139","persistence" "5130","textfield" "5130","google-signin" "5129","linux-device-driver" "5128","zurb-foundation" "5127","google-tag-manager" "5124","newline" "5124","responsive" "5120","segue" "5115","cell" "5110","url-routing" "5102","product" "5093","eclipselink" "5074","amazon-cloudfront" "5073","magento2" "5072","href" "5072","hql" "5069","h2" "5058","command-line-arguments" "5057","ag-grid" "5055","special-characters" "5051","aws-amplify" "5049","linq-to-xml" "5042","adapter" "5038","aem" "5035","anchor" "5032","google-places-api" "5019","netty" "5017","gstreamer" "5013","github-pages" "5001","pickle" "5000","decorator" "4998","microsoft-edge" "4992","mkmapview" "4992","sdl" "4972","user-defined-functions" "4971","jpeg" "4964","android-notifications" "4962","android-linearlayout" "4960","qt-creator" "4958","server-side-rendering" "4957","codenameone" "4956","viewmodel" "4955","action" "4952","embed" "4948","translation" "4948","nested-loops" "4947","eval" "4945","resharper" "4943","ubuntu-16.04" "4931","jbutton" "4931","geospatial" "4926","alert" "4917","analytics" "4911","tortoisesvn" "4907","python-multiprocessing" "4902","jhipster" "4897","rails-activerecord" "4892","data-analysis" "4890","integration" "4881","session-cookies" "4873","inno-setup" "4872","netsuite" "4860","typescript-typings" "4859","webhooks" "4858","classpath" "4858","sharepoint-2013" "4855","overlay" "4849","apache-beam" "4849","javafx-2" "4842","ubuntu-14.04" "4836","angular-reactive-forms" "4834","nsdate" "4831","project" "4828","typeorm" "4820","hiveql" "4813","exchange-server" "4809","metaprogramming" "4809","stdout" "4808","xslt-2.0" "4807","angular2-routing" "4800","monitoring" "4796","android-mediaplayer" "4789","azure-databricks" "4783","datasource" "4783","core-graphics" "4782","upgrade" "4781","screenshot" "4780","screen" "4777","native" "4775","mutex" "4764","multipartform-data" "4763","service-worker" "4763","sprite" "4758","setinterval" "4751","hide" "4748","kotlin-coroutines" "4745","bokeh" "4742","webbrowser-control" "4741","boost-asio" "4738","sql-server-2014" "4733","mongoid" "4733","typescript-generics" "4732","return-value" "4729","sencha-touch" "4724","csrf" "4723","global" "4722","augmented-reality" "4722","threadpool" "4719","cpu" "4719","angular8" "4711","stata" "4709","autohotkey" "4703","primeng" "4699","postgis" "4696","openapi" "4696","system" "4688","documentation" "4682","categories" "4682","quarkus" "4681","xml-serialization" "4677","middleware" "4670","gunicorn" "4668","fabricjs" "4663","diff" "4662","mobile-safari" "4661","vscode-extensions" "4660","object-detection" "4658","wildcard" "4654","web-deployment" "4651","angular-ui-bootstrap" "4644","crud" "4642","calculator" "4637","owin" "4635","karate" "4623","spreadsheet" "4621","soapui" "4621","cross-compiling" "4620","connection-string" "4620","karma-runner" "4620","ipc" "4619","polygon" "4618","plotly-dash" "4618","embedded-linux" "4616","real-time" "4611","dask" "4610","centos7" "4609","customization" "4606","linear-algebra" "4602","styled-components" "4600","alarmmanager" "4599","precision" "4596","outlook-addin" "4592","advanced-custom-fields" "4591","ngrx" "4586","razor-pages" "4583","apollo" "4579","gcloud" "4578","static-libraries" "4574","laravel-5.1" "4573","admin" "4573","contextmenu" "4573","gnu-make" "4563","primary-key" "4559","mp3" "4555","swagger-ui" "4554","pass-by-reference" "4551","scale" "4547","imap" "4545","clone" "4545","intellisense" "4545","vlookup" "4545","message" "4542","spring-kafka" "4537","youtube-data-api" "4529","svm" "4508","xss" "4501","umbraco" "4501","wolfram-mathematica" "4500","graph-theory" "4494","okhttp" "4494","computer-science" "4493","nfc" "4492","smarty" "4491","psycopg2" "4487","alias" "4482","aws-cli" "4479","uicollectionviewcell" "4477","log4j2" "4477","powerbi-desktop" "4473","cakephp-3.0" "4472","tesseract" "4468","addeventlistener" "4468","heatmap" "4467","share" "4459","oledb" "4457","innodb" "4456","ibm-mq" "4452","prism" "4452","emulation" "4445","collision-detection" "4443","bioinformatics" "4442","powershell-2.0" "4441","function-pointers" "4439","proguard" "4436","dynamics-crm-2011" "4425","variable-assignment" "4424","openstreetmap" "4421","recaptcha" "4419","shapes" "4410","visual-studio-2022" "4406","limit" "4401","rows" "4401","inputstream" "4395","whitespace" "4389","inversion-of-control" "4388","wmi" "4386","plpgsql" "4386","autodesk-forge" "4384","gradient" "4383","internet-explorer-9" "4381","geojson" "4379","database-migration" "4379","mouse" "4377","android-arrayadapter" "4373","rake" "4371","ms-access-2007" "4370","decode" "4366","artifactory" "4364","chromium" "4360","chatbot" "4353","nan" "4352","kafka-consumer-api" "4348","tidyr" "4344","gmail-api" "4339","google-analytics-api" "4335","autofac" "4333","codeblocks" "4322","rdf" "4318","sparse-matrix" "4315","string-formatting" "4302","enzyme" "4299","amazon-sqs" "4293","azure-logic-apps" "4287","greatest-n-per-group" "4286","antlr" "4283","paperclip" "4273","payment-gateway" "4271","common-table-expression" "4258","amazon-cloudwatch" "4257","grails-orm" "4252","android-imageview" "4247","terraform-provider-aws" "4242","stack-overflow" "4238","window-functions" "4236","delay" "4235","wxwidgets" "4232","laravel-5.3" "4221","aws-glue" "4218","call" "4217","custom-controls" "4211","cpu-architecture" "4207","xcode8" "4205","qr-code" "4203","iis-7.5" "4200","command-prompt" "4199","ctypes" "4197","valgrind" "4194","phonegap-plugins" "4186","netlogo" "4185","access-token" "4180","onclicklistener" "4179","asp.net-core-2.0" "4177","filenames" "4174","bundler" "4166","orientation" "4163","flutter-web" "4162","accordion" "4162","subclass" "4161","core-animation" "4158","junit4" "4157","yarnpkg" "4156","classloader" "4156","laravel-5.4" "4153","ios9" "4149","asp.net-mvc-routing" "4145","clipboard" "4139","rx-java2" "4123","python-3.7" "4121","scenekit" "4121","webclient" "4120","google-plus" "4117","uiimagepickercontroller" "4114","wso2-esb" "4111","rvm" "4111","cakephp-2.0" "4108","puppet" "4103","nsdictionary" "4103","android-permissions" "4101","parquet" "4098","pixel" "4096","drools" "4094","internet-explorer-7" "4091","raspberry-pi3" "4088","exchangewebservices" "4087","z-index" "4085","programming-languages" "4083","travis-ci" "4081","python-multithreading" "4080","panel" "4075","md5" "4073","liquid" "4073","probability" "4073","rdd" "4071","jax-ws" "4065","react-bootstrap" "4064","phoenix-framework" "4062","couchbase" "4058","django-orm" "4057","azure-application-insights" "4056","selection" "4053","jsonp" "4051","game-development" "4047","naming-conventions" "4044","lapply" "4043","sublimetext2" "4038","cdi" "4033","linker-errors" "4032","apache-kafka-streams" "4030","antlr4" "4026","variadic-templates" "4026","batch-processing" "4025","symfony4" "4022","spotify" "4013","contacts" "4012","igraph" "4011","padding" "4011","log4net" "4004","javabeans" "4003","digital-ocean" "4002","bind" "4002","sharepoint-online" "4000","message-queue" "3997","oracle12c" "3994","android-view" "3988","distance" "3988","facebook-like" "3987","winrt-xaml" "3985","xcode5" "3984","symfony1" "3980","mean" "3974","mdx" "3967","blazor-webassembly" "3961","urllib" "3957","clr" "3955","ads" "3955","kubernetes-ingress" "3953","reverse-engineering" "3952","media-player" "3948","facebook-opengraph" "3946","hadoop-yarn" "3940","xcode7" "3935","hyperledger" "3935","game-physics" "3934","simplexml" "3933","entity-framework-5" "3929","data-manipulation" "3920","unity-container" "3919","stdin" "3914","code-generation" "3912","opengl-es-2.0" "3905","replication" "3905","flex4" "3905","numpy-ndarray" "3904","firemonkey" "3902","wkwebview" "3901","reshape" "3895","selector" "3895","redhat" "3892","atomic" "3887","pyodbc" "3886","manifest" "3886","minecraft" "3886","iot" "3884","marklogic" "3882","ip-address" "3881","pentaho" "3878","mean-stack" "3877","cocos2d-x" "3876","yocto" "3876","future" "3875","microsoft-metro" "3874","capistrano" "3871","apache-kafka-connect" "3868","ui-automation" "3866","complexity-theory" "3865","each" "3865","google-cloud-sql" "3864","httpresponse" "3862","amazon-eks" "3858","wget" "3856","liquibase" "3856","android-relativelayout" "3853","prisma" "3853","spacy" "3852","loading" "3852","ninject" "3850","router" "3849","session-variables" "3846","sql-server-2016" "3842","sencha-touch-2" "3834","openxml" "3834","activex" "3833","matlab-figure" "3830","firebird" "3830","aws-cdk" "3829","game-engine" "3828","automatic-ref-counting" "3817","reverse" "3817","sql-injection" "3816","option-type" "3815","quartz-scheduler" "3809","android-canvas" "3807","raster" "3805","screen-scraping" "3804","web-component" "3803","inline" "3801","github-api" "3797","python-sphinx" "3794","pinvoke" "3792","system-calls" "3790","azureservicebus" "3784","updates" "3784",".net-4.5" "3781","django-urls" "3779","nsuserdefaults" "3779","logistic-regression" "3772","text-to-speech" "3771","elisp" "3769","marshalling" "3767","grand-central-dispatch" "3767","react-testing-library" "3767","microcontroller" "3763","gallery" "3760","tornado" "3756","avro" "3755","local" "3753","wicket" "3753","margin" "3747","afnetworking" "3746","war" "3746","one-to-many" "3745","psql" "3743","angular-routing" "3741","executable" "3741","nvidia" "3738","elastic-stack" "3736","nuget-package" "3732","junit5" "3732","splash-screen" "3727","handler" "3724","frame" "3723","background-color" "3719","reporting" "3719","c#-3.0" "3717","mvvmcross" "3715","immutability" "3715","apache-zookeeper" "3715","pdfbox" "3713","maven-plugin" "3712","logback" "3709","openid" "3707","random-forest" "3706","correlation" "3706","richfaces" "3706","uisearchbar" "3703","aop" "3703","kubectl" "3694","nokogiri" "3694","lookup" "3692","scatter-plot" "3692","draggable" "3690","windows-8.1" "3689","excel-2007" "3680","facebook-php-sdk" "3679","paypal-sandbox" "3673","sql-server-ce" "3655","python-typing" "3654","redux-toolkit" "3653","wrapper" "3648","export-to-excel" "3648","office-interop" "3644","syntax-highlighting" "3642","drupal-6" "3639","uigesturerecognizer" "3636","dynamic-memory-allocation" "3634","phpexcel" "3632","ssrs-2012" "3632","cs50" "3631","saml" "3631","mediawiki" "3630","sfml" "3629","google-docs" "3628","azure-aks" "3623","bit" "3621","argparse" "3620","fxml" "3620","avplayer" "3619","toolbar" "3618","gremlin" "3618","activeadmin" "3617","pyside" "3614","passenger" "3610","atom-editor" "3610","extension-methods" "3608","amazon-athena" "3604","html5-audio" "3603","series" "3602","xlsx" "3602","ubuntu-18.04" "3602","struts" "3600","infinite-loop" "3597","assets" "3596","biztalk" "3596","physics" "3596","benchmarking" "3595","python-unittest" "3591","intel" "3590","appcelerator" "3590","reduce" "3588","header-files" "3584","serverless" "3584","digital-signature" "3581","kerberos" "3580","traits" "3579","vercel" "3577","jboss7.x" "3575","store" "3572","mern" "3569","materialize" "3569","data-cleaning" "3564","slideshow" "3564","asset-pipeline" "3564","curve-fitting" "3563","android-support-library" "3560","increment" "3559","richtextbox" "3558","acumatica" "3558","ienumerable" "3557","rgb" "3556","xdebug" "3556","guava" "3553","draw" "3549","transparency" "3544","setuptools" "3542","alfresco" "3540","dropbox" "3538","dotnetnuke" "3538","haml" "3538","eigen" "3536","default" "3535","android-spinner" "3533","symbols" "3529","open-source" "3523","deadlock" "3521","purrr" "3517","jpql" "3517","monads" "3517","copy-paste" "3513","c++builder" "3513","office-addins" "3509","lotus-notes" "3509","use-effect" "3507","jsonschema" "3504","fullscreen" "3503","git-bash" "3501","importerror" "3500","backgroundworker" "3498","k-means" "3497","actionlistener" "3493","google-maps-android-api-2" "3492","footer" "3492","transformation" "3491","system-verilog" "3489","huggingface-transformers" "3486","scheduler" "3485","next.js13" "3484","onchange" "3481","package.json" "3474","wait" "3474","windows-xp" "3473","mathematical-optimization" "3473","aggregation" "3472","ros" "3472","libraries" "3471","sqlplus" "3469","twisted" "3466","deep-linking" "3465","html-agility-pack" "3460","payment" "3457","mime-types" "3457","plist" "3452","sublimetext" "3450","move" "3448","load-testing" "3448","declaration" "3446","boxplot" "3446","system.reactive" "3446","font-face" "3439","trigonometry" "3435","abap" "3431","powershell-3.0" "3427","block" "3427","jquery-ui-sortable" "3422","center" "3421","mybatis" "3415","spatial" "3414","git-merge" "3409","publish" "3409","interrupt" "3409","aurelia" "3409","bazel" "3407","wso2-api-manager" "3406","release" "3406","amazon-emr" "3405","x11" "3405","bdd" "3404","apollo-client" "3400","sendgrid" "3393","semaphore" "3392","external" "3392","commit" "3391","clickonce" "3391","android-adapter" "3389","actions-on-google" "3388","python-3.5" "3385","facebook-login" "3382","standards" "3382","mongoose-schema" "3378","desktop-application" "3376","media" "3375","shared-ptr" "3372","datetimepicker" "3371","react-props" "3369",".net-assembly" "3368","primes" "3364","magento-1.7" "3353","android-espresso" "3353","aspectj" "3350","transpose" "3350","recurrent-neural-network" "3349","uipickerview" "3348","root" "3348","hook-woocommerce" "3347","project-reactor" "3345","basic-authentication" "3345","eclipse-cdt" "3345","sybase" "3338","slf4j" "3335","here-api" "3333","cloudflare" "3332","tls1.2" "3330","zeromq" "3329","perforce" "3325","arkit" "3324","regex-lookarounds" "3321","flink-streaming" "3318","vpn" "3318","playwright" "3317","mstest" "3313","spring-data-mongodb" "3309","uuid" "3306","turtle-graphics" "3306","use-state" "3304","stanford-nlp" "3302","compiler-optimization" "3299","tweepy" "3295","connection-pooling" "3294","android-custom-view" "3293","cloud-foundry" "3293","grammar" "3287","esp32" "3287","tfsbuild" "3286","xunit" "3286","entity-framework-migrations" "3283","bufferedreader" "3282","git-branch" "3279","box2d" "3276","actionbarsherlock" "3275","vertical-alignment" "3275","webpack-dev-server" "3274","gtk3" "3270","jlabel" "3269","updatepanel" "3268","array-formulas" "3263","indentation" "3263","blender" "3262","android-constraintlayout" "3259","slack" "3259","multer" "3257","alexa-skills-kit" "3255","custom-post-type" "3254","hibernate-mapping" "3254","httpurlconnection" "3249","asp.net-membership" "3247","mod-wsgi" "3247","auth0" "3246","quicksort" "3244","windows-mobile" "3243","lwjgl" "3243","multilingual" "3238","glob" "3237","watchkit" "3237","google-forms" "3234","key-value" "3229","nested-lists" "3227","cart" "3227","presto" "3226","guice" "3225","associative-array" "3223","libcurl" "3223","geocoding" "3221","jpa-2.0" "3221","vmware" "3220","sql-like" "3214","sleep" "3214","repository-pattern" "3213","mysql-python" "3208","whatsapp" "3208","android-contentprovider" "3206","gif" "3206","destructor" "3205","microsoft-dynamics" "3204","x509certificate" "3204","partitioning" "3200","normalization" "3200","encode" "3199","background-process" "3199","dagger-2" "3198","forms-authentication" "3197","require" "3195","docker-swarm" "3195","visibility" "3195","doxygen" "3191","edit" "3190","nest" "3190","git-submodules" "3189","mamp" "3186","factory" "3185","repeat" "3185","shared-memory" "3178","gitlab-ci-runner" "3177","datetime-format" "3177","android-source" "3166","distribution" "3162","bouncycastle" "3162","virtual" "3159","bower" "3151","versioning" "3150","p5.js" "3150","spring-security-oauth2" "3146","react-native-ios" "3145","nexus" "3142","coronasdk" "3142","azure-service-fabric" "3142","thumbnails" "3136","visual-studio-2005" "3135","na" "3134","python-itertools" "3134","crop" "3134","web-hosting" "3132","wear-os" "3131","codeigniter-2" "3130","angularfire2" "3129","userform" "3128","multi-tenant" "3125","expandablelistview" "3123","swift6" "3122","sql-delete" "3121","serverless-framework" "3117","core-location" "3116","typedef" "3116","ember-cli" "3115","file-permissions" "3114","google-cloud-pubsub" "3113","barcode" "3113","ignite" "3112","app-config" "3111","docx" "3111","android-toolbar" "3111","virtualhost" "3109","freemarker" "3104","mp4" "3103","data-modeling" "3103","swig" "3103","crashlytics" "3103","moodle" "3102","delphi-7" "3101","form-submit" "3101","android-jetpack" "3100","saml-2.0" "3100","collision" "3098","nsurlconnection" "3097","smartcontracts" "3097","dashboard" "3096","bitwise-operators" "3095","compact-framework" "3094","remote-access" "3094","axis" "3093","uwp-xaml" "3091","crm" "3081","dotnet-httpclient" "3080","cdn" "3079","rcpp" "3076","offset" "3074","windows-authentication" "3072","e2e-testing" "3070","data-mining" "3070","roles" "3065","video-processing" "3063","flash-builder" "3061","pie-chart" "3061","amazon-sagemaker" "3060",".net-5" "3056","jndi" "3053","v8" "3052","weka" "3052","wso2-identity-server" "3051","min" "3049","contains" "3048","data-annotations" "3045","delimiter" "3045","equals" "3044","stdvector" "3041","wireshark" "3039","facebook-fql" "3038","react-context" "3036","carrierwave" "3036","sdl-2" "3033","azure-resource-manager" "3031","dependency-management" "3031","nio" "3028","android-xml" "3027","rdlc" "3027","tokenize" "3025","binary-search" "3021","abstract-syntax-tree" "3020","wav" "3015","amazon-sns" "3014","xib" "3014","x86-16" "3013","gitignore" "3012","influxdb" "3012","magento-1.9" "3011","program-entry-point" "3009","sharepoint-2007" "3009","compatibility" "3008","identity" "3006","filepath" "3006","innerhtml" "3005","record" "3004","instagram-api" "3004","obfuscation" "3003","freeze" "3002","layout-manager" "3002","webassembly" "3000","publish-subscribe" "2999","document" "2998","hardware" "2998","conditional-formatting" "2997","android-drawable" "2994","matrix-multiplication" "2993","anylogic" "2993","azure-powershell" "2991","firewall" "2990","raspbian" "2988","jenkins-groovy" "2988","new-operator" "2987","graphviz" "2987","java-7" "2986","image-uploading" "2985","sendmail" "2985","javadoc" "2983","entity-relationship" "2981","drawable" "2981","currency" "2978","breakpoints" "2978","google-cloud-run" "2975","jquery-ui-datepicker" "2970","angular-material2" "2970","raphael" "2968","onedrive" "2965","device" "2964","highlight" "2963","graph-databases" "2963","jtextfield" "2962","nspredicate" "2961","coq" "2961","gd" "2957","azure-keyvault" "2956","display" "2956","urllib2" "2953","uwsgi" "2952","database-schema" "2951","browserify" "2950","aframe" "2949","master-pages" "2949","orchardcms" "2947","filereader" "2947","attachment" "2947","java-11" "2946","file-handling" "2945","latitude-longitude" "2943","windbg" "2943","intervals" "2941","rvest" "2940","slack-api" "2939","binaryfiles" "2936","jodatime" "2935","nsdateformatter" "2932","hazelcast" "2931","elementtree" "2930","tensor" "2930","gdi+" "2929","uistoryboard" "2929","dapper" "2928","fs" "2928","chai" "2922","parent" "2919","android-livedata" "2916","cpu-usage" "2914","blogger" "2912","fopen" "2908","browser-cache" "2904","iis-6" "2903","formik" "2902","azure-synapse" "2902","search-engine" "2900","sip" "2895","roslyn" "2893","entity-framework-4.1" "2892","content-security-policy" "2891","simulink" "2889","private" "2889","observablecollection" "2889","angular2-template" "2886","clion" "2886","jobs" "2885","metrics" "2884","sveltekit" "2884","nlog" "2883","number-formatting" "2882","python-2.x" "2879","azure-ad-msal" "2879","plone" "2879","ld" "2878","frequency" "2877","missing-data" "2877","do-while" "2877","startup" "2876","z3" "2872","distributed-computing" "2868","hierarchy" "2867","mask" "2867","indexoutofboundsexception" "2866","gnu" "2865","statsmodels" "2864","stylesheet" "2863","calayer" "2863","environment" "2862","resttemplate" "2861","nginx-reverse-proxy" "2861","fstream" "2860","strapi" "2860","googletest" "2859","es6-modules" "2857","blogs" "2856","viewport" "2855","webcam" "2852","mvvm-light" "2851","xgboost" "2851","ping" "2850","loopbackjs" "2849","sudo" "2847","patch" "2844","jruby" "2842","greasemonkey" "2842","smart-pointers" "2842","simple-form" "2838","swipe" "2835","captcha" "2835","font-size" "2834","criteria" "2834","asterisk" "2831","sinon" "2829","slim" "2826","caffe" "2826","asmx" "2826","prediction" "2824","ibm-midrange" "2823","data-warehouse" "2823","trace" "2823","arcgis" "2822","static-methods" "2821","rdbms" "2820","ios10" "2820","multi-index" "2818","drupal-8" "2817","fpga" "2815","shinydashboard" "2813","angularfire" "2812","spring-cloud-stream" "2810","breeze" "2810","autowired" "2809","paint" "2809","apple-m1" "2808","word-wrap" "2806","avaudioplayer" "2804","scheduling" "2803","type-inference" "2802","talend" "2802","computational-geometry" "2800","android-5.0-lollipop" "2799","ubuntu-12.04" "2796","contour" "2794","openai-api" "2792","jython" "2791","repeater" "2790","viewcontroller" "2789","filestream" "2789","nullreferenceexception" "2789","comparator" "2788","acl" "2787","keystore" "2787","mergesort" "2785","asp.net-core-3.1" "2784","solaris" "2783","h.264" "2781","geopandas" "2780","c-strings" "2775","dos" "2775","expect" "2772","flex3" "2771","reload" "2771","undefined-behavior" "2771","iphone-sdk-3.0" "2770","castle-windsor" "2770","graph-algorithm" "2768","prototypejs" "2766","ksh" "2764","gfortran" "2764","kivy-language" "2763","procedure" "2762","flutter-animation" "2761","angular-ui" "2760","twitter-oauth" "2759","fedora" "2757","voip" "2755","android-softkeyboard" "2754","domdocument" "2750","jfreechart" "2747","multiple-inheritance" "2747","semantic-ui" "2746","registration" "2745","google-play-console" "2743","php-7" "2742","matching" "2742","symfony-forms" "2740","regex-group" "2739","react-native-flatlist" "2739","credentials" "2739","surfaceview" "2738","jetbrains-ide" "2738","kendo-asp.net-mvc" "2738","assert" "2737","windows-server-2008" "2737","percentage" "2736","pca" "2732","jooq" "2731","azure-mobile-services" "2730","paypal-ipn" "2729","http-live-streaming" "2728","icloud" "2728","compiler-warnings" "2728","amazon-elb" "2726","tar" "2724","firebug" "2722","partial-views" "2719","cllocationmanager" "2718","operator-keyword" "2715","dynamic-sql" "2712","kinect" "2712","positioning" "2711","jscrollpane" "2711","minikube" "2708","reinforcement-learning" "2704","jupyter-lab" "2701","ado" "2698","postback" "2694","pine-script-v5" "2694","nuxt3.js" "2693","bing-maps" "2693","variadic-functions" "2693","mongodb-.net-driver" "2691","tomcat8" "2691","mesh" "2690","show-hide" "2688","simd" "2688","restkit" "2687","windows-ce" "2687","continuous-deployment" "2687","auto-increment" "2685","shortcut" "2685","istio" "2683","amazon-vpc" "2682","interceptor" "2681","paramiko" "2679","power-automate" "2679","android-appcompat" "2676","vert.x" "2675","subdirectory" "2672","helper" "2671","masm" "2670","checkout" "2670","kml" "2669","joomla2.5" "2669","styling" "2668","orientdb" "2667","vlc" "2662","monodevelop" "2661","remote-debugging" "2660","singly-linked-list" "2656","android-virtual-device" "2656","setstate" "2654","audio-streaming" "2654","angular2-forms" "2653","jspdf" "2652","simpledateformat" "2651","hudson" "2650","daemon" "2649","derby" "2648","amazon-route53" "2644","hdf5" "2644","d" "2643","factory-bot" "2643","mypy" "2641","phonegap-build" "2639","server-side" "2638","watir" "2638","haproxy" "2637","erb" "2637","32bit-64bit" "2635","instantiation" "2635","numeric" "2634","laravel-livewire" "2633","sensors" "2633","ironpython" "2631","priority-queue" "2630","bison" "2630","spring-aop" "2630","email-attachments" "2629","nsis" "2628","linear-programming" "2627","nstimer" "2626","amcharts" "2625","jsonb" "2624","depth-first-search" "2624","objective-c-blocks" "2623","pandoc" "2622","emoji" "2621","dao" "2619","keypress" "2619","logical-operators" "2617","break" "2617","exit" "2616","react-hook-form" "2616","web-audio-api" "2614","lubridate" "2613","picturebox" "2611","in-app-billing" "2611","lazy-evaluation" "2609","fosuserbundle" "2607","azure-cognitive-services" "2607","messaging" "2606","file-get-contents" "2605","feed" "2605","cicd" "2605","rmi" "2604","database-performance" "2602","code-signing" "2601","apex" "2601","pascal" "2600","free" "2597","text-mining" "2597","webdriverwait" "2596","sqoop" "2596","delphi-xe2" "2595","guzzle" "2592","lumen" "2592","el" "2592","stringr" "2591","dbcontext" "2591","attributeerror" "2588","event-listener" "2587","add-in" "2587","accelerometer" "2587","sql-server-2000" "2587","redux-thunk" "2586","query-builder" "2583","ipv6" "2582","deprecated" "2581","python-3.4" "2581","cross-validation" "2581","paste" "2581","maya" "2579","lotus-domino" "2578","mapbox-gl-js" "2577","apache-storm" "2577","contenteditable" "2577","axapta" "2577",".net-2.0" "2577","zxing" "2576","mootools" "2573","resultset" "2572","owl" "2572","azure-api-management" "2570","tcpclient" "2570","qemu" "2568","constexpr" "2567","pydev" "2561","rpc" "2561","android-videoview" "2557","str-replace" "2555","uialertview" "2554","multiplication" "2554","nav" "2551","barcode-scanner" "2551","tostring" "2548","menuitem" "2545","wampserver" "2545","abstract" "2545","iostream" "2542","picasso" "2540","hsqldb" "2540","android-resources" "2539","development-environment" "2537","channel" "2536","ravendb" "2535","image-segmentation" "2534","swap" "2531","bulkinsert" "2531","ios11" "2530","amqp" "2530","tk-toolkit" "2529","css-transforms" "2522","intersection" "2522","nodemailer" "2521","show" "2520","scaling" "2519","androidx" "2519","google-chrome-app" "2519","restsharp" "2518","photoshop" "2517","decision-tree" "2516","knex.js" "2514","windows-forms-designer" "2514","twilio-api" "2513","opacity" "2513","core-bluetooth" "2513","google-ads-api" "2511","cloudera" "2510","mysql-connector" "2509","ghc" "2509","powerapps" "2509","resteasy" "2508","rtsp" "2508","desktop" "2506","nginx-ingress" "2504","datatemplate" "2502","android-databinding" "2499","adt" "2497","wsgi" "2496","mechanize" "2495","meta-tags" "2494","python-decorators" "2493","core-audio" "2492","azure-virtual-machine" "2492","esp8266" "2489","telnet" "2489","sandbox" "2489","google-cloud-endpoints" "2488","symlink" "2488","wkhtmltopdf" "2487","relative-path" "2487","title" "2486","lombok" "2485","nsdata" "2485","spark-structured-streaming" "2484","nsurlsession" "2484","archive" "2482","gsub" "2482","video-capture" "2479","firebase-hosting" "2479","mouseover" "2478","redux-saga" "2474","laravel-5.5" "2474","javac" "2473","slick" "2473","model-binding" "2472","trim" "2472","nullable" "2471","firebase-analytics" "2471","rspec-rails" "2469","icalendar" "2468","finance" "2467","rsync" "2464","implicit-conversion" "2463","popen" "2463","systemd" "2463","plyr" "2463","communication" "2461","gensim" "2460","var" "2457","keyword" "2457","glfw" "2454","lightbox" "2451","minify" "2450","xml-namespaces" "2450","spring-jdbc" "2450","code-injection" "2450","speech-to-text" "2449","python-xarray" "2449","statusbar" "2446","jmx" "2445","theano" "2443","long-integer" "2442","casperjs" "2436","ngfor" "2436","android-lifecycle" "2436","sphinx" "2435","jcombobox" "2435","executable-jar" "2434","mailchimp" "2433","terraform-provider-azure" "2433","getelementbyid" "2432","datastax" "2432","liferay-6" "2431","ibm-watson" "2431","offline" "2429","pcre" "2427","installshield" "2426","vulkan" "2425","copy-constructor" "2425","race-condition" "2423","web3js" "2417","tiff" "2416","apache-axis" "2416","ada" "2413","symfony-1.4" "2413","openlayers-3" "2411","jena" "2411","android-button" "2411","prompt" "2410","vtk" "2410","wysiwyg" "2409","apple-watch" "2408","serilog" "2405","ejabberd" "2404","date-format" "2403","spock" "2401","sidekiq" "2401","zlib" "2401","user-agent" "2399","wagtail" "2398","snmp" "2396","redux-form" "2395","windows-10-universal" "2394","hybrid-mobile-app" "2392","json-deserialization" "2392","azure-table-storage" "2391","velocity" "2391","elf" "2389","readfile" "2388","models" "2387","flowtype" "2387","numba" "2387","reset" "2386","code-first" "2385","actionmailer" "2384","marionette" "2384","ehcache" "2383","dropbox-api" "2380","assemblies" "2380","resolution" "2378","indexeddb" "2377","utc" "2376","combinatorics" "2374","fibonacci" "2371","template-meta-programming" "2371","virtualization" "2370","avr" "2369","wpfdatagrid" "2368","boto" "2368","angular-directive" "2367","rust-cargo" "2367","rpm" "2365","sse" "2365","client-side" "2365","flask-wtforms" "2365","content-type" "2365","polymer-1.0" "2365","glibc" "2363","paging" "2357","coroutine" "2357","http-status-code-403" "2356","yeoman" "2354","stack-trace" "2352","visual-studio-debugging" "2351","omniauth" "2350","cloudkit" "2350","unix-timestamp" "2350","uibarbuttonitem" "2347","netcdf" "2346","apache-httpclient-4.x" "2345","reportviewer" "2345","ghostscript" "2345","openstack" "2345","dreamweaver" "2344","inner-classes" "2344","ejb-3.0" "2344","qtquick2" "2343","next-auth" "2343","urlencode" "2343","bcrypt" "2341","godot" "2340","cplex" "2338","ram" "2334","logcat" "2333","dllimport" "2332","streamlit" "2331","android-glide" "2330","splunk" "2329","unreal-engine4" "2328","android-cardview" "2328","executorservice" "2326","roblox" "2326","iis-express" "2325","corda" "2324","arabic" "2322","firebase-admin" "2322","subscription" "2320","uilocalnotification" "2319","pyserial" "2318","bytecode" "2318","react-apollo" "2318","forecasting" "2317","capacitor" "2316","vps" "2316","dependency-properties" "2316","winsock" "2316","shuffle" "2314","ssrs-2008-r2" "2314","scalability" "2314","pm2" "2314","string-matching" "2313","ajaxcontroltoolkit" "2312","clojurescript" "2312","uitabbar" "2312","traefik" "2311","amp-html" "2310","terminology" "2305","fpdf" "2305","specflow" "2304","nhibernate-mapping" "2301","calculated-columns" "2300","silverstripe" "2297","jersey-2.0" "2297","flyway" "2297","lifetime" "2296","build-process" "2296","odoo-8" "2295","android-mapview" "2294","azure-cli" "2294","interpreter" "2294","itunes" "2293","division" "2293","python-3.8" "2293","word2vec" "2292","nsfetchedresultscontroller" "2290","swiper.js" "2290","hashset" "2288","api-design" "2287","kernel-module" "2286","putty" "2284","tracking" "2284","glut" "2283","countdown" "2281","ddl" "2279","soap-client" "2274","pydantic" "2274","azure-webjobs" "2273","netlify" "2272","fiddler" "2269","neovim" "2268","web-worker" "2267","laravel-7" "2266","gpgpu" "2266","amazon-ses" "2266","dropzone.js" "2264","nsattributedstring" "2261","ibeacon" "2260","distributed" "2259","html-helper" "2257","sidebar" "2256","readline" "2254","photo" "2254","child-process" "2254","pull-request" "2254","keyboard-events" "2254","informix" "2254","breadth-first-search" "2253","uninstallation" "2253","rest-assured" "2252","string-comparison" "2251","configuration-files" "2250","infinite-scroll" "2250","shortcode" "2248","jsf-2.2" "2248","metal" "2246","classnotfoundexception" "2246","css-tables" "2246","node-red" "2244","webapi" "2243","python-polars" "2243","put" "2243","line-breaks" "2241","pygtk" "2240","arduino-uno" "2239","unique-ptr" "2239","rebase" "2238","nservicebus" "2237","apache-spark-mllib" "2235","gdal" "2234","pseudo-element" "2233","video.js" "2233","laravel-routing" "2231","yii2-advanced-app" "2231","sap-commerce-cloud" "2230","tensorflow-lite" "2230","tf.keras" "2229","nstableview" "2228","mef" "2227","tabcontrol" "2225","jquery-ui-dialog" "2225","andengine" "2223","clearcase" "2223","spring-data-rest" "2223","emgucv" "2221","selenium-ide" "2219","gesture" "2219","parallax" "2218","dry" "2217","kohana" "2216","pyramid" "2215","dsl" "2214","inline-assembly" "2214","shopping-cart" "2210","equality" "2210","text-editor" "2210","logout" "2210","mpmovieplayercontroller" "2210","static-analysis" "2207","scapy" "2206","ontology" "2205","bloc" "2205","osx-lion" "2205","noclassdeffounderror" "2204","angular2-services" "2202","tcpdf" "2200","implementation" "2200","searchview" "2199","vscode-debugger" "2198","grid-layout" "2197","image-resizing" "2196","elementor" "2195","android-theme" "2194","popover" "2194","drupal-modules" "2194","itext7" "2188","birt" "2188","omnet++" "2186","numerical-methods" "2186","storybook" "2184","detection" "2184","gdi" "2184","ms-access-2013" "2183","phaser-framework" "2182","kdb" "2177","getter-setter" "2172","android-bluetooth" "2171","masstransit" "2169","google-apps" "2168","android-6.0-marshmallow" "2167","centering" "2166","android-testing" "2165","git-commit" "2164","send" "2163","bufferedimage" "2162","rx-swift" "2162","nslayoutconstraint" "2162","torch" "2160","mixins" "2159","joomla3.0" "2159","ioc-container" "2159","plotly-python" "2159","endianness" "2157","drag" "2155","oracle-adf" "2154","kql" "2154","ifstream" "2153","lamp" "2151","dto" "2149","sizeof" "2148","move-semantics" "2148","odoo-10" "2146","quotes" "2146","testflight" "2145","cql" "2144","analysis" "2143","apollo-server" "2141","org-mode" "2138","anonymous-function" "2137","social-networking" "2136","lag" "2135","explode" "2134","stringbuilder" "2133","web2py" "2127","endpoint" "2123","clickhouse" "2122","ios13" "2121","jquery-ui-autocomplete" "2120","database-administration" "2120","spss" "2119","large-data" "2118","multi-select" "2118","hidden" "2117","langchain" "2117","angular-promise" "2117","android-tabhost" "2115","delete-file" "2114","spring-test" "2113","android-fragmentactivity" "2111","indy" "2111","expression-trees" "2111","layer" "2110","uisplitviewcontroller" "2109","tensorflow-datasets" "2109","reactive" "2108","flex-lexer" "2108","kineticjs" "2108","onload" "2106","nginx-config" "2105","sitemap" "2102","fatal-error" "2102","google-api-php-client" "2102","npgsql" "2102","toast" "2102","genetic-algorithm" "2101","confluent-platform" "2101","vb.net-2010" "2099","sml" "2099","varnish" "2097","adfs" "2097","ruby-on-rails-6" "2096","placeholder" "2096","opencv3.0" "2096","r-caret" "2094","jwplayer" "2094","convolution" "2094","weblogic12c" "2092","servlet-filters" "2092","soundcloud" "2090","internet-explorer-6" "2087","azure-iot-hub" "2086","fgets" "2086","vi" "2084","python-module" "2084","cakephp-1.3" "2083","console.log" "2083","osx-yosemite" "2083","pywin32" "2082","angular-services" "2082","arm64" "2081","firefox-addon-sdk" "2081","bit-shift" "2081","actor" "2080","hierarchical-data" "2076","business-intelligence" "2075","sonata-admin" "2073","impala" "2072","python-re" "2071","kubernetes-pod" "2071","shadow" "2071","angular-components" "2071","web.xml" "2070","clang++" "2070","fadein" "2070","uipageviewcontroller" "2070","directive" "2069","caliburn.micro" "2069","android-contacts" "2068","clock" "2068","sql-server-data-tools" "2067","angular-forms" "2066","recursive-query" "2063","runnable" "2062","flot" "2059","exc-bad-access" "2056","encapsulation" "2055","glm" "2054","raku" "2053","projection" "2053","combine" "2053","linechart" "2052","unzip" "2052","azure-data-explorer" "2051","fastcgi" "2049","mime" "2047","lets-encrypt" "2047","point" "2047","httpd.conf" "2045","string-concatenation" "2045","iis-8" "2044","tumblr" "2044","exoplayer" "2044","tkinter-canvas" "2043","modeling" "2043","android-tablayout" "2043","audio-recording" "2043","hadoop2" "2043","restore" "2042","directshow" "2040","phalcon" "2040","jtextarea" "2040","plesk" "2039","supabase" "2039","shapefile" "2039","hashcode" "2039","powermock" "2036","signature" "2036","gerrit" "2035","jstree" "2034","looker-studio" "2033","default-value" "2032","android-wifi" "2030","custom-wordpress-pages" "2028","subplot" "2026","azure-eventhub" "2026","dt" "2026","scenebuilder" "2025","jdbctemplate" "2025","jna" "2025","freebsd" "2023","appdelegate" "2021","guid" "2021","spring-transactions" "2021","querydsl" "2020","chromecast" "2020","java-ee-6" "2016","lifecycle" "2016","sticky" "2015","dompdf" "2014","data-conversion" "2014","xctest" "2013","react-select" "2013","dropwizard" "2010","traversal" "2010","iptables" "2007","azure-pipelines-release-pipeline" "2004","dispose" "2003","conditional-operator" "1999","xts" "1999","r-sf" "1999","cqrs" "1998","sentiment-analysis" "1998","jit" "1998","midi" "1998","difference" "1997","azure-ad-graph-api" "1995","lldb" "1995","biginteger" "1994","xlsxwriter" "1993","sha256" "1993","mmap" "1992","gsap" "1991","google-authentication" "1990","react-router-v4" "1990","google-workspace" "1990","zend-form" "1989","slick.js" "1989","ssh-keys" "1989","software-design" "1989","rally" "1988","tensorboard" "1988","modulo" "1987","indexof" "1987","space" "1986","directx-11" "1984","react-native-navigation" "1983","remote-server" "1983","osx-mavericks" "1982","typeclass" "1982","redmine" "1980","esb" "1980","ode" "1978","keychain" "1978","arangodb" "1975","p2p" "1975","azure-devops-rest-api" "1975","text-processing" "1974","go-gorm" "1973","semantic-web" "1971","internet-explorer-10" "1971","android-context" "1970","code-behind" "1968","hana" "1968","msmq" "1967","getjson" "1966","pgadmin" "1965","powershell-4.0" "1964","unmarshalling" "1964","target" "1963","mvp" "1963","packaging" "1962","volatile" "1962","spring-jms" "1961","azure-machine-learning-service" "1959","nested-forms" "1956","smartcard" "1955","atlassian-sourcetree" "1955","actionscript-2" "1954","mustache" "1954","soa" "1953","dataweave" "1953","opera" "1953","streamreader" "1952","xcode4.2" "1951","create-table" "1951","touch-event" "1950","navigationbar" "1949","vimeo" "1949","overlap" "1949","android-dialogfragment" "1948","shortest-path" "1948","outlook-web-addins" "1948","multiline" "1946","yolo" "1946","code-snippets" "1946","regex-negation" "1945","blur" "1943","pseudocode" "1942","git-svn" "1941","typoscript" "1940","equation" "1940","compass-sass" "1939","preg-match-all" "1938","kafka-producer-api" "1938","mpandroidchart" "1937","autodesk-viewer" "1937","predicate" "1933","jacoco" "1932","yacc" "1932","covariance" "1932","c99" "1932","dijkstra" "1932","bean-validation" "1932","query-performance" "1931","x509" "1929","embedded-resource" "1928","lm" "1928","imagick" "1927","void" "1927","init" "1926","public-key-encryption" "1925","multipart" "1925","transparent" "1925",".net-8.0" "1924","epplus" "1923","oozie" "1923","scikit-image" "1922","laravel-9" "1922","session-state" "1921","python-datetime" "1921","django-serializer" "1920","azure-data-lake" "1920","android-preferences" "1919","core-plot" "1919","delete-row" "1918","django-authentication" "1917","mobile-application" "1917","angular9" "1916","android-styles" "1912","hyperledger-composer" "1912","uart" "1910","enumeration" "1909","contact-form-7" "1909","laravel-6" "1909","quickbooks" "1907","win32com" "1907","substitution" "1906","slurm" "1906","checksum" "1906","broadcast" "1905","tvos" "1905","builder" "1905","diagram" "1905","azure-rm-template" "1903","fixed" "1903","wcf-data-services" "1901","mobx" "1901","android-library" "1900","form-data" "1900","monogame" "1897","android-pendingintent" "1896","pyautogui" "1895","getter" "1895","named-pipes" "1895","joptionpane" "1895","ncurses" "1895","elm" "1894","thrift" "1893","angular-ui-grid" "1892","saxon" "1892","allocation" "1891","server-sent-events" "1890","interactive" "1889","http2" "1888","qmake" "1886","h2o" "1886","google-translate" "1885","firebaseui" "1885","synchronized" "1884","tablesorter" "1883","selenium-grid" "1883","portlet" "1883","code-analysis" "1883","powerpivot" "1883","preprocessor" "1881","counting" "1879","serversocket" "1879","flutter-test" "1879","prestashop-1.6" "1878","cin" "1877","similarity" "1877","tmux" "1877","css-shapes" "1876","xls" "1876","messagebox" "1874","circleci" "1874","testcafe" "1873","fill" "1872","adsense" "1872","heap" "1870","bluebird" "1869","production-environment" "1869","snapshot" "1869","countif" "1869","schedule" "1868","windows-phone-7.1" "1867","aws-fargate" "1866","alpine-linux" "1865","jsonpath" "1865","database-replication" "1864","angular-router" "1864","dynamic-arrays" "1864","com-interop" "1863","autoscaling" "1862","scp" "1861","collation" "1860","floating-action-button" "1860","lint" "1859","ecmascript-5" "1857","ansible-2.x" "1857","tomcat6" "1856","ffi" "1854","build-automation" "1853","adodb" "1853","game-center" "1851","eof" "1848","yum" "1847","face-recognition" "1847","bubble-sort" "1847","parse-server" "1846","dc.js" "1846","sfinae" "1845","rtf" "1845","provisioning-profile" "1844","host" "1844","exif" "1843","coded-ui-tests" "1843","facebook-android-sdk" "1842","sha1" "1842","doubly-linked-list" "1842","react-admin" "1841","file-transfer" "1840","observer-pattern" "1840","lucene.net" "1839","laravel-5.6" "1839","cout" "1838","pypi" "1838","pojo" "1837","jlist" "1837","operator-precedence" "1837","progressdialog" "1836","jmeter-plugins" "1835","xsl-fo" "1835","react-query" "1835","instruments" "1835","volume" "1835","informatica" "1835","lex" "1835","cabal" "1833","laravel-5.8" "1832","bukkit" "1832","amazon-kinesis" "1831","htmlunit" "1829","aix" "1829","micronaut" "1829","postgresql-9.1" "1829","android-viewmodel" "1828","bootloader" "1827","uisegmentedcontrol" "1826","gpio" "1826","entitymanager" "1826","html2canvas" "1826","java-time" "1824","src" "1823","gaussian" "1823","permalinks" "1822","slide" "1821","nvd3.js" "1820","static-linking" "1820","using" "1819","drupal-views" "1819","openldap" "1819","angular2-directives" "1819","webdriver-io" "1818","favicon" "1818","mongoengine" "1817","aws-appsync" "1816","memory-address" "1815","facelets" "1814","apache-commons" "1813","mathjax" "1813","getline" "1813","licensing" "1812","snakemake" "1811","profile" "1809","bayesian" "1808","lme4" "1808","windows-7-x64" "1808","cpu-registers" "1808","http-status-code-301" "1808","imagebutton" "1808","alpha" "1807","phonegap" "1807","loader" "1807","colorbox" "1807","gnupg" "1806","syncfusion" "1805","jquery-ui-draggable" "1804","kivymd" "1803","implicit" "1803","valueerror" "1803","theory" "1802","i2c" "1801","windows-server-2008-r2" "1799","facet" "1799","boolean-logic" "1797","invoke" "1796","githooks" "1796","bert-language-model" "1795","uiviewanimation" "1794","laravel-artisan" "1794","extjs4.1" "1794","protobuf-net" "1793","java-web-start" "1792","ecto" "1791","rhel" "1791","uibezierpath" "1791","titanium-mobile" "1790","facebook-ios-sdk" "1790","exists" "1788","spring-data-neo4j" "1787","android-scrollview" "1785","palindrome" "1785","facebook-c#-sdk" "1783","mulesoft" "1782","kentico" "1781","tampermonkey" "1779","path-finding" "1779","java-io" "1778","gettext" "1778","yui" "1777","bitcoin" "1777","django-celery" "1777","azure-cognitive-search" "1777","knn" "1777","arcore" "1776","categorical-data" "1776","android-bitmap" "1775","fwrite" "1775","wikipedia" "1775","sax" "1775","qt-designer" "1775","training-data" "1774","jsdoc" "1774","azure-pipelines-yaml" "1773","super" "1772","rx-android" "1772","simulator" "1772","setter" "1770","goroutine" "1769","bitnami" "1769","keylistener" "1769","libreoffice" "1768","member" "1767","cobol" "1766","virtual-reality" "1766","pylint" "1766","xcode9" "1765","execution" "1764","aptana" "1763","cefsharp" "1763","angular-universal" "1763","setup.py" "1763","mount" "1763","autoit" "1762","composition" "1761","bottomnavigationview" "1760","circular-dependency" "1760","akka-stream" "1760","provider" "1759","decoding" "1759","ubuntu-20.04" "1758","ternary-operator" "1757","infragistics" "1756","netbeans-8" "1756","okta" "1755","visual-studio-extensions" "1754","websphere-liberty" "1754","spring-boot-actuator" "1754","loss-function" "1753","specifications" "1752","password-protection" "1751","popupwindow" "1751","excel-2013" "1751","state-machine" "1749","semantics" "1749","key-bindings" "1748","pyside2" "1744","docker-registry" "1743","profiler" "1743","mule-studio" "1742","yield" "1742","foreign-key-relationship" "1740","realloc" "1739","windows-server-2012" "1737","production" "1737","signals-slots" "1737","cx-freeze" "1736","optaplanner" "1735","ng-bootstrap" "1735","sql-server-express" "1731","kotlin-multiplatform" "1730","filenotfoundexception" "1729","react-typescript" "1728","gatling" "1728","git-push" "1727","face-detection" "1727","mozilla" "1726","structuremap" "1724","pid" "1722","sugarcrm" "1720","git-rebase" "1719","preview" "1719","naming" "1719","qgis" "1717","flash-cs5" "1717","android-architecture-components" "1717","rcp" "1716","large-files" "1715","frame-rate" "1715","spree" "1714","python-tesseract" "1714","cas" "1714","extends" "1713","xml-rpc" "1713","date-formatting" "1713","uipopovercontroller" "1713","tfs-2015" "1711","smalltalk" "1711","django-allauth" "1711","http-status-codes" "1709","classcastexception" "1709","aiohttp" "1707","solver" "1707","google-play-games" "1707","google-search" "1703","jface" "1702","prettier" "1701","assign" "1700","bigdecimal" "1700","user-experience" "1699","archlinux" "1696","sample" "1696","postgresql-9.3" "1695","unions" "1695","blocking" "1694","translate" "1693","web-parts" "1693","watch" "1693","countdowntimer" "1692","ribbon" "1692","uialertcontroller" "1691","jsfiddle" "1691","outer-join" "1691","asp.net-core-2.1" "1690","olap" "1690","cut" "1689","owl-carousel" "1689","docker-machine" "1689","jqplot" "1688","rules" "1686","fade" "1686","winjs" "1684","rtmp" "1683","directory-structure" "1682","cloudinary" "1682","pear" "1681","onesignal" "1678","mingw-w64" "1677","robolectric" "1677","android-camera2" "1676","text-classification" "1676","bigcommerce" "1675","sharding" "1673","simple-html-dom" "1672","graphics2d" "1671","final" "1671","jquery-isotope" "1671","swagger-2.0" "1670","disassembly" "1670","hlsl" "1670","iron-router" "1669","django-class-based-views" "1668","jsch" "1667","hibernate-criteria" "1667","large-language-model" "1666","contact-form" "1666","cryptojs" "1665","cheerio" "1665","ini" "1664","template-specialization" "1664","axis-labels" "1664","swiftmailer" "1664","parcelable" "1663","xsd-validation" "1663","c#-2.0" "1663","tablet" "1662","temp-tables" "1662","paintcomponent" "1661","vue-composition-api" "1661","feature-extraction" "1661","ranking" "1661","netflix-eureka" "1659","synchronous" "1658","rank" "1657","ts-jest" "1657","datastax-enterprise" "1655","baseadapter" "1655","pic" "1654","conflict" "1653","google-cloud-dataproc" "1652","backtracking" "1652","private-key" "1652","database-trigger" "1652","spring-amqp" "1652","uidatepicker" "1652","autoload" "1651","template-engine" "1651","nsview" "1650","django-channels" "1649","vcl" "1649","py2exe" "1649","bootstrap-vue" "1649","nsurl" "1648","right-to-left" "1647","public" "1646","date-range" "1646","xor" "1646","wcf-binding" "1646","xcode4.5" "1646","ethernet" "1645","back-button" "1645","android-progressbar" "1645","amazon-aurora" "1644","telerik-grid" "1644","mysql-error-1064" "1644","android-studio-3.0" "1644","excel-interop" "1643","delphi-2010" "1643","nested-attributes" "1642","marker" "1642","readonly" "1640","scala-collections" "1639","workflow-foundation-4" "1639","shiny-server" "1639","plsqldeveloper" "1639","multicast" "1636","functor" "1636",".net-standard" "1636","signalr-hub" "1635","samsung-mobile" "1635","haxe" "1634","vue-cli" "1634","orders" "1634","tastypie" "1633","http-get" "1631","cx-oracle" "1630","dynamic-linking" "1629","children" "1629","angular-ngmodel" "1629","fread" "1628","algolia" "1627","setup-project" "1627","code-formatting" "1627","rack" "1626","flux" "1625","delayed-job" "1625","cpu-word" "1625","sampling" "1624","android-sensors" "1621","geoserver" "1620","gradle-plugin" "1620","supervisord" "1620","android-gridview" "1619","watir-webdriver" "1618","flutter-getx" "1617","shared-hosting" "1616","adal" "1616","aws-step-functions" "1616","spring-restcontroller" "1616","google-analytics-4" "1615","datediff" "1614","fixtures" "1614","acrobat" "1613","claims-based-identity" "1613","boot" "1612","java-9" "1612","scalatest" "1611","history" "1610","glassfish-3" "1609","binary-data" "1609","dump" "1609","predict" "1608","calculation" "1608","kill" "1608","wordpress-rest-api" "1608","higher-order-functions" "1607","unityscript" "1606","truncate" "1606","flask-restful" "1606","ivy" "1605","flatten" "1605","t4" "1605","uislider" "1603","codable" "1602","tabbar" "1602","linear-gradients" "1602","solrj" "1601","octobercms" "1601","google-api-client" "1601","screen-orientation" "1601","nonblocking" "1600","webrequest" "1600","unordered-map" "1599","memcpy" "1599","yup" "1598","jolt" "1598","tic-tac-toe" "1597","python-telegram-bot" "1596","vuforia" "1595","tensorflow.js" "1595","intentfilter" "1595","picker" "1595","activemq-artemis" "1595","linux-mint" "1594","devtools" "1593","uniqueidentifier" "1593","service-accounts" "1592","winui-3" "1591","definition" "1591","producer-consumer" "1591","google-api-python-client" "1590","nsmanagedobject" "1590","viewstate" "1590","laravel-passport" "1589","hpc" "1589","shadow-dom" "1587","literals" "1586","google-docs-api" "1585","qtp" "1584","treemap" "1583","enterprise-library" "1582","nsnotificationcenter" "1581","class-diagram" "1581","cassandra-3.0" "1581","meteor-blaze" "1581","naudio" "1581","pyomo" "1579","live" "1579","database-backups" "1578","access-violation" "1577","bamboo" "1577","rollback" "1577","windows-vista" "1577","centos6" "1576","fortran90" "1576","taxonomy" "1575","partition" "1574","permission-denied" "1573","firefox-addon-webextensions" "1571","homestead" "1569","configure" "1568","aws-codepipeline" "1568","genymotion" "1567","browser-history" "1567","openxml-sdk" "1567","google-glass" "1567","spotfire" "1567","glib" "1566","iad" "1565","packet" "1565","r-leaflet" "1565","autofill" "1565","cycle" "1564","nutch" "1563","mongodb-atlas" "1563","google-admin-sdk" "1561","figure" "1561","extjs4.2" "1559","symbolic-math" "1559","differential-equations" "1558","mailgun" "1558","timepicker" "1557","multiplayer" "1557","windows-server-2012-r2" "1557","minitest" "1557","schema.org" "1557","autoencoder" "1555","netbeans-7" "1555","uistoryboardsegue" "1554","playback" "1553","twitter4j" "1549","quickblox" "1548","appkit" "1548","shopware" "1548","webfonts" "1547","crash-reports" "1546","sentry" "1546","virtual-functions" "1546","return-type" "1545","logstash-grok" "1544","inotifypropertychanged" "1544","android-coordinatorlayout" "1543","extend" "1542","mapstruct" "1541","wcf-ria-services" "1541","foursquare" "1540","autotools" "1539","horizontal-scrolling" "1539","fragment-shader" "1539","android-image" "1539","custom-fields" "1538","python-venv" "1538","api-platform.com" "1538","poco" "1538","qthread" "1537","pusher" "1536","friend" "1536","laravel-query-builder" "1535","impersonation" "1534","eager-loading" "1534","stock" "1533","self" "1533","criteria-api" "1532","braintree" "1532","streamwriter" "1532","excel-2016" "1532","flutter-provider" "1531","jira-rest-api" "1531","restart" "1531","preferences" "1530","live-streaming" "1530","buffer-overflow" "1529","progress" "1529","arrow-functions" "1528","keras-layer" "1528","pouchdb" "1528","macos-sierra" "1527","privileges" "1527","spring-data-elasticsearch" "1527","libxml2" "1526","pool" "1526","angular-httpclient" "1525","file-rename" "1525","angularjs-service" "1524","cat" "1524","sql-server-2017" "1524","memoization" "1523","mpdf" "1523","has-many-through" "1522","crosstab" "1522","branching-and-merging" "1521","borrow-checker" "1521","pypdf" "1520","hyper-v" "1520","visio" "1520","google-cloud-build" "1520","median" "1519","python-packaging" "1519","alarm" "1519","fastlane" "1519","http-proxy" "1519","cvs" "1519","tradingview-api" "1517","ms-access-2016" "1516","txt" "1516","apt" "1515","instance-variables" "1515","processbuilder" "1514","jquery-autocomplete" "1513","apex-code" "1513","i18next" "1513","postfix-mta" "1511","silverlight-3.0" "1511","mosquitto" "1510","dbt" "1510","rxjs5" "1510","openfire" "1509","quaternions" "1508","django-migrations" "1508","quartz.net" "1508","linked-server" "1507","grails-plugin" "1507","read-eval-print-loop" "1507","sonarqube-scan" "1506","wtforms" "1504","one-to-one" "1502","hololens" "1501","python-turtle" "1501","functional-testing" "1501",".net-7.0" "1501","extern" "1501","macos-catalina" "1501","ieee-754" "1500","named-entity-recognition" "1500","delphi-xe" "1500","stdmap" "1499","install4j" "1499","subtraction" "1498","image-manipulation" "1498","android-sdcard" "1498","suitescript" "1498","web-development-server" "1497","deep-copy" "1496","back" "1495","unmanaged" "1495","uicollectionviewlayout" "1495","nightwatch.js" "1495","dagger" "1495","bearer-token" "1494","gsm" "1494","outputstream" "1494","project-management" "1492","feature-selection" "1492","smoothing" "1492","akka-http" "1492","high-availability" "1491","datacontext" "1491","mex" "1491","direct3d" "1488","pagespeed" "1488","codec" "1487","rollup" "1487","bottle" "1486","filebeat" "1486","newrelic" "1486","radix" "1484","fluid" "1483","relation" "1483","django-cms" "1483","superclass" "1482","flags" "1482","salt-project" "1482","cumulative-sum" "1481","graphql-js" "1481","umbraco7" "1481","spring-boot-test" "1480","fadeout" "1480","typescript2.0" "1480","qwidget" "1479","spring-websocket" "1479","hibernate-search" "1479","odoo-9" "1478","fluentvalidation" "1478","android-4.4-kitkat" "1477","bitbake" "1477","factory-pattern" "1477","assertion" "1476","smack" "1476","jsp-tags" "1476","gradient-descent" "1476","codeception" "1475","php-carbon" "1475","overwrite" "1475","sql-execution-plan" "1475","quasar-framework" "1475","partial" "1474","python-docx" "1474","aws-codebuild" "1474","mobile-website" "1473","docker-volume" "1473","fabric" "1473","monitor" "1473","iqueryable" "1472","portforwarding" "1472","xamarin-studio" "1471","electron-builder" "1470","dagger-hilt" "1469","remote-desktop" "1468","anova" "1468","geckodriver" "1468","stomp" "1468","embedding" "1465","apache-zeppelin" "1465","wai-aria" "1464","duration" "1464","jailbreak" "1463","polling" "1463","google-maps-api-2" "1462","file-descriptor" "1462","language-design" "1462","text-extraction" "1461","python-idle" "1461","osx-mountain-lion" "1461","directed-acyclic-graphs" "1460","imacros" "1459","capture" "1457","ioexception" "1457","android-dialog" "1456","varchar" "1456","nsfilemanager" "1455","voice-recognition" "1455","openedge" "1455","hmac" "1454","vega-lite" "1454","uistackview" "1454","web-frontend" "1453","verification" "1453","portability" "1453","globalization" "1452","database-normalization" "1452","epoch" "1452","io-redirection" "1452","sqldatatypes" "1452","gaps-and-islands" "1451","jbpm" "1451","uac" "1451","autocompletetextview" "1450","react-component" "1450","coldfusion-9" "1450","has-many" "1449","xmlserializer" "1449","chess" "1449","monorepo" "1449","sd-card" "1448","recommendation-engine" "1448","at-command" "1448","modelica" "1448","autocad" "1447","riverpod" "1447","landscape" "1447","animated-gif" "1447","restful-authentication" "1445","extbase" "1445","substr" "1444","x++" "1444","spell-checking" "1444","completable-future" "1444","status" "1443","robots.txt" "1442","dbus" "1442","keydown" "1442","cache-control" "1442","egit" "1441","google-sheets-query" "1440","rtp" "1440","dtd" "1439","vertica" "1437","boost-spirit" "1437","webpack-2" "1436","prestashop-1.7" "1436","idisposable" "1435","rethinkdb" "1434","nginx-location" "1434","7zip" "1432","bitbucket-pipelines" "1432","ontouchlistener" "1432","gnome" "1431","spi" "1430","stderr" "1428","react-leaflet" "1427","jdeveloper" "1427","wiki" "1427","xilinx" "1427","cortex-m" "1427","lua-table" "1426","angle" "1426","xcodebuild" "1426","complex-numbers" "1424","labview" "1424","android-tv" "1422","vaadin7" "1421","skspritenode" "1421","workflow-foundation" "1420","imagemagick-convert" "1420","pcap" "1420","bson" "1420","ref" "1419","timing" "1417","filesize" "1417","strtok" "1416","shared" "1415","porting" "1415","uicolor" "1414","git-clone" "1414","portable-class-library" "1414","silverlight-5.0" "1414","java.util.concurrent" "1414","mixed-models" "1414","tizen" "1413","dynamics-crm-2013" "1412","visualforce" "1412","webpack-4" "1412","submenu" "1411","hikaricp" "1410","ssrs-tablix" "1410","appdomain" "1410","pyaudio" "1409","kettle" "1409","huawei-mobile-services" "1406","echarts" "1406","jnlp" "1406","point-cloud-library" "1405","camera-calibration" "1404","zabbix" "1403","32-bit" "1402","raspberry-pi4" "1402","screen-resolution" "1401","google-cast" "1401","spring-tool-suite" "1400","cancan" "1399","swashbuckle" "1399","systemjs" "1399","aspnetboilerplate" "1399","embedded-jetty" "1398","delta-lake" "1398","audio-player" "1396","point-clouds" "1395","openssh" "1391","selenium-rc" "1391","unpivot" "1391","appium-android" "1391","java-6" "1391","access-control" "1390","void-pointers" "1390","cpython" "1390","auto-update" "1389","uppercase" "1389","react-table" "1389","osx-snow-leopard" "1388","nfs" "1388","mainframe" "1387","dbi" "1387","laravel-5.7" "1387","cascade" "1387","text-parsing" "1384","react-native-firebase" "1384","rectangles" "1383","unique-constraint" "1383","blackberry-10" "1383","tkinter-entry" "1383","context-free-grammar" "1382","cruisecontrol.net" "1382","riscv" "1382","timedelta" "1380","xtext" "1380","tabular" "1380","webdav" "1379","nsmanagedobjectcontext" "1379","meta" "1378","pymysql" "1378","maven-surefire-plugin" "1376","tablelayout" "1376","policy" "1375","factorial" "1375","nodemon" "1375","image-gallery" "1374","bookmarklet" "1374","has-and-belongs-to-many" "1374","trading" "1373","csproj" "1373","spring-rabbit" "1373","paypal-rest-sdk" "1373","google-maps-sdk-ios" "1372","ssis-2012" "1371","cherrypy" "1371","biopython" "1371","fingerprint" "1371","android-8.0-oreo" "1371","azure-language-understanding" "1371","cucumber-jvm" "1371","q" "1371","altair" "1370","floating-accuracy" "1370","elasticsearch-5" "1370","textinput" "1369","django-filter" "1369","netezza" "1369","openmpi" "1369","between" "1367","destructuring" "1367","asp.net-4.0" "1367","tail-recursion" "1367","handle" "1367","laravel-mix" "1367","area" "1367","glm-math" "1366","tibble" "1365","xlrd" "1365","jquery-ui-tabs" "1364","html-entities" "1364","hapi.js" "1364","ipa" "1363","flex4.5" "1363","identifier" "1362","seekbar" "1361","material-components-android" "1361","python-poetry" "1361","apache-superset" "1360","silex" "1360","seam" "1359","freepascal" "1359","hangfire" "1359","perl-module" "1359","beagleboneblack" "1358","intrinsics" "1358","evaluation" "1358","linq-to-objects" "1357","apache-karaf" "1357","m" "1357","nonetype" "1356","assignment-operator" "1356","android-location" "1356","zoo" "1354","job-scheduling" "1354","mnist" "1353","markup" "1353","absolute" "1353","prefix" "1352","nswindow" "1351","enterprise-architect" "1351","android-workmanager" "1351","tabulator" "1351","solana" "1350","excel-addins" "1350","strip" "1349","intellij-plugin" "1349","master-detail" "1349","durandal" "1349","restful-url" "1348","yahoo-finance" "1348","image-recognition" "1348","swift-playground" "1347","client-certificates" "1347","robotics" "1347","projects-and-solutions" "1346","pipenv" "1346","gradle-kotlin-dsl" "1345","group-concat" "1344","facebook-apps" "1343","worksheet-function" "1342","api-gateway" "1342","execute" "1342","google-fusion-tables" "1341","atl" "1341","dst" "1340","firebase-dynamic-links" "1340","appstore-approval" "1340","azure-virtual-network" "1340","numerical-integration" "1340","collectionview" "1340","folium" "1339","delete-operator" "1339","android-architecture-navigation" "1339","curve" "1338","dbpedia" "1338","boost-python" "1338","h5py" "1338","lazarus" "1338","hugo" "1336","yesod" "1336","agent" "1336","cube" "1335","fluentd" "1335","ibm-cloud-infrastructure" "1335","shopify-app" "1335","commonjs" "1334","sha" "1334","userscripts" "1333","xul" "1333","avx" "1333","r-package" "1333","ormlite" "1330","matlab-guide" "1328","php-curl" "1328","pythonanywhere" "1328","odp.net" "1327","sklearn-pandas" "1327","cassandra-2.0" "1326","progress-4gl" "1326","telethon" "1326","sas-macro" "1326","ls" "1325","checkstyle" "1325","properties-file" "1324","tsconfig" "1324","keytool" "1324","rfid" "1324","wordpress-gutenberg" "1324","iterable" "1324","cgal" "1323","chmod" "1323","gsp" "1322","dynamodb-queries" "1322","sumifs" "1321","local-variables" "1321","data-wrangling" "1321","xargs" "1320","ireport" "1320","webmethod" "1320","powermockito" "1318","apache-fop" "1318","python-2.6" "1318","microphone" "1317","identityserver3" "1316","skype" "1316","asihttprequest" "1316","arduino-ide" "1315","smtplib" "1315","m2eclipse" "1315","bezier" "1314","spring-annotations" "1314","tinymce-4" "1312","pdf.js" "1312","codeigniter-4" "1312","restructuredtext" "1312","powerbuilder" "1312","tf-idf" "1311","amd" "1311","scons" "1310","filemaker" "1310","polymorphic-associations" "1309","insert-update" "1309","spring-rest" "1308","coredump" "1308","strtotime" "1308","auto" "1307","xcode11" "1307","react-functional-component" "1306","reportlab" "1306","dispatcher" "1306","data-migration" "1306","watchos" "1306","jquery-chosen" "1306","postgresql-9.4" "1306","storekit" "1305","django-haystack" "1305","spring-cloud-dataflow" "1305","nsmutabledictionary" "1305","mule4" "1304","distributed-system" "1304","jquery-file-upload" "1304","shopware6" "1303","llvm-ir" "1303","survival-analysis" "1303","office365api" "1303","summary" "1302","swiftui-list" "1302","google-search-console" "1301","api-key" "1301","fiware" "1301","dql" "1300","slidetoggle" "1300","apache-tika" "1300","disk" "1300","sap-ase" "1300","account" "1299","spring-webflow" "1299","httpserver" "1299","ole" "1298","microsoft-graph-sdks" "1298","open-telemetry" "1298","angular-dart" "1296","multi-touch" "1296","spring-cloud-gateway" "1296","launch" "1295","modalviewcontroller" "1295","tiles" "1294","google-cloud-composer" "1293","hid" "1292","azure-cosmosdb-sqlapi" "1292","algorithmic-trading" "1291","slickgrid" "1291","leiningen" "1291","google-api-dotnet-client" "1291","colorbar" "1290","case-sensitive" "1290","grails-2.0" "1289","data-access-layer" "1288","or-tools" "1287","app-engine-ndb" "1287","nameerror" "1287","worker" "1287","strongloop" "1287","emscripten" "1286","php-5.3" "1286","wcf-security" "1286","facebook-messenger" "1286","montecarlo" "1285","session-timeout" "1285","angularjs-routing" "1285","ktor" "1285","jackson-databind" "1285","activiti" "1284","swift-package-manager" "1284","informatica-powercenter" "1284","memory-alignment" "1284","generic-programming" "1283","haskell-stack" "1282","salesforce-lightning" "1282","normal-distribution" "1281","undefined-reference" "1281","uitoolbar" "1281","ngrx-store" "1281","windows-server" "1281","cytoscape.js" "1280","smtpclient" "1280","self-join" "1280","type-traits" "1278","typeahead.js" "1278","event-log" "1276","wif" "1276","designer" "1276","visual-studio-cordova" "1275","qtableview" "1274","unicorn" "1273","repaint" "1273","aws-iot" "1273","upsert" "1273","shiro" "1273","nopcommerce" "1273","es6-class" "1272","slug" "1272","rubymine" "1272","mkannotation" "1271","memorystream" "1270","java-17" "1270","cairo" "1269","django-staticfiles" "1269","unsigned" "1269","uisearchcontroller" "1269","toad" "1268","spring-roo" "1268","android-sdk-tools" "1267","createjs" "1267","bottom-sheet" "1267","rails-activestorage" "1267","loopback" "1266","react-state" "1266","android-menu" "1266","angular2-nativescript" "1264","backpropagation" "1264","uiactivityviewcontroller" "1264","authorize.net" "1263","nsxmlparser" "1263","subview" "1263","powershell-remoting" "1263","subroutine" "1262","spring-ws" "1261","loadrunner" "1261","survey" "1261","mouselistener" "1261","restlet" "1260","expressionengine" "1260","comparable" "1259","smartgwt" "1259","keyevent" "1259","gradlew" "1259","express-session" "1259","pysimplegui" "1259","gxt" "1258","tensorflow-serving" "1258","shutdown" "1258","bundling-and-minification" "1258","lattice" "1257","vsix" "1257","quill" "1257","logstash-configuration" "1255","avcapturesession" "1255","aws-serverless" "1255","reddit" "1255","string-literals" "1254","attr" "1253","chef-recipe" "1253","visual-foxpro" "1253","solrcloud" "1252","afnetworking-2" "1252","r-raster" "1252","objective-c++" "1252","hashicorp-vault" "1252","modbus" "1252","argv" "1251","vim-plugin" "1250","xmldocument" "1249","event-sourcing" "1248","airflow-scheduler" "1248","httphandler" "1248","email-validation" "1247","matplotlib-basemap" "1247","android-4.0-ice-cream-sandwich" "1246","core-image" "1246","codemirror" "1245","w3c" "1245","unobtrusive-validation" "1245","git-pull" "1244","ear" "1244",".net-4.8" "1242","dynamics-365" "1242","angularjs-controller" "1242","latency" "1242","struts-1" "1242","multicore" "1241","sign" "1241","dimensions" "1241","pgadmin-4" "1240","jquery-masonry" "1239","django-testing" "1239","android-broadcast" "1239","expression-blend" "1239","togglebutton" "1238","chromium-embedded" "1238","angular-ng-if" "1238","libsvm" "1238","lotusscript" "1237","puma" "1237","sapply" "1237","koa" "1237","dpi" "1237","mesos" "1236","publishing" "1236","android-collapsingtoolbarlayout" "1236","arima" "1235","clean-architecture" "1235","appcelerator-titanium" "1235","worksheet" "1234","phone-number" "1234","hibernate-validator" "1234","angularjs-filter" "1233","filesystemwatcher" "1233","row-number" "1233","android-tabs" "1233","raspberry-pi2" "1233","rider" "1233","ntlm" "1232","inertiajs" "1232","c++-concepts" "1232","iis-10" "1231","initializer-list" "1231","double-quotes" "1230","instrumentation" "1229","sendkeys" "1229","swi-prolog" "1229","url-parameters" "1228","cloudant" "1228","one-hot-encoding" "1228","layout-inflater" "1227","rxjs6" "1227","type-hinting" "1227","network-protocols" "1227","headless" "1226","addclass" "1226","hortonworks-data-platform" "1226","rdp" "1225","sharing" "1225","raycasting" "1224","gridbaglayout" "1224","friendly-url" "1224","rollupjs" "1224","camunda" "1224","orbeon" "1224","rhino-mocks" "1224","gateway" "1224","peewee" "1224","idioms" "1223","optional-parameters" "1223","waterline" "1223","can-bus" "1222","node-webkit" "1221","uitapgesturerecognizer" "1221","docker-container" "1221","java-ee-7" "1221","qtablewidget" "1220","nagios" "1220","android-tablelayout" "1220","webmatrix" "1220","solid-principles" "1219","jtree" "1219","dynamics-ax-2012" "1218","pyarrow" "1218","setcookie" "1218","android-navigation" "1218","utf-16" "1218","webdeploy" "1217","fullpage.js" "1217","outliers" "1217","lines" "1216","confluence" "1216","windows-server-2003" "1216","osmdroid" "1216","aspect-ratio" "1215","mapbox-gl" "1215","asp.net-core-identity" "1215","spline" "1215","achartengine" "1213","rpy2" "1213","variant" "1213","postgresql-9.5" "1213","virtual-memory" "1213","protege" "1213","quarto" "1212","netflix-zuul" "1212","mkdir" "1212","healthkit" "1212","quartz-graphics" "1211","phone-call" "1211","rust-tokio" "1210","adobe-indesign" "1210","dynamics-crm-online" "1210","protected" "1210","state-management" "1210","sudoku" "1209","azure-ad-b2c-custom-policy" "1209","ramda.js" "1209","ace-editor" "1209","stdstring" "1208","paho" "1208","password-encryption" "1208","cpan" "1207","mutable" "1207","metaclass" "1206","immutable.js" "1205","key-value-observing" "1205","dereference" "1205","derived-class" "1205","custom-taxonomy" "1204","itemscontrol" "1201","xna-4.0" "1201","watermark" "1200","websphere-8" "1200","osx-elcapitan" "1200","a-star" "1200","android-mediacodec" "1198","gherkin" "1198","credit-card" "1198","terraform-provider-gcp" "1198","scrolltop" "1197","r-plotly" "1197","explorer" "1197","static-members" "1195","openapi-generator" "1195","hierarchical-clustering" "1195","tomcat9" "1195","transfer" "1195","subsonic" "1194","crossfilter" "1194","information-retrieval" "1193","built-in" "1192","workspace" "1192","lda" "1192","quantmod" "1191","ksoap2" "1191","stringstream" "1190","flickr" "1190","csh" "1190","ionic-native" "1190","controltemplate" "1190","pass-by-value" "1189","fancybox-2" "1189","ttk" "1189","shutil" "1189","shinyapps" "1188","timeline" "1188","transformer-model" "1188","mschart" "1187","retina-display" "1187","objectmapper" "1186","steam" "1185","jscript" "1185","keyerror" "1185","ag-grid-angular" "1185","cognos" "1185","scrollviewer" "1184","user-permissions" "1183","reshape2" "1182","fluent" "1182","system.text.json" "1182","rbenv" "1181","erd" "1180","google-chrome-headless" "1180","android-alarms" "1179","populate" "1179","custom-attributes" "1179","having" "1178","plc" "1178","restful-architecture" "1178","zk" "1177","masking" "1177","jfilechooser" "1176","anypoint-studio" "1176","kaggle" "1176","timespan" "1176","android-gallery" "1176","geo" "1175","hotkeys" "1175","syslog" "1174","public-key" "1173","func" "1173","facebook-sdk-4.0" "1173","spring-cloud-config" "1172","page-refresh" "1171","lan" "1171","nearest-neighbor" "1171","mahout" "1171","google-closure-compiler" "1171","sqlcmd" "1171","android-listfragment" "1169","shapely" "1169","azure-log-analytics" "1169","confidence-interval" "1168","react-dom" "1168","automator" "1168","zapier" "1167","privacy" "1167","hostname" "1167","fold" "1166","wizard" "1166","xcode-ui-testing" "1166","httpcontext" "1164","osdev" "1163","consul" "1163","emr" "1163","powerbi-embedded" "1162","dbeaver" "1162","dart-pub" "1161","joomla1.5" "1161","navigator" "1161","bcp" "1160","tridion" "1160","confluent-schema-registry" "1160","breadcrumbs" "1160","asp.net-core-6.0" "1160","cultureinfo" "1159","case-insensitive" "1159","propel" "1159","cucumber-java" "1158","opencart2.x" "1157","ansible-inventory" "1157","rbac" "1156","onsen-ui" "1156","nvm" "1155","datadog" "1155","sanitization" "1154","audit" "1154","c3p0" "1154","dart-null-safety" "1153","google-api-java-client" "1153","conventions" "1153","qgraphicsview" "1152","weak-references" "1152","rspec2" "1152","same-origin-policy" "1152","opensearch" "1151","gevent" "1151","objectify" "1151","google-query-language" "1150","swift-protocols" "1150","callstack" "1150","oracleforms" "1150","crc" "1149","file-extension" "1149","dataflow" "1149","infowindow" "1149","browser-automation" "1149","dicom" "1149","nib" "1149","googlemock" "1148","vector-graphics" "1147","debezium" "1147","jdo" "1147","remoting" "1147","owasp" "1147","jquery-deferred" "1147",".net-framework-version" "1146","extjs5" "1146","framebuffer" "1144","fileinputstream" "1144","jta" "1144","sharepoint-designer" "1144","system.reflection" "1144","url-scheme" "1143","stackexchange.redis" "1143","freertos" "1143","pybind11" "1143","uinavigationitem" "1142","system.drawing" "1141","symfony5" "1141","autoconf" "1140","distutils" "1140","aws-application-load-balancer" "1140","measure" "1139","python-3.3" "1139","filewriter" "1139","sqldatareader" "1139","ios14" "1139","mediastore" "1138","cjk" "1138","nat" "1137","fifo" "1137","azure-web-roles" "1137","android-maps-v2" "1136","flume" "1136","http-status-code-401" "1136","isabelle" "1135","with-statement" "1134","datamapper" "1134","tortoisehg" "1133","dask-distributed" "1133","postgresql-9.2" "1133","lighttpd" "1132","flush" "1132","python-3.9" "1132","abstraction" "1132","alter-table" "1131","radgrid" "1130","voice" "1130","micropython" "1130","object-detection-api" "1130","elk" "1129","python-c-api" "1129","gurobi" "1129","spawn" "1128","alfresco-share" "1128","google-app-maker" "1128","textmate" "1127","webservice-client" "1127","fileoutputstream" "1127","libc" "1127","rate-limiting" "1127","2d-games" "1127","railstutorial.org" "1126","ebay-api" "1126","ckeditor5" "1126","source-maps" "1125","flexslider" "1124","xlwings" "1124","bootstrap-datepicker" "1124","appsettings" "1124","c3.js" "1124","gdscript" "1124","event-loop" "1124","spacing" "1123","class-design" "1123","recordset" "1123","bpmn" "1123","asp.net-3.5" "1122","add-on" "1122","react-three-fiber" "1122","dynamically-generated" "1122","buildozer" "1122","scipy-optimize" "1122","string-interpolation" "1121","bookmarks" "1121","parse-cloud-code" "1120","intentservice" "1120","cloud9-ide" "1120","mailto" "1120","kvm" "1120","rich-text-editor" "1120","reactiveui" "1120","illegalstateexception" "1120","threadpoolexecutor" "1119","mxml" "1119","regexp-replace" "1118","git-diff" "1118","cdata" "1118","hp-uft" "1118","word-embedding" "1118","sql-server-2019" "1118","behat" "1117","diacritics" "1116","checkboxlist" "1116","xmlreader" "1115","getusermedia" "1115","window.open" "1115","nsfetchrequest" "1115","android-cursor" "1115","elasticsearch-aggregation" "1115","stub" "1114","refresh-token" "1114","dotnetopenauth" "1114","custom-data-attribute" "1113","flask-socketio" "1113","simple-injector" "1113","handsontable" "1113","tortoisegit" "1112","trie" "1112","playframework-2.2" "1112","rvalue-reference" "1112","digits" "1112","lift" "1111","backbone-views" "1111","cakephp-2.3" "1111","jmeter-5.0" "1111","bmp" "1111","qunit" "1111","perf" "1111","throttling" "1110","rolling-computation" "1109","integer-overflow" "1109","ebean" "1108","maze" "1107","gridfs" "1107","git-checkout" "1107","database-partitioning" "1107","bounding-box" "1107","migrate" "1106","date-arithmetic" "1106","pubnub" "1106","nancy" "1106","sys" "1106","comet" "1106","tor" "1104","confusion-matrix" "1104","uploadify" "1104","aws-code-deploy" "1104","device-driver" "1103","clob" "1103","dlib" "1103","infinispan" "1103","knapsack-problem" "1103","stdio" "1102","sitecore6" "1102","expand" "1101","maven-assembly-plugin" "1101","irc" "1101","long-polling" "1101","mediarecorder" "1100","sqlconnection" "1100","ejb-3.1" "1100","alsa" "1099","automake" "1099","alpine.js" "1098","listviewitem" "1098","macports" "1096","git-flow" "1096","jasperserver" "1096","javax.imageio" "1096","mousewheel" "1096","testcontainers" "1096","msdeploy" "1095","llvm-clang" "1095","calling-convention" "1095","infinite" "1095","dot" "1094","posixct" "1094","pdfkit" "1094","custom-component" "1093","symfony-2.1" "1093","nsurlrequest" "1092","jogl" "1092","bluej" "1092","openjpa" "1091","ag-grid-react" "1091","msdn" "1090","flask-login" "1090","html.dropdownlistfor" "1090","qlikview" "1089","angularjs-ng-click" "1089","box-api" "1089","exit-code" "1088","discrete-mathematics" "1088","wikipedia-api" "1087","mobile-development" "1087","vaadin-flow" "1086","ghci" "1086","lexer" "1086","provisioning" "1086","zend-db" "1085","typing" "1085","android-logcat" "1084","edge-detection" "1083","react-native-maps" "1083","cil" "1083","doctype" "1083","tm" "1082","deferred" "1082","textblock" "1082","geom-bar" "1082","autodesk" "1081","docker-network" "1080","listadapter" "1080","huffman-code" "1079","decompiling" "1079","rtk-query" "1079","java-2d" "1079","forward-declaration" "1079","resourcedictionary" "1077","raytracing" "1077","npm-scripts" "1077","ipv4" "1077","shell-exec" "1076","salt-cryptography" "1076","portable-executable" "1076","openfiledialog" "1076","ionic5" "1076","libvlc" "1076","google-contacts-api" "1075","truffle" "1075","enterprise" "1074","docker-image" "1074","currying" "1073","apexcharts" "1073","swiftui-navigationlink" "1073","ibatis" "1073","postscript" "1073","u-boot" "1073","msys2" "1072","insertion-sort" "1072","joomla-extensions" "1072","surface" "1072","wsh" "1072","visual-studio-lightswitch" "1072","timezone-offset" "1071","rounded-corners" "1071","servicenow" "1070","ngrok" "1070","ng-grid" "1070","sitecore8" "1070","revit-api" "1070","moving-average" "1069","pjsip" "1069","goto" "1069","crystal-reports-2008" "1069","postcss" "1069","non-ascii-characters" "1068","backwards-compatibility" "1068","unit-of-work" "1068","spring-data-redis" "1068","java-threads" "1068","behavior" "1067","servicebus" "1067","resque" "1067","performancecounter" "1066","xlib" "1066","winscp" "1066","minimum" "1066","azure-servicebus-queues" "1065","python-unicode" "1065","scaffolding" "1065","microsoft-graph-teams" "1065","iso" "1065","asp.net-identity-2" "1064","saas" "1064","azure-cloud-services" "1064","boolean-expression" "1064","polyline" "1064","uipangesturerecognizer" "1064","gnu-assembler" "1064","pretty-print" "1063","cpu-cache" "1063","android-framelayout" "1063","shift" "1062","oracle19c" "1062","openai-gym" "1062","business-objects" "1062","azure-pipelines-build-task" "1062","zero" "1061","runtimeexception" "1061","apt-get" "1061","allure" "1060","temporary-files" "1060","tslint" "1060","locationmanager" "1060","updating" "1060","roc" "1060","access-denied" "1059","signing" "1059","httpwebresponse" "1059","string-length" "1058","coldfusion-10" "1058","glew" "1057","internal-server-error" "1057","armadillo" "1057","transactionscope" "1057","avaudiosession" "1056","inappbrowser" "1056","facebook-page" "1056","android-viewholder" "1055","ssh-tunnel" "1055","effects" "1055","att" "1055","mac-address" "1055","access-modifiers" "1054","asp.net-web-api-routing" "1054","custom-action" "1054","heroku-postgres" "1053","sweetalert" "1053","mdm" "1053","suitescript2.0" "1052","many-to-one" "1052","firebase-tools" "1052","radio-group" "1052","gac" "1051","yahoo" "1051","xcode4.3" "1050","scalaz" "1049","selenium-firefoxdriver" "1049","cisco" "1049","mongodb-java" "1049","drawrect" "1048","laravel-10" "1048","pixi.js" "1048","visual-studio-mac" "1048","hl7-fhir" "1048","android-file" "1047","chrome-extension-manifest-v3" "1047","voiceover" "1047","nsoperationqueue" "1047","buttonclick" "1047","httr" "1047","gmp" "1046","recurrence" "1046","ios-autolayout" "1045","greedy" "1045","modx" "1045","tail" "1045","eigen3" "1044","tcpdump" "1044","preload" "1044","parentheses" "1043","monaco-editor" "1043","spring-webclient" "1042","cell-array" "1042","agora.io" "1042","watin" "1042","brackets" "1042","bookdown" "1042","c++-chrono" "1042","uikeyboard" "1042","imageicon" "1041","git-lfs" "1041","nant" "1041","android-contentresolver" "1041","ms-project" "1040","unsafe" "1040","docker-desktop" "1040","deno" "1040","global-asax" "1039","lapack" "1039","shapeless" "1039","logarithm" "1038","php-extension" "1038","samba" "1037","stack-memory" "1036","class-library" "1036","youtube-dl" "1036","wildfly-8" "1036","rails-migrations" "1036","lowercase" "1036","menubar" "1035","proc" "1035","jtextpane" "1035","nstextfield" "1035","spam" "1034","naivebayes" "1034","linqpad" "1033","detect" "1033","nose" "1033","promql" "1033","parallel.foreach" "1032","localdb" "1032","adobe-illustrator" "1032","geodjango" "1032","binance" "1031","xunit.net" "1031","agile" "1031","intuit-partner-platform" "1030","vega" "1030","introspection" "1029","android-proguard" "1028","dalvik" "1027","aws-sam" "1026","multiple-instances" "1026","semantic-markup" "1026","mongoose-populate" "1026","searchbar" "1026","dart-polymer" "1025","least-squares" "1024","ggmap" "1024","opencsv" "1023","jdialog" "1023","gravity-forms-plugin" "1023","wpftoolkit" "1023","bucket" "1022","pointer-to-member" "1022","curses" "1022","gnu-screen" "1022","zebra-printers" "1021","multitasking" "1021","keyword-argument" "1021","paypal-adaptive-payments" "1021","esri" "1020","fish" "1020","konvajs" "1020","huggingface" "1020","custom-element" "1019","package-managers" "1019","myisam" "1019","django-south" "1019","taskbar" "1019","resx" "1019","ipywidgets" "1018","sqlsrv" "1018","swifty-json" "1018","xml-deserialization" "1018","sql-loader" "1017","selecteditem" "1017","testcase" "1016","xstream" "1016","sqlclr" "1016","isset" "1016","pem" "1015","extjs3" "1015","spaces" "1014","anonymous-types" "1014","cloudera-cdh" "1014","sql-view" "1014","datastax-java-driver" "1013","flutter-bloc" "1013","inject" "1013","ofstream" "1012","bandwidth" "1012","xml-validation" "1012","kotlin-flow" "1012","vhosts" "1011","cosine-similarity" "1011","chaining" "1010","pyqtgraph" "1010","google-cloud-ml" "1010","amazon-neptune" "1009","javacard" "1008","truetype" "1008","knockout-2.0" "1008","pyparsing" "1007","onmouseover" "1007","polynomials" "1007","deque" "1007","aar" "1007","async.js" "1006","vala" "1006","cakephp-2.1" "1006","javascript-framework" "1006","frames" "1006","tinkerpop" "1006","scene" "1006","pywinauto" "1006","spark-cassandra-connector" "1005","backslash" "1005","jboss-arquillian" "1005","findbugs" "1005","windows-server-2016" "1005","easeljs" "1005","infopath" "1004","jquery-ui-accordion" "1004","eloquent-relationship" "1004","arduino-esp8266" "1003","spfx" "1003","subscribe" "1002","jslint" "1002","easymock" "1002","pascalscript" "1001","joi" "1001","android-download-manager" "1000","telerik-mvc" "1000","interaction" "1000","azure-bot-service" "1000","shiny-reactivity" "999","managed-bean" "998","bluez" "998","uiactionsheet" "998","oncreate" "997","swagger-codegen" "997","android-calendar" "997","url-encoding" "996","playframework-2.1" "996","macos-big-sur" "996","asyncstorage" "996","signed" "996","node-gyp" "994","vagrantfile" "994","opc-ua" "993","framer-motion" "993","onactivityresult" "992","python-dataclasses" "992","pdflatex" "992","winsock2" "992","typo3-9.x" "991","spring-el" "991","dynamic-data" "990","smooth-scrolling" "990","robotium" "990","hta" "990","destroy" "990","miniconda" "989","n-tier-architecture" "988","datastore" "988","javacv" "988","mode" "988","uitabbaritem" "988","google-geocoder" "988","composite-primary-key" "987","db2-400" "987","pseudo-class" "987","body-parser" "987","minio" "987","topic-modeling" "986","function-definition" "986","rule-engine" "986","cryptocurrency" "986","android-appwidget" "986","reusability" "986","brute-force" "986","uiactivityindicatorview" "986","gdata" "986","resampling" "986","concurrent.futures" "985","playframework-2.3" "985","tty" "984","docker-for-windows" "984","enumerate" "984","axes" "984","rhino" "984","android-keystore" "984","amazon-ecr" "983","native-base" "983","opentk" "983","google-custom-search" "982","appendchild" "982","ruby-on-rails-7" "982",".net-core-3.1" "982","mkannotationview" "982","membership-provider" "982","custom-adapter" "981","file-format" "981","nsoperation" "981","texture-mapping" "980","vscode-remote" "980","sage" "980","onitemclicklistener" "979","primitive" "979","antialiasing" "979","grayscale" "979","jshint" "979","fine-uploader" "979","pyside6" "979","cocoa-bindings" "979","string-parsing" "978","levenshtein-distance" "978","foundation" "978","tapestry" "978","android-camera-intent" "978","gawk" "978","illegalargumentexception" "977","preventdefault" "977","rselenium" "977","gspread" "977","audiokit" "977","regex-greedy" "977","nodemcu" "977","eventemitter" "977","cgcontext" "977","membership" "977","composite" "976","pulp" "976","ntfs" "976","python-wheel" "975","arcgis-js-api" "974","jboss6.x" "974","csom" "974","woocommerce-rest-api" "974","xcode10" "974","monkeypatching" "972","datalist" "972","dispatch" "972","turbolinks" "972","android-10.0" "972","mousemove" "971","json-ld" "971","simplecursoradapter" "971","gpuimage" "971","pull" "971","wso2-enterprise-integrator" "971","uiinterfaceorientation" "971","webapp2" "970","apache-spark-dataset" "970","azure-automation" "970","posts" "970","osgi-bundle" "970","sqldatasource" "970","rest-client" "969","bootstrap-table" "969","outlook-restapi" "969","sqlbulkcopy" "969","rails-routing" "969","nonlinear-optimization" "968","google-fit" "968","google-earth" "968","compile-time" "967","tsc" "967","stackdriver" "967","extjs6" "967","elasticsearch-plugin" "967","angular-http" "966","instanceof" "966","cartopy" "966","separator" "966","apache-tomee" "966","scala-cats" "966","quasar" "966","user-roles" "965","templating" "965","fuzzy-search" "965","thrust" "964","realitykit" "964","random-seed" "964","system-administration" "964","rails-admin" "964","uiswitch" "964","strong-parameters" "964","beanshell" "963","ngx-bootstrap" "963","gtkmm" "963","video-encoding" "963","text-alignment" "962","mysql-5.7" "962","delphi-2009" "962","elmah" "961","serial-communication" "961","cakephp-3.x" "961","wiremock" "961","color-scheme" "960","vapor" "960","macvim" "960","spray" "959","git-log" "959","imputation" "959","x509certificate2" "959","titan" "958","mat" "958","ngrx-effects" "957","adaptive-cards" "957","openwrt" "957","strcmp" "957","git-remote" "956","processor" "956","bootstrapping" "956","overlapping" "956","speech" "955","cashapelayer" "955","apc" "955","jgit" "955","ws-security" "955","visible" "954","masonry" "954","mysql-8.0" "954","noise" "954","propertygrid" "954","google-cloud-vertex-ai" "953","taglib" "953","oh-my-zsh" "953","strcpy" "952","terminate" "952","sendmessage" "952","winston" "952","coordinate-systems" "952","hue" "951","mandrill" "951","dockerhub" "951","android-youtube-api" "951","outlook-2010" "950","magento-1.8" "950","pyopengl" "950","asp.net-mvc-partialview" "950","screen-readers" "950","euclidean-distance" "950","hdl" "949","bulk" "949","tile" "948","hidden-field" "947","odoo-11" "946","nativescript-angular" "946","aws-secrets-manager" "945","pageload" "945","grpc-java" "945","epub" "945","mdi" "944","coalesce" "944","coreml" "944","pop3" "944","extendscript" "944","bulma" "943","db2-luw" "943","serde" "943","dev-c++" "943","space-complexity" "942","banner" "942","appium-ios" "942","azure-bicep" "942","movieclip" "941","mysql2" "941","browser-sync" "941","asp.net-core-2.2" "941","drive" "941","look-and-feel" "941","getchar" "940","cron-task" "940","node-sass" "939","background-service" "939","apache-spark-ml" "939","django-settings" "939","xcode-storyboard" "939","azure-managed-identity" "939","odoo-12" "938","file-writing" "938","azure-hdinsight" "937","apache2.4" "937","laravel-backpack" "937","servlet-3.0" "937","avl-tree" "937","box" "937","summernote" "936","graphite" "936","horizontalscrollview" "936","scatter" "935","saxparser" "935","form-for" "935","wordnet" "935","minimax" "935","jaas" "935","sqflite" "935","force-layout" "934","sequential" "934","abi" "934","azure-stream-analytics" "933","snowflake-schema" "933","robocopy" "932","wildfly-10" "932","javasound" "931","gimp" "931","pharo" "931","tcplistener" "930","ng-options" "930","docx4j" "929","cname" "929","bios" "928","fasta" "928","rancher" "927","blas" "927","facet-wrap" "927","ksqldb" "927","google-assistant-sdk" "927","pyqt6" "926","windows-task-scheduler" "926","iso8601" "926","amazon-elasticache" "925","python-logging" "925","pyglet" "925","bytebuffer" "924","data-transfer" "924","addressbook" "924","typeahead" "924","observers" "924","sqlcommand" "924","google-cloud-vision" "923","sql-function" "923","openvpn" "923","generative-adversarial-network" "923","restangular" "923","array-broadcasting" "922","symfony-3.4" "922","micro-optimization" "922","macos-mojave" "922","openoffice.org" "922","android-networking" "922","powershell-5.0" "922","mcrypt" "921","regular-language" "921","class-method" "921","wikidata" "921","go-gin" "921","vertex-shader" "920","release-management" "920","swingworker" "920","rbind" "920","fortify" "920","tibco" "919","smb" "919","fiware-orion" "919","kendo-ui-angular2" "919","timertask" "919","tagging" "919","bxslider" "919","onbeforeunload" "919","gltf" "918","include-path" "918","neon" "918","isolatedstorage" "917","editing" "917","libreoffice-calc" "917","titanium-alloy" "917","mule-component" "916","adjacency-matrix" "916","w3c-validation" "916","supertest" "916","knockout-mapping-plugin" "916","csvhelper" "915","antlr3" "915","session-storage" "915","developer-tools" "915","postsharp" "915","weblogic-10.x" "914","try-except" "914","reportingservices-2005" "914","alembic" "914","boot2docker" "914","dvcs" "914","asp.net-2.0" "914","sonar-runner" "913","jboss5.x" "913","mfmailcomposeviewcontroller" "912","apache-felix" "912","data-processing" "912","facebook-access-token" "911","paypal-subscriptions" "911","c11" "910","renderer" "910","chunks" "910","cgo" "910","lockscreen" "909","onnx" "909","delphi-xe7" "909","subnet" "908","multi-module" "908","phpdoc" "908","gekko" "907","azure-application-gateway" "907","asp.net-core-signalr" "907","glade" "906","feature-detection" "906","data-extraction" "906","vbo" "906","android-uiautomator" "906","abp-framework" "906","pyenv" "906","signalr.client" "906","autosuggest" "906","glassfish-4" "906","batch-rename" "905","reportbuilder3.0" "905","fftw" "905","yii-extensions" "905","netcat" "905","locust" "905","imagej" "904","dygraphs" "904","required" "903","caret" "903","pycrypto" "903","spring-integration-dsl" "903","polyfills" "902","bitmapimage" "902","datacontractserializer" "902","pdfsharp" "902","android-textinputlayout" "901","django-users" "901","iboutlet" "901","nsobject" "901","laravel-nova" "901","qt-quick" "901","liferay-7" "900","lwuit" "900","colormap" "900","elasticsearch-dsl" "900","qgraphicsscene" "899","nrwl-nx" "899","keep-alive" "899","quickbooks-online" "899","nuget-package-restore" "898","controllers" "897","materialized-views" "897","graalvm" "897","serializable" "897","postmessage" "897","modernizr" "896","guard" "896","launcher" "896","throw" "896","powershell-cmdlet" "895","carriage-return" "895","e4" "895","pdb" "895","moss" "894","intel-fortran" "894","ibaction" "894","in-memory-database" "894","devextreme" "894","npx" "893","bing" "893","symbian" "893","payload" "893","janusgraph" "893","exponential" "892","datanucleus" "892","windows-11" "892","django-signals" "892","formatter" "892","android-build" "892","amazon-ami" "891","application-pool" "891","sbcl" "890","ssas-tabular" "890","managed" "890","hibernate-envers" "890","sdwebimage" "890","usability" "889","ormlite-servicestack" "889","args" "889","webpack-5" "888","jedis" "888","vitest" "888","android-jetpack-navigation" "887","cartesian-product" "887","web.py" "886","spring-cloud-netflix" "886","typo3-7.6.x" "886","color-picker" "886","laravel-validation" "886","solr4" "885","php-5.6" "885","xpages-ssjs" "885","enter" "885","dice" "884","standard-deviation" "884","hyperparameters" "884","libusb" "884","android-3.0-honeycomb" "884","angular-http-interceptors" "883","bit-fields" "883","malware" "883","datatrigger" "883","sqlexception" "883","cucumberjs" "883","tex" "882","indices" "882","pg" "881","debug-symbols" "881","dma" "881","algebra" "881","ms-media-foundation" "880","n-gram" "880","xelement" "880","case-when" "880","delphi-xe5" "880","code-reuse" "880","facebook-ads-api" "880","dictionary-comprehension" "880","dotenv" "880","lotus" "880","three20" "879","fluid-layout" "879","runtime.exec" "879","names" "879","data-fitting" "879","reverse-geocoding" "878","effect" "878","ngroute" "878","win32gui" "878","boost-thread" "878","tasm" "878","double-click" "878","asp.net-core-1.0" "877","pinia" "877","sikuli" "877","android-cursoradapter" "877","android-orientation" "877","moxy" "877","meanjs" "877","summarize" "876","gsutil" "876","android-7.0-nougat" "876","android-camerax" "876","mediaelement" "875","phpspreadsheet" "875","dex" "874","feathersjs" "874","ng-class" "874","smlnj" "874","openerp-7" "874","pmd" "874","nstextview" "874","std-function" "873","badge" "873","microdata" "873","entity-attribute-value" "873","cfml" "873","mql4" "872","grid-search" "872","clang-format" "872","pinterest" "872","magicalrecord" "872","branch.io" "872","gamekit" "872","battery" "872","thinking-sphinx" "872","utf" "872","beacon" "872","amazon-cloudwatchlogs" "871","sling" "871","semantic-ui-react" "871","packer" "871","nix" "871","cesiumjs" "870","rpmbuild" "870","twitter-fabric" "870","blueimp" "870","windows-store" "870","scilab" "870","iterm2" "870","maven-release-plugin" "869","contentful" "869","markerclusterer" "869","selected" "869","red5" "869","lottie" "869","accessor" "868","undo" "868","failover" "868","html-framework-7" "868","forum" "868","hadoop-streaming" "868","morphia" "865","xmppframework" "865","universal-image-loader" "864","flicker" "864","jbossfuse" "864","smt" "864","mahapps.metro" "863","imagemap" "863","passport-local" "863","memory-mapped-files" "863","css-sprites" "863","z3py" "862","derivative" "862","applicationcontext" "862","cran" "862","model-associations" "862","dummy-variable" "862","link-to" "861","flash-cs6" "861","keyframe" "861","google-speech-api" "860","rmagick" "860","azure-notificationhub" "860","reactive-cocoa" "859","jenkins-job-dsl" "859","eclipse-jdt" "859","will-paginate" "859","aws-security-group" "859","pentaho-spoon" "859","multilabel-classification" "858","basic" "858","platform" "858","uber-api" "858","points" "858","highlighting" "858","mobx-react" "858","actioncable" "858","panel-data" "857","web-sql" "857","minimize" "857","android-broadcastreceiver" "857","aspose" "857","tablerow" "857","google-fabric" "856","phpseclib" "856","documentation-generation" "856","go-templates" "856","maxima" "855","gantt-chart" "854","pageobjects" "854","gcc-warning" "854","openweathermap" "853","envoyproxy" "853","drawerlayout" "853","podman" "853","ellipse" "853","google-drive-android-api" "853","reachability" "852","findall" "852","windows-10-mobile" "852","database-cursor" "852","kestrel-http-server" "852","uglifyjs" "852","formbuilder" "852","foxpro" "852","android-handler" "852","prototypal-inheritance" "852","pentaho-data-integration" "852","sunspot" "852","urlfetch" "851","trino" "851","doc" "851","sap-fiori" "851","android-2.2-froyo" "850","scala.js" "850","atmega" "850","android-maps" "849","ggplotly" "849","image-rotation" "849","keycode" "849","absolute-path" "849","mlab" "849","asp.net-core-3.0" "849","melt" "849","ios-charts" "849","metamask" "848","wifi-direct" "848","blobstore" "848","control-flow" "847","lexical-analysis" "847","sigabrt" "847","stylus" "846","agda" "846","delphi-2007" "846","pecl" "845","kohana-3" "845","dom-manipulation" "845","alter" "845","qt6" "844","modulenotfounderror" "844","stat" "843","pki" "843","mod-proxy" "843","buildroot" "842","palantir-foundry" "842","jsf-1.2" "842","modulus" "842","azure-worker-roles" "842","stopwatch" "842","pyyaml" "842","use-case" "841","youtube-javascript-api" "841","connection-timeout" "841","proof" "841","angular2-observables" "840","intellij-14" "840","file-type" "840","connector" "840","watchos-2" "840","entities" "840","numberformatexception" "840","ethers.js" "840","subclassing" "839","firedac" "839","flat-file" "839","hosts" "839","keil" "838","google-api-nodejs-client" "838","hashtag" "838","pep8" "837","vue-test-utils" "837","intel-xdk" "837","bioconductor" "837","jsdom" "837","android-external-storage" "837","ios-universal-links" "836","integral" "836","multiple-monitors" "835","default-constructor" "835","triangulation" "835","tree-traversal" "835","apigee" "835","rating" "835","autofilter" "834","rundeck" "834","gulp-watch" "834","vimeo-api" "834","ubuntu-server" "834","pygobject" "834","type-mismatch" "834","drake" "833","enthought" "833","android-4.2-jelly-bean" "833","cgaffinetransform" "832","ef-fluent-api" "832","squarespace" "832","rtti" "832","newsletter" "832","ria" "831","pi" "831","aerospike" "831","kable" "831","stored-functions" "831","array-merge" "830","flexdashboard" "830","intel-mkl" "830","django-crispy-forms" "830","cp" "830","postgresql-9.6" "829","map-function" "829","failed-installation" "829","mailkit" "829","httpmodule" "829","google-developers-console" "828","relationships" "828","pylons" "827","squid" "827","imshow" "827","twitch" "826","multiple-tables" "826","datatables-1.10" "826","cumsum" "826","spam-prevention" "826","qtreeview" "825","gravity" "825","printwriter" "825","ef-core-3.1" "825","ui-testing" "825","jtabbedpane" "825","capistrano3" "825","workbox" "825","android-appbarlayout" "825","sift" "825","titlebar" "824","jira-plugin" "824","interstitial" "824","google-places" "824","tfvc" "823","jersey-client" "823","pexpect" "823","web-api-testing" "823","thread-sleep" "823","amazon-mws" "822","teechart" "822","listitem" "822","webview2" "822","pgp" "822","facebook-oauth" "822","interrupt-handling" "822","code-completion" "822","geb" "822","uisearchdisplaycontroller" "822","culture" "822","olap-cube" "822","http-status-code-400" "822","image-compression" "821","jmockit" "821","angular10" "821","reactjs-flux" "820","rlang" "820","facebook-authentication" "820","drupal-theming" "820","webgrid" "819","primitive-types" "819","dbf" "819","indy10" "819","sweetalert2" "819","setup-deployment" "818","tycho" "818","reducers" "818","lighting" "817","ckan" "817","screen-capture" "817","opentok" "817","requestanimationframe" "816","telephony" "816","xslt-3.0" "816","legacy" "816","fractions" "815","skphysicsbody" "815","aws-event-bridge" "815","suppress-warnings" "815","shopify-api" "815","azure-monitoring" "815","lookup-tables" "815","eventhandler" "815","concurrenthashmap" "814","proc-sql" "814","ckeditor4.x" "814","bittorrent" "814","cells" "814","corruption" "814","sprockets" "813","youtube-iframe-api" "813","checked" "813","led" "813","c++03" "812","smo" "812","p-value" "812","abaddressbook" "812","organization" "812","type-erasure" "812","yql" "812","billing" "812","paragraph" "811","websphere-7" "811","bitbucket-server" "811","rodbc" "810","erp" "810","libstdc++" "810","opensuse" "810","mudblazor" "810","urlsession" "809","epoll" "809","gtk#" "809","azure-media-services" "809","qliksense" "809","octopus-deploy" "808","cllocation" "808","dylib" "808","error-logging" "808","cqlsh" "808","java-bytecode-asm" "808","head" "807","facebook-messenger-bot" "807","gyroscope" "807","google-earth-engine" "806","greenplum" "806","yii2-basic-app" "806","static-variables" "805","self-signed" "805","hough-transform" "805","mingw32" "805","minecraft-forge" "805","mlflow" "805","c++-cx" "805","touchscreen" "805","webpacker" "804","floating" "804","windows-10-iot-core" "804","puzzle" "804","libpcap" "804","ms-access-2003" "803","weather" "803","constraint-programming" "803","firebase-cli" "803","fosrestbundle" "802","markers" "802","fastify" "802","pypy" "802","caesar-cipher" "802","glyphicons" "801","polymer-2.x" "801","sqliteopenhelper" "801","memory-barriers" "801","paperjs" "800","psexec" "800","bloomberg" "800",".net-standard-2.0" "800","sparkr" "799","datacontract" "799","springfox" "799","vis.js" "799","exploit" "799","openmodelica" "799","lighthouse" "798","opengl-3" "798","emu8086" "797","listactivity" "797","python-3.10" "797","fusioncharts" "797","azure-appservice" "797","erlang-otp" "797","sanity" "797","tabview" "797","generic-list" "797","persistent-volumes" "797","url-rewrite-module" "797","qtstylesheets" "795","function-call" "795","recharts" "795","velo" "795","asymptotic-complexity" "795","vivado" "794","window-resize" "794","sankey-diagram" "794","scala-macros" "794","tbb" "794","azureportal" "794","static-files" "794","user-defined-types" "793","union-all" "793","spring-bean" "793","buddypress" "793","macos-high-sierra" "793","android-datepicker" "793","byte-buddy" "793","v-for" "793","certbot" "793","qstring" "792","veins" "792","iso-8859-1" "792","idris" "791","apdu" "791","icefaces" "791","pcm" "791","machine-code" "791","typeof" "791","settext" "791","is-empty" "791","notepad" "791","moviepy" "791","flv" "791","yuv" "791","hebrew" "790","grepl" "790","multisite" "790","rxjs-observables" "790","watson-conversation" "790","facebook-comments" "790","ambari" "790","rds" "790","strptime" "790","foreground-service" "789","master-slave" "789","ownership" "789","android-11" "789","android-audiomanager" "789","geofencing" "788","whm" "788","backbone-events" "788","telephonymanager" "788","sony" "787","application-settings" "787","rails-engines" "787","mediaelement.js" "786","self-hosting" "786","roslyn-code-analysis" "786","simplify" "786","quantitative-finance" "785","edmx" "785","json-schema-validator" "785","icu" "785","uipath" "785","c#-5.0" "785","eventtrigger" "785","http-status-code-500" "784","snap.svg" "784","crtp" "784","stress-testing" "784","sparklyr" "784","particles" "783","jcr" "783","sequel" "783","inkscape" "783","visitor-pattern" "783","dimension" "783","rails-i18n" "783","urllib3" "783","google-iam" "782","file-conversion" "782","replaceall" "782","overload-resolution" "782","nsnumber" "782","ransack" "782","asn.1" "781","marquee" "781","katalon-studio" "781","navigationview" "781","typo3-6.2.x" "781","std-pair" "780","listboxitem" "780","datareader" "780","finder" "780","pkcs#11" "780","azure-durable-functions" "780","equation-solving" "780","merge-conflict-resolution" "780","google-home" "780","zend-framework3" "779","yahoo-api" "779","kong" "779","uibinder" "778","airflow-2.x" "778","html-input" "778","typechecking" "778","aspxgridview" "778","xcode12" "778","composite-component" "778","quantile" "777","jcomponent" "777","reactstrap" "777","spring-hateoas" "777","event-dispatch-thread" "777","parseint" "777","zoho" "777","bin" "776","vertex" "776","argument-passing" "776","multimap" "776","webp" "776","heredoc" "775","confirm" "775","keyup" "775","modelsim" "775","obiee" "775","typo3-8.x" "775","dhcp" "775","resnet" "775","node-redis" "775","sublist" "775","comparison-operators" "774","removing-whitespace" "774","choropleth" "774","unreal-engine5" "774","recovery" "774","irb" "774","mouse-cursor" "774","persistent" "774","stenciljs" "774","pragma" "774","sublime-text-plugin" "773","ebpf" "773","directoryservices" "773","riak" "773","mockmvc" "772","sitefinity" "772","circular-reference" "772","bounds" "772","region" "772","drawer" "771","pythonpath" "771","windows-shell" "771","twilio-twiml" "771","gtsummary" "771","ostream" "771","b-tree" "771","oledbconnection" "771","prometheus-alertmanager" "770","symfony-2.3" "770","variance" "770","dllexport" "770","spring-oauth2" "770","galaxy" "770","android-mvvm" "770","google-geocoding-api" "770","gnu-parallel" "769","qgraphicsitem" "769","ipfs" "769","soql" "769","u-sql" "768","appcelerator-mobile" "768","socks" "768","video-player" "768","task-queue" "768","dialogflow-es-fulfillment" "768","messenger" "767","spring-3" "766","wdk" "766","x-editable" "766","jplayer" "766","docstring" "766","monad-transformers" "766","ray" "765","applepay" "765","spring-session" "765","blend" "765","wix3.5" "765","radiobuttonlist" "765","hardhat" "765","user-accounts" "764","python-pptx" "764","google-apps-marketplace" "764","terra" "764","transactional" "764","multiclass-classification" "763","crypto++" "763","delegation" "763","librosa" "763","coordinate-transformation" "763","rails-api" "763","geocode" "762","flashdevelop" "762","adonis.js" "762","unhandled-exception" "762","oracle-apex-5.1" "762","jvm-hotspot" "762","core-text" "762","exoplayer2.x" "762","eigenvalue" "762","partials" "761","php-ziparchive" "761","callable" "761","tableau-desktop" "761","cocos2d-x-3.0" "761","java-module" "760","icc" "760","info.plist" "760","custom-cell" "760","ellipsis" "760","arcpy" "759","bitset" "759","scrum" "759","headless-browser" "758","audiounit" "758","notify" "758","openshift-origin" "758","resourcebundle" "758","scrollto" "758","belongs-to" "757","wowza" "757","svelte-3" "757","playlist" "757","non-linear-regression" "757","splice" "757","encryption-symmetric" "756","clips" "756","tsx" "756","datarow" "756","google-vision" "756","portal" "756","spring-saml" "756","bufferedwriter" "755","declare" "755","traveling-salesman" "755","angular-resource" "755","wallpaper" "755","svd" "755","msbuild-task" "754","bing-api" "754","jquery-templates" "754","ios-ui-automation" "754","amazon-quicksight" "754","sticky-footer" "753","implode" "753","diskspace" "753","wcf-client" "753","twitter-bootstrap-4" "753","aws-sdk-js" "753","m3u8" "753","astropy" "753","direct2d" "753","flutter-navigation" "753","composite-key" "752","ubuntu-22.04" "752","reflection.emit" "752","xcopy" "752","android-design-library" "751","sap-gui" "751","gulp-sass" "751","spring-cloud-feign" "751","typography" "751","parsley.js" "751","altbeacon" "750","decltype" "750","recording" "750","quickfix" "750","timescaledb" "750","percentile" "750","allocator" "749","margins" "749","meteor-accounts" "749","android-transitions" "749","google-cardboard" "749","office-automation" "749","ip-camera" "748","microsoft-sync-framework" "748","hammer.js" "748","subreport" "748","google-sites" "747","instruction-set" "747","cd" "747","firebase-notifications" "747","bootstrap-datetimepicker" "747","episerver" "747","facebook-marketing-api" "747","hamburger-menu" "747","angular-filters" "747","chakra-ui" "747","splunk-query" "747","emmet" "747","conan" "746","fxcop" "746","python-internals" "746","ruby-on-rails-2" "746","let" "745","file-copying" "745","relayjs" "745","cancellation" "745","isolation-level" "745","dhtml" "745","uipagecontrol" "745","flutter-listview" "745","gnuradio" "745","amazon-kms" "744","ansible-facts" "744","web-testing" "744","annotation-processing" "744","kableextra" "744","erase" "744","css-modules" "744","conditional-compilation" "743","visualsvn-server" "743","qcombobox" "742","celery-task" "742","smartphone" "742","bitmask" "742","playframework-1.x" "742","rsyslog" "742","depth" "742","siblings" "742","condition-variable" "741","gsl" "741","invoice" "741","c#-6.0" "741","traceback" "740","import-from-excel" "740","keystonejs" "740","modem" "740","azure-data-lake-gen2" "740","rasa" "740","jaxb2" "740","bigint" "740","transfer-learning" "739","flip" "739","angular-test" "739","nativescript-vue" "739","android-ksoap2" "739","queryover" "738","sencha-architect" "738","calculated-field" "738","m2e" "738","tinkerpop3" "738","hasura" "738","screen-size" "738","zope" "737","xjc" "737","disqus" "737","kde-plasma" "737","apscheduler" "737","rcurl" "737","active-model-serializers" "737","amazon-lex" "736","ef-database-first" "736","pinchzoom" "736","sitecore7" "736","android-gps" "736","uifont" "736","strftime" "735","pointer-arithmetic" "735","android-checkbox" "735","continue" "735","ctags" "734","clip" "734","ftp-client" "734","avx2" "734","oracle-cloud-infrastructure" "734","operation" "734","dio" "734","google-cloud-stackdriver" "733","citrix" "733","gitlab-api" "733","ngx-translate" "733","assertions" "732","rvalue" "732","image-upload" "732","py2neo" "732","word-cloud" "732","execution-time" "732","compareto" "732","collectors" "732","http-error" "732","qualtrics" "731","react-navigation-v5" "731","renderscript" "731","adobe-analytics" "731","rpa" "731","microchip" "731","formulas" "731","poco-libraries" "731","android-multidex" "731","alphabetical" "731","bids" "730","template-argument-deduction" "730","connectivity" "730","dji-sdk" "730","readability" "730","perspective" "729","os.walk" "729","japplet" "729","npapi" "729","business-process-management" "729","redis-cluster" "729","strategy-pattern" "729","pytz" "729","restriction" "729","restkit-0.20" "729","ios-app-extension" "729","arel" "729","autodesk-model-derivative" "728","yammer" "728","ecdsa" "728","content-script" "728","hystrix" "728","easy-install" "728","internal" "728","nsthread" "728","google-gdk" "728","autoplay" "728","gluon" "727","typescript-eslint" "727","android-gridlayout" "726","background-task" "726","php-7.2" "726","slick2d" "726","fitnesse" "726","magnific-popup" "726","poisson" "726","getopt" "726","sonarlint" "725","dataview" "725","seq" "725","datagrip" "725","modularity" "725","neo4j-apoc" "725","google-cloud-iam" "725","custom-keyboard" "725","low-level" "724","babel-loader" "724","angular-translate" "724","crash-dumps" "724","nsregularexpression" "724","mifare" "724","browserstack" "724","stringify" "724","mongo-shell" "723","skip" "723","packet-sniffers" "723","twilio-php" "723","wmic" "723","nohup" "722","joblib" "722","rpgle" "722","gam" "721","material-table" "721","unix-socket" "721","pushviewcontroller" "721","dependent-type" "721","authlogic" "721","sccm" "721","tcsh" "721","google-cloud-spanner" "721","avaudiorecorder" "720","clip-path" "720","divide-and-conquer" "720","core-motion" "720","visual-sourcesafe" "720","viewdidload" "720","c++-winrt" "720","hamcrest" "720","strpos" "720","compass" "719","antivirus" "719","remix" "719","case-class" "719","nashorn" "719","onsubmit" "719","svg-animate" "719","nvcc" "719","sql-grant" "719","lazy-initialization" "719","trac" "718","yeoman-generator" "718","portfolio" "718","corpus" "718","core-foundation" "718","code-duplication" "718","nokia" "718","draftjs" "718","cgrect" "718","heroku-cli" "718","alphanumeric" "717","xero-api" "717","document-ready" "717","caption" "717","thermal-printer" "716","flink-sql" "716","jssor" "716","flexbuilder" "716","sonata" "715","debouncing" "715","oracle-apex-5" "715","rhel7" "715","gemfile" "715","android-launcher" "715","threshold" "714","onresume" "714","virtuemart" "713","reactor" "713","ef-core-2.0" "713","firefox-developer-tools" "713","android-viewpager2" "713","spring-social" "713","viewbag" "713","gameobject" "713","nmap" "712","ruby-on-rails-plugins" "712","database-restore" "712","kotlin-android-extensions" "712","anaconda3" "712","corba" "712","offline-caching" "711","faker" "711","nsjsonserialization" "711","sql++" "711","angular-cdk" "711","user-profile" "711","sections" "710","reportbuilder" "710","android-vectordrawable" "710","tcpserver" "709","github-for-windows" "709","csrf-protection" "709","istream" "709","activity-lifecycle" "709","ios-provisioning" "709","subclipse" "708","anonymous-class" "708","json-api" "708","findstr" "708","administrator" "708","google-apis-explorer" "708","npm-start" "708","powerpc" "707","mailmerge" "707","ioctl" "707","isnull" "707","logfile" "707","elliptic-curve" "706","insert-into" "706","trigger.io" "706","sylius" "706","mapi" "706","dnx" "706","jvm-arguments" "706","type-safety" "706","direction" "706","activemodel" "706","automata" "706","linkedhashmap" "705","awtrobot" "705","boost-graph" "705","dynamics-crm-2016" "705","nine-patch" "705","strsplit" "705","prawn" "704","clickable" "704","crystal-reports-2010" "704","blazor-client-side" "704","strlen" "703","kill-process" "703","browser-extension" "702","replit" "702","private-members" "702","vcf-vcard" "702","pow" "702","spring-cache" "702","aws-ssm" "702","android-mediarecorder" "702","amazon-lightsail" "702","parceljs" "701","bindingsource" "701","xpath-2.0" "701","ruby-on-rails-4.2" "701","django-registration" "701","react-i18next" "701","shellcode" "701","google-street-view" "701","google-project-tango" "700","date-conversion" "700","pact" "700","vcpkg" "700","scientific-notation" "700","ca" "699","apache-phoenix" "699","azure-container-instances" "699","correlated-subquery" "699","ojdbc" "699","node-mysql" "698","vue-cli-3" "698","graphicsmagick" "698","getstream-io" "698","google-app-engine-python" "698","android-nestedscrollview" "698","lightgbm" "698","preloader" "697","imaplib" "697","rebol" "697","fragmentmanager" "697","right-click" "697","android-c2dm" "696","photos" "696","vnc" "696","dayofweek" "696","binning" "696","initializer" "696","formtastic" "696","pymc3" "696","azure-servicebus-topics" "696","assetic" "696","gmaps4rails" "695","live-wallpaper" "695","chisel" "695","dymola" "695","payment-processing" "695","forward" "695","ubuntu-10.04" "695","geoip" "694","apache-arrow" "694","decodable" "694","lit-element" "694","graphing" "694","micrometer" "694","dlopen" "694","reactivex" "694","beta" "694","thin" "693","any" "693","photoshop-script" "693","boost-spirit-qi" "693","bootstrapper" "693","visual-studio-app-center" "693","directed-graph" "693","android-fileprovider" "693","export-to-pdf" "692","pack" "692","magento-1.4" "692","modelform" "692","nls" "692","angular11" "691","kernel-density" "691","tweets" "691","rake-task" "691","drawimage" "691","nosuchmethoderror" "691","git-stash" "690","anonymous" "690","mxnet" "690","grails-domain-class" "690","angular-pipe" "689","divide" "689","firmware" "689","pika" "689","flask-admin" "689","phpword" "689","twos-complement" "689","word-count" "689","atom-feed" "689","scientific-computing" "689","heuristics" "689","tidymodels" "688","base-class" "688","cloudbees" "688","appfabric" "688","verify" "688","c++98" "688","spartacus-storefront" "687","standard-library" "687","varnish-vcl" "687","angular-template" "687","variadic" "687","words" "687","workbench" "687","internals" "687","sqldf" "687","nim-lang" "687","flutter-futurebuilder" "686","swiperefreshlayout" "686","r-sp" "686","mojolicious" "686","azure-iot-edge" "686","foreground" "686","arithmetic-expressions" "685","selectize.js" "685","safari-extension" "685","configparser" "685","myfaces" "685","simplemodal" "685","pull-to-refresh" "685","nsimage" "685","pynput" "685","ios12" "684","react-proptypes" "684","jquery-ui-slider" "684","ntp" "684","redux-observable" "683","slim-lang" "683","jenkins-cli" "683","json-rpc" "683","outputcache" "683","dpdk" "683","autoresize" "682","fuse" "682","ftplib" "682","facet-grid" "682","rtos" "682","inventory" "682","astrojs" "682","proxypass" "682","angular-animations" "682","email-client" "681","ansi-escape" "681","flurry" "681","rubymotion" "681","asp.net-core-5.0" "681","torchvision" "680","cmusphinx" "680","xcuitest" "679","whitelist" "679","freeswitch" "679","software-distribution" "679","packet-capture" "679","wireless" "679","handshake" "679","lock-free" "679","qprocess" "679","excel-2003" "678","aforge" "678","biometrics" "678","end-to-end" "678","suds" "678","preferenceactivity" "677","vpc" "677","selinux" "677","dynamics-crm-4" "677","popupmenu" "677","system.diagnostics" "677","opennlp" "677","device-tree" "677","pg-dump" "676","removechild" "676","quicktime" "676","requirements.txt" "676","sharpdx" "675","mutation-observers" "675","stacked-chart" "675","semantic-versioning" "675","sms-gateway" "675","akka.net" "675","fmdb" "674","web-push" "674","reloaddata" "674","chocolatey" "674","request-headers" "674","qpainter" "674","sumo" "673","django-database" "673","opc" "673","ml" "673","ivalueconverter" "673","tfs-workitem" "673","solution" "673","gitolite" "673","powerbi-datasource" "672","maple" "672","nslog" "672","oculus" "672","stop-words" "672","tr" "672","font-family" "671","urlconnection" "671","sicp" "671","love2d" "670","f-string" "670","recv" "670","variable-declaration" "670","records" "670","build-error" "670","lvalue" "670","plotly.js" "669","photon" "669","vb6-migration" "669","jax" "669","jackrabbit" "669","thread-synchronization" "669","quartz-2d" "668","skaction" "668","localdate" "668","mapper" "668","window.location" "668","app-inventor" "668","silverlight-toolkit" "667","consumer" "667","micro-frontend" "667","delphi-xe3" "667","raspberry-pi-pico" "667","milliseconds" "667","coinbase-api" "667","vaadin8" "666","clipping" "666","keycloak-services" "666","abort" "666","mailer" "666","scanning" "666","texture2d" "666","laravel-sanctum" "665","clearinterval" "665","angular-library" "665","ajaxform" "665","pathlib" "665","getelementsbyclassname" "665","google-cloud-logging" "665","ninja" "665","pre-commit-hook" "665","auto-generate" "664","decimalformat" "664","uitouch" "664","facebook-social-plugins" "664","iar" "664","jquery-ui-droppable" "664","swift4.2" "664","kalman-filter" "664","wsdl2java" "664","netcdf4" "664","cordova-3" "664","ondraw" "663","square" "663","sockjs" "663","html-to-pdf" "663","visualvm" "663","iis-8.5" "663","google-mlkit" "663","complex-event-processing" "662","vsphere" "662","wifimanager" "662","nft" "662","directx-9" "662","crystal-lang" "662","nsoutlineview" "662","virtualenvwrapper" "662","android-actionbar-compat" "662","zpl" "662","scss-mixins" "662","thingsboard" "661","adjacency-list" "661","indicator" "661","jpa-2.1" "661","curly-braces" "661","multi-factor-authentication" "660","react-navigation-stack" "660","flash-cs4" "660","r-s4" "660","jupyterhub" "660","holoviews" "660","member-functions" "660","custom-error-pages" "660","qsort" "660","hateoas" "659","freetds" "659","vee-validate" "659","net-snmp" "659","qlabel" "659","httpsession" "659","customtkinter" "658","back-stack" "658","serenity-bdd" "658","cql3" "658","nsubstitute" "658","onblur" "658","ldap-query" "658","mediapipe" "657","multiple-conditions" "657","tensorflow-estimator" "657","method-chaining" "657","android-seekbar" "657","html2pdf" "657","richtext" "657","java.util.logging" "657","mq" "656","rscript" "656","roxygen2" "656","azure-eventgrid" "656","rasa-nlu" "656","system-tray" "656","pytorch-lightning" "656","angular12" "656","iife" "656","webautomation" "655","relay" "655","skscene" "655","image-scaling" "655","file-read" "655","unicode-string" "655","ida" "655","react-state-management" "655","android-security" "655","des" "655","freebase" "655","css-variables" "655","arduino-c++" "655","stdatomic" "654","ternary" "654","filezilla" "654","spring-cloud-sleuth" "654","payara" "654","lerna" "654","messagebroker" "654","eigenvector" "654","hybrid" "653","cobertura" "653","git-config" "653","savefiledialog" "653","shinyjs" "653","reveal.js" "653","gmail-imap" "652","defaultdict" "652","appbar" "652","index-error" "652","django-csrf" "652","astronomy" "652","angular-datatables" "651","telegraf" "651","werkzeug" "651","sabre" "651","windowbuilder" "651","nearprotocol" "651","google-cloud-bigtable" "650","apache-drill" "650","apache-servicemix" "650","firebird2.5" "650","svg-filters" "650","android-inflate" "650","stylecop" "649","pdb-files" "649","extjs-mvc" "649","ratchet" "649","uicontainerview" "649","busybox" "649","vertical-scrolling" "648","load-data-infile" "648","uiwindow" "648","oracle-call-interface" "648","spring-ldap" "648","bootstrap-typeahead" "648","code-contracts" "648","drm" "648","amazon-ebs" "648","cvxpy" "647","livecode" "647","chi-squared" "647","dismiss" "647","caml" "647","mips32" "647","android-app-bundle" "647","c89" "647","launchd" "647","light" "647","secret-key" "647","custom-view" "646","integer-division" "646","xerces" "646","ng-animate" "646","mgo" "646","intersect" "646","google-analytics-firebase" "646","resolve" "646","google-search-api" "645","lambda-calculus" "645","distinct-values" "645","urbanairship.com" "645","inference" "645","hard-drive" "645","quanteda" "644","viewflipper" "644","mininet" "644","linkage" "644","webm" "644","stax" "643","administration" "643","named-ranges" "643","android-toast" "643","inotify" "643","zos" "643","msp430" "643","zod" "643","qtwebkit" "642","stage" "642","php-mongodb" "642","powerapps-canvas" "642","libgit2" "642","code-cleanup" "642","system.data.sqlite" "642","ml.net" "641","feign" "641","eclipse-juno" "641","service-discovery" "641","crystal-reports-xi" "641","iconv" "641","analyzer" "641","ext.net" "641","quote" "641","uvicorn" "640","bad-request" "640","material-design-lite" "640","avr-gcc" "640","callkit" "640","review" "640","nusoap" "640","percona" "640","mediawiki-api" "639","temperature" "639","babel-jest" "639","check-constraints" "639","firebase-mlkit" "639","grafana-loki" "639","os.system" "639","system-design" "639","iphone-x" "639","elasticsearch-query" "638","discord.net" "638","database-project" "638","unixodbc" "638","openam" "638","google-hangouts" "638","subscript" "637","xlwt" "637","adc" "637","pine-script-v4" "637","sessionid" "637","sap-erp" "637","drivers" "637","items" "637","computation-theory" "636","closedxml" "636","spring-java-config" "636","polynomial-math" "636","forwarding" "636","google-api-js-client" "636","contextmanager" "636","toolchain" "636","stream-builder" "636","mouseclick-event" "635","group" "635","vtable" "635","processing-efficiency" "635","django-tables2" "635","rect" "635","postgresql-10" "635","godot4" "635","osmnx" "635","qpushbutton" "635","tpl-dataflow" "635","seed" "634","segment" "634","pushstate" "634","wso2-data-services-server" "634","html-encode" "634","android-9.0-pie" "634","arduino-esp32" "633","datagram" "633","read-write" "633","abaqus" "633","notation" "633","modalpopupextender" "633","etag" "633","huawei-developers" "633","image-classification" "632","datastage" "632","database-deadlocks" "632","factors" "632","ns2" "632","business-logic" "631","stackpanel" "631","treeset" "631","bitmapfactory" "631","recode" "631","objective-c-runtime" "631",".net-core-3.0" "631","quota" "631","mplab" "631","pre-signed-url" "631","amazon-kinesis-firehose" "631","autofixture" "630","daterangepicker" "630","druid" "630","zshrc" "630","http-status-code-302" "630","irvine32" "629","treenode" "629","php-8" "629","selectonemenu" "629","xmlstarlet" "629","xpages-extlib" "629","inet" "629","tween" "629","pymssql" "629","short" "629","npoi" "629","istanbul" "629","laravel-socialite" "628","ansi-c" "628","fluent-nhibernate-mapping" "628","instagram-graph-api" "628","cryptoapi" "628","delphi-10-seattle" "628","dynamic-cast" "628","detox" "628","didselectrowatindexpath" "628","encoder" "628","concurrentmodification" "628","textwatcher" "627","flextable" "627","println" "627","localnotification" "627","vue-i18n" "627","multiple-databases" "627","eclipse-pdt" "627","fix-protocol" "627","azure-app-service-plans" "627","neo4jclient" "627","magic-methods" "627","google-classroom" "627","spring.net" "627","pyzmq" "627","evernote" "627","stringtokenizer" "627","darkmode" "626","probability-density" "626","weighted" "626","code-organization" "626","msxml" "625","ansible-template" "625","xorg" "625","units-of-measurement" "625","python.net" "625","wine" "625","sqlperformance" "625","eventmachine" "624","repo" "624","install.packages" "624","mv" "624","file-not-found" "624","selection-sort" "624","2sxc" "624","r.java-file" "624","ognl" "624","weblogic11g" "624","linq-to-nhibernate" "623","graphene-python" "623","py2app" "623","http-authentication" "623","restify" "623","action-filter" "623","iphone-5" "623","maximo" "622","socketexception" "622","cdc" "622","swfobject" "622","objectinputstream" "621","graphql-java" "621","classname" "621","react-native-router-flux" "621","unpack" "621","atmel" "621","plupload" "621","element-ui" "621","emotion" "621","behaviorsubject" "621","statistics-bootstrap" "620","universal" "620","realm-mobile-platform" "620","java-home" "620","httparty" "620","odoo-13" "619","decompiler" "619","datetimeoffset" "619","createprocess" "619","spring-data-cassandra" "619","forever" "619","raw-input" "619","ambiguous" "619","libpng" "619","pytables" "619","hardware-acceleration" "619","burn" "618","square-connect" "618","deb" "618","language-features" "618","react-tsx" "618","unsupervised-learning" "618","ttl" "618","jquery-hover" "618","gwt-rpc" "618","completionhandler" "618","traffic" "617","removeclass" "617","rjava" "617","jsonparser" "617","single-table-inheritance" "617","javassist" "617","spring-4" "617","mssql-jdbc" "617","bbcode" "616","alassetslibrary" "616","windows-console" "616","wcf-rest" "616","forge" "616","objectdatasource" "616","libav" "616","referrer" "616","polar-coordinates" "616","pfx" "616","stdthread" "616","praw" "616","web-frameworks" "615","ngtable" "615","density-plot" "615","nscalendar" "615","html5-history" "615","freeglut" "615","azure-webapps" "615","ashx" "614","dbunit" "614","ddms" "614","ballerina" "614","ftpwebrequest" "614","vegan" "614","android-facebook" "614","android-music-player" "613","jcheckbox" "613","inspect" "613","scala-3" "613","omnifaces" "613","glmnet" "613","arraybuffer" "612","jointjs" "612","kinect-sdk" "612","hornetq" "612","spring-camel" "612","modx-revolution" "612","minimum-spanning-tree" "612","shopify-template" "612","amcharts4" "612","asp.net-4.5" "612","explain" "612","qlineedit" "612","email-notifications" "612","argocd" "612","topojson" "611","gorilla" "611","tunnel" "611","odoo-14" "611","parsec" "610","slidedown" "610","entropy" "610","nscoding" "610","raii" "610","moose" "610","encryption-asymmetric" "609","oracle9i" "609","kibana-4" "609","unity-webgl" "609","equinox" "609","swiftdata" "609","aac" "609","alloy" "608","sliding-window" "608","file-exists" "608","swiftui-navigationview" "608","self-reference" "608","pycurl" "608","sequence-diagram" "608","unsigned-integer" "608","wix3" "608","quoting" "608","conways-game-of-life" "608","sdn" "607","gridsearchcv" "607","symfony-2.8" "607","xforms" "607","facebook-unity-sdk" "607","axon" "607","google-cloud-speech" "607","node-postgres" "606","week-number" "606","underline" "606","enumerable" "606","for-in-loop" "606","except" "606","actionlink" "606","angular4-forms" "606","loss" "606","armv7" "606","mule-esb" "606","mayavi" "605","flowplayer" "605","reinterpret-cast" "605","datamodel" "605","reboot" "605","negative-number" "605","android-syncadapter" "605","leaderboard" "605","google-pay" "604","deflate" "604","mat-table" "604","masm32" "604","matlab-cvst" "604","displaytag" "604","landscape-portrait" "604","ui-thread" "604","android-things" "604","detailsview" "604","azure-container-registry" "604","rfc" "604","sqlcipher" "604","preprocessor-directive" "604","subtitle" "603","printers" "603","unc" "603","symfony-sonata" "603","biztalk-2010" "603","azure-deployment" "603","go-modules" "603","linq-expressions" "602","marshmallow" "602","formarray" "601","yfinance" "601","blazeds" "601","distributed-transactions" "601","purescript" "601","intersection-observer" "601","fragmentpageradapter" "601","out" "601","spark-submit" "600","docker-build" "600","password-hash" "600","downcast" "600","paraview" "600","tqdm" "600","solrnet" "600","gluon-mobile" "599","webvr" "599","replicaset" "599","cascading-deletes" "599","simplemembership" "599","azure-artifacts" "599","codedom" "599","networkstream" "599","android-assets" "599","cabasicanimation" "598","widgetkit" "598","yolov5" "598","jetty-9" "598","finite-automata" "598","icmp" "598","autoscroll" "598","arp" "597","laravel-echo" "597","configurationmanager" "597","r-mice" "597","unset" "597","bpel" "597","boxing" "597","one-time-password" "597","magento-1.5" "597","diagonal" "597","soundpool" "596","slidingmenu" "596","data-uri" "596","red-black-tree" "596","facebook-sharer" "596","value-type" "596","dendrogram" "596","pause" "596","homescreen" "596","exponent" "596","charles-proxy" "595","greendao" "595","tridion-2011" "595","wicked-pdf" "595","functional-interface" "595","calabash" "595","lxc" "595","word-addins" "595","stargazer" "594","file-sharing" "594","aidl" "594","magnolia" "594","mpeg-dash" "593","bare-metal" "593","firebase-remote-config" "593","dynamics-ax-2009" "593","bookshelf.js" "593","taskmanager" "593","geom-text" "593","thread-local" "593","toolkit" "592","edges" "592","onenote" "592","crc32" "592","sqlanywhere" "592","dhtmlx" "592","scoping" "592","qlistwidget" "592","amazon-efs" "591","chatgpt-api" "591","database-indexes" "591","django-rest-auth" "591","bootstrap-select" "591","gsoap" "591","midp" "591","codesign" "591","openoffice-calc" "591","qweb" "591","onbackpressed" "591","text-align" "591","terrain" "591","acceptance-testing" "590","flowchart" "590","openal" "590","application-server" "590","scala-2.10" "590","netbeans-platform" "590","mirror" "590","jagged-arrays" "590","xamarin.mac" "590","morris.js" "589","ggpubr" "589","firebase-console" "589","mail-server" "589","rstudio-server" "589","goland" "589","typo3-extensions" "589","maatwebsite-excel" "589","notifydatasetchanged" "589","scrapy-splash" "589","droppable" "589","azure-storage-account" "589","preact" "588","weld" "588","photo-gallery" "588","vscode-tasks" "588","deprecation-warning" "588","3dsmax" "588","response.redirect" "588","android-productflavors" "588","gesture-recognition" "588","strict-aliasing" "588","thunderbird" "588","webpack-module-federation" "587","antiforgerytoken" "587","insertion" "587","laravel-excel" "587","calculus" "587","surf" "587","asyncsocket" "587","expandablelistadapter" "587","substrate" "586","sweave" "586","byte-order-mark" "586","android-database" "586","motion" "586","mousehover" "585","mapbox-android" "585","ngcordova" "585","service-broker" "585","coreos" "585","pos-tagger" "585","core-data-migration" "585","visual-studio-express" "585","wininet" "585","formset" "585","continuous-delivery" "585","zap" "584","gridgain" "584","instructions" "584","apple-silicon" "584","ordereddictionary" "584","dfa" "584","gcov" "584","geotools" "584","web-controls" "583","mutation" "583","skype-for-business" "583","firefox-os" "583","manifest.json" "583","unrecognized-selector" "583","virtual-environment" "583","mailchimp-api-v3.0" "583","hierarchical" "583","azure-qna-maker" "583","nosuchelementexception" "583","angular-bootstrap" "583","qtextedit" "583","tidy" "583","scrollable" "583","use-context" "583","compute-shader" "582","blackberry-simulator" "582","imgur" "582","rpm-spec" "582","sharepoint-workflow" "582","aws-codecommit" "582","intranet" "582","rgdal" "582","mms" "582","coldfusion-8" "582","concrete5" "582","computed-properties" "581","udpclient" "581","activesupport" "581","log4net-configuration" "581","laravel-middleware" "580","relational-algebra" "580","swrevealviewcontroller" "580","address-sanitizer" "580","method-reference" "580","bonjour" "580","getelementsbytagname" "580","android-json" "580","custom-function" "580","flutter-widget" "579","ef-core-2.2" "579","trello" "579","typeconverter" "579","delphi-10.1-berlin" "579","envdte" "579","synology" "579","gatt" "579","exchange-server-2010" "578","angular-module" "578","applicative" "578","jquery-cycle" "578","postfix-notation" "578","terraform0.12+" "577","faceted-search" "577","samsung-smart-tv" "577","video-recording" "577","c#-8.0" "577","mouseenter" "577","street-address" "577","web-inspector" "576","postgresql-performance" "576","retain" "576","stm32f4discovery" "575","uitextfielddelegate" "575","cardview" "575","rgl" "575","asp.net-mvc-areas" "575","ios7.1" "575","persist" "574","pygame-surface" "574","object-oriented-analysis" "574","geofire" "574","react-chartjs" "573","fbml" "573","imageresizer" "573","windows-explorer" "573","windows-server-2019" "573","nested-class" "573","dynamic-linq" "573","invalidation" "573","razorengine" "572","markov-chains" "572","affinetransform" "572","django-generic-views" "572","read-the-docs" "572","blueprism" "572","nskeyedarchiver" "572","invoke-command" "572","wms" "572","azure-function-app" "572","azure-sdk-.net" "572","event-bubbling" "572","cucumber-junit" "572","web3py" "571","jet" "571","livereload" "571","semantic-segmentation" "571","ibeacon-android" "571","kaminari" "571","blending" "571","errno" "571","eventkit" "571","stm32f4" "571","tfs-sdk" "571","gnome-terminal" "570","xslt-grouping" "570","material-components" "570","flowdocument" "570","pdfmake" "570","post-increment" "570","lync" "570","objectoutputstream" "570","linegraph" "570","cyrillic" "569","gganimate" "569","vxworks" "569","read.table" "569","postgresql-12" "569","nsbundle" "569","object-literal" "569","r-highcharter" "569","string.format" "569","android-package-managers" "569","forecast" "569","weather-api" "569","alphablending" "568","graph-visualization" "568","websphere-portal" "568","fullcalendar-5" "568","direct-line-botframework" "568","lcd" "568","cgimage" "568","parse-error" "568","beamer" "567","eclipse-adt" "567","union-types" "567","jsplumb" "567","aptana3" "567","formview" "567","http-referer" "567","response-headers" "567","usb-drive" "567","sts-springsourcetoolsuite" "567","ascx" "567","quartus" "567","spark-java" "566","react-native-reanimated" "566","watchdog" "566","android-windowmanager" "566","nsdatecomponents" "566","normalize" "565","yaxis" "565","adfs2.0" "565","waveform" "565","calloc" "565","mac-catalyst" "565","spring-xd" "565","contiki" "565","shibboleth" "565","idl" "564","closest" "564","marklogic-8" "564","claims" "564","jcarousel" "564","doc2vec" "564","apple-tv" "564","delphi-10.2-tokyo" "564","uefi" "564","outlook-2007" "564","xamarin.uwp" "564","ios15" "564","user32" "564","presentmodalviewcontroller" "564","customvalidator" "563","gridextra" "563","full-text-indexing" "563","cardlayout" "563","key-value-store" "563","opencart-3" "563","htmx" "563","gecko" "563","nixos" "562","oxyplot" "562","days" "562","freeradius" "562","error-code" "562","nsnumberformatter" "562","bnf" "562","revert" "562","asmack" "562","sonatype" "561","xterm" "561","bi-publisher" "561","universal-analytics" "561","sinch" "561","opayo" "561","postgresql-11" "561","android-geofence" "561","android-jobscheduler" "560","matomo" "560","lnk2019" "560","template-literals" "560","phpbb" "560","loadlibrary" "560","python-os" "560","libvirt" "560","coldfusion-11" "560","codepen" "560","accessibilityservice" "560","avaudioengine" "559","decoder" "559","procedural-generation" "559","mapply" "559","python-requests-html" "559","reader" "559","information-schema" "559","referenceerror" "559","google-dfp" "559","chain" "559","proto" "559","bazaar" "559","particle-system" "558","apache-beam-io" "558","python-social-auth" "558","findviewbyid" "558","ngxs" "558","intern" "558","createelement" "558","googlebot" "558","expander" "558","google-pagespeed" "558","msysgit" "557","ddos" "557","delphi-10.3-rio" "557","dosbox" "557","audio-processing" "557","cad" "557","itemtemplate" "557","http-status-code-405" "557","git-tag" "557","sox" "557","dafny" "556","temp" "556","apache-httpcomponents" "556","dynamics-crm-2015" "556","spring-boot-maven-plugin" "556","android-instant-apps" "556","qimage" "556","mediatr" "556","subsonic3" "556","preg-split" "555","next.js14" "555","blackberry-webworks" "555","jqgrid-asp.net" "555","free-jqgrid" "555","convex-hull" "555","perfect-forwarding" "554","rule" "554","avplayerviewcontroller" "554","mixpanel" "554","numpy-slicing" "554","mockk" "553","dbscan" "553","localstack" "553","vtiger" "553","mysql-connector-python" "553","nas" "553","middleman" "553","winrm" "552","functional-dependencies" "552","image-size" "552","dml" "552","aws-sdk-nodejs" "552","uiaccessibility" "552","fortran77" "552","dpkg" "552","openmdao" "552","http-delete" "552","tox" "552","parcel" "551","remix.run" "551","angular-material-table" "551","crypt" "551","nomethoderror" "551","prerender" "551","bigtable" "550","fillna" "550","nsscrollview" "550","domparser" "550","javaagents" "550","moshi" "550","heapsort" "550","git-subtree" "550","maxlength" "549","jbehave" "549","jboss-eap-6" "549","divide-by-zero" "549","fsm" "549","flatmap" "549","aws-java-sdk" "549","namedtuple" "549","hittest" "549","change-password" "549","chainlink" "548","xvfb" "548","floating-point-precision" "548","contactscontract" "548","fullcalendar-4" "548","kie" "548","tap" "548","xbee" "548","contravariance" "548","exceljs" "548","spf" "548","get-childitem" "548","specs2" "548","use-ref" "547","jcrop" "547","yarn-workspaces" "547","git-fork" "547","adhoc" "547","ftps" "547","sharepoint-list" "547","karaf" "547","rgba" "547","git-merge-conflict" "546","ghost-blog" "546","jspm" "546","upstart" "546","delphi-xe4" "546","bugzilla" "546","macos-carbon" "546","mockery" "546","ios-frameworks" "546","angularjs-e2e" "546","resume" "546","google-font-api" "546","http-status-code-503" "546","maven-shade-plugin" "546","spannablestring" "545","addsubview" "545","adobe-brackets" "545","gql" "545","android-video-player" "545","wmi-query" "545","continuations" "545","talkback" "545","google-people-api" "544","voronoi" "544","undertow" "544","recursive-datastructures" "544","gs-conditional-formatting" "544","type-providers" "544","fractals" "544","exist-db" "544","nivo-slider" "544","glsurfaceview" "543","tee" "543","python-click" "543","nexus3" "543","unresolved-external" "543","ruby-on-rails-5.2" "543","qtgui" "542","reactor-netty" "542","graphdb" "542","mutate" "542","discriminated-union" "542","smartsheet-api" "542","rm" "542","infix-notation" "542","podio" "542","angular-google-maps" "542","std-ranges" "542","powercli" "541","github-flavored-markdown" "541","staging" "541","jql" "541","mixed-integer-programming" "541","netstat" "541","uiprogressview" "540","apache-commons-httpclient" "540","file-management" "540","id3" "540","watson" "540","android-12" "540","qwebview" "540","azure-sql-server" "540","user-management" "539","teradata-sql-assistant" "539","discord-jda" "539","configmap" "539","aws-opsworks" "539","readr" "539","ros2" "539","auc" "539","esper" "539","uvm" "539","avaloniaui" "539","multi-level" "538","temporary" "538","playframework-2.4" "538","graalvm-native-image" "538","cross-join" "538","upnp" "538","jmespath" "538","svelte-component" "538","ports" "538","android-sharedpreferences" "538","seek" "537","federated-identity" "537","jsonserializer" "537","sequences" "537","amd-processor" "537","udf" "537","atmosphere" "537","scalar" "537","butterknife" "537","alm" "537","stemming" "537","msal.js" "536","appharbor" "536","jsondecoder" "536","sencha-cmd" "536","keystroke" "536","type-parameter" "536","android-install-apk" "536","azure-policy" "536","httpconnection" "536","android-paging" "535","ps" "535","wakelock" "535","aws-sam-cli" "535","azure-authentication" "535","nssortdescriptor" "535","nsbutton" "535","supervised-learning" "535","outlook-redemption" "535","3g" "535","minimization" "535","razorpay" "535","strcat" "534","sslhandshakeexception" "534","python-behave" "534","approximation" "534","jquery-waypoints" "534","fpm" "534","hidden-markov-models" "534","uiswipegesturerecognizer" "534","pytube" "534","responsive-images" "534","amazon-product-api" "533","dblink" "533","fixed-point" "533","spring-mybatis" "533","nsarraycontroller" "533","saucelabs" "533","java-websocket" "533","non-static" "533","itk" "533","taxonomy-terms" "533","autorotate" "533","array.prototype.map" "533","qtreewidget" "533","steam-web-api" "532","remember-me" "532","freetype" "532","selectlist" "532","aiogram" "532","csr" "532","critical-section" "532","doctrine-odm" "532","sapb1" "532","dropdownbox" "532","gdata-api" "532","android-instrumentation" "532","columnsorting" "532","powershell-core" "532","parameterized" "532","prefetch" "531","fileapi" "531","openembedded" "531","google-chrome-os" "531",".htpasswd" "531","hhvm" "531","hal" "530","gremlin-server" "530","pg-promise" "530","jeditorpane" "530","swipe-gesture" "530","manytomanyfield" "530","angularjs-ng-model" "530","google-closure" "530","anagram" "530",".net-maui" "530","virtual-directory" "530","gutenberg-blocks" "530","geopy" "529","matlab-deployment" "529","ng2-charts" "529","apostrophe-cms" "529","watson-assistant" "529","docusaurus" "529","portaudio" "529","opendaylight" "529","boolean-operations" "529","java-platform-module-system" "529","dozer" "529","sqlclient" "529","static-site" "529","line-endings" "528","data-synchronization" "528","pagespeed-insights" "528","softmax" "528","cakephp-4.x" "528","couchbase-lite" "528","boilerplate" "528","onkeydown" "528","rad" "528","iphone-privateapi" "528","monolog" "528","specialization" "528","http-caching" "528","steganography" "527","clpfd" "527","consistency" "527","ng-show" "527","react-virtualized" "527","css-loader" "527","blogdown" "527","openframeworks" "527","gt" "527","apriori" "527","homography" "527","angular13" "527","presentviewcontroller" "527","querying" "526","relational" "526","unreal-blueprint" "526","canopy" "526","jprofiler" "526","sbt-assembly" "526","uiapplicationdelegate" "526","android-pay" "526","requirements" "526","mouseleave" "526","email-verification" "526","enable-if" "526","avassetwriter" "526","shellexecute" "525","fieldset" "525","in-app-subscription" "525","simple-framework" "525","virtuoso" "525","android-browser" "525","asio" "525","timber" "524","webrick" "524","cifilter" "524","avi" "524","spring-cloud-stream-binder-kafka" "524","save-as" "524","stateless" "524","git-reset" "523","backbone.js-collections" "523","catalyst" "523","chef-solo" "523","unlink" "523","revit" "523","plm" "523","collada" "523","qooxdoo" "523","odoo-15" "523","userdefaults" "523","powershell-ise" "523","emacs24" "523","asana" "522","ime" "522","data-preprocessing" "522","named-query" "522","pycaffe" "522","pattern-recognition" "522","libavcodec" "522","pymc" "522","dsc" "522","express-checkout" "522","nmake" "522","seeding" "522","quartz" "521","php-5.5" "521","size-classes" "521","unique-key" "521","marathon" "521","ngresource" "521","chm" "521","read.csv" "521","icecast" "521","fallback" "521","bsd" "521","koin" "521","knife" "521","qmainwindow" "521","acts-as-taggable-on" "520","fuelphp" "520","snackbar" "520","celerybeat" "520","pdftk" "520","redux-persist" "520","scorm" "520","event-tracking" "520","google-directions-api" "520","collaboration" "519","fckeditor" "519","prime-factoring" "519","file-access" "519","animate.css" "519","kiosk-mode" "519","scene2d" "519","mobilefirst-adapters" "519","google-drive-realtime-api" "519","persistence.xml" "519","scriptmanager" "519","static-cast" "519","heroku-toolbelt" "518","php-7.1" "518","react-scripts" "518","cmis" "518","psychopy" "518","iokit" "518","errorbar" "518","neo4j-ogm" "518","lwc" "518","dspace" "518","nunjucks" "518","google-cloud-sdk" "518","cytoscape" "517","process.start" "517","stack-navigator" "517","flex-spark" "517","datagridviewcolumn" "517","worklight-adapters" "517","device-orientation" "517","memgraphdb" "517","user-data" "517","stereo-3d" "516","product-variations" "516","unauthorized" "516","ad-hoc-distribution" "516","kendo-treeview" "516","keycloak-rest-api" "516","canvasjs" "516","jquery-select2-4" "516","bpf" "516","html5-appcache" "516","spring-data-neo4j-4" "516","artifacts" "515","client-side-validation" "515","after-effects" "515","fuzzywuzzy" "515","smsmanager" "515","python-sockets" "515","suse" "515","browser-detection" "515","tabindex" "515","cookbook" "515","diagnostics" "515","hibernate-annotations" "515","geotiff" "515","stretch" "515","gestures" "515","ogg" "515","huggingface-tokenizers" "514","instances" "514","ts-node" "514","invalidoperationexception" "514","post-build-event" "514","knockout-validation" "514","period" "514","nlme" "514","reactivemongo" "514","meson-build" "514","accountmanager" "514","actix-web" "513","php-7.4" "513","datasnap" "513","disable" "513","windows-firewall" "513","eas" "513","domain-name" "513","open-liberty" "513","electron-packager" "513","geography" "512","whmcs" "512","jsonlite" "512","sequelize-cli" "512","systemctl" "512","microsoft-graph-mail" "512","f2py" "512","tmap" "512","pnpm" "512","hl7" "512","memset" "512","laravel-migrations" "512","ipod" "512","cgpoint" "512","pre-trained-model" "511","clustered-index" "511","jeditable" "511","blackberry-eclipse-plugin" "511","owl-api" "511","unobtrusive-javascript" "511","fastreport" "511","kiosk" "511","bluetooth-gatt" "511","mirth" "511","pfquery" "511","qnx" "511","git-revert" "511","measurement" "511","suitecrm" "510","react-router-redux" "510","pkcs#7" "510","symfony6" "510","dkim" "510","roku" "510","rocksdb" "510","nsindexpath" "510","springdoc" "510","rapidminer" "510","odeint" "510","eslintrc" "510","spectrogram" "510","autostart" "509","python-class" "509","microbenchmark" "509","mongomapper" "509","wordpress-shortcode" "509","viewer" "509","nunit-3.0" "509","android-imagebutton" "509","playwright-python" "509","c#-7.0" "509","autodesk-bim360" "508","fbx" "508","edi" "508","fullcalendar-scheduler" "508","readlines" "508","databricks-sql" "508","virus" "508","pylance" "508","tableadapter" "508","tire" "508","qpixmap" "508","angular2-components" "508","requiredfieldvalidator" "508","gitpython" "507","pjax" "507","date-fns" "507","udev" "507","issue-tracking" "507","textcolor" "507","user-registration" "507","msys" "506","mars-simulator" "506","group-policy" "506","matrix-inverse" "506","where-in" "506","algebraic-data-types" "506","annotate" "506","android-viewbinding" "506","savon" "506","viewgroup" "506","business-rules" "506","timestamp-with-timezone" "506","tableofcontents" "506","qt-signals" "505","whenever" "505","playframework-2.5" "505","working-directory" "505","dropzone" "505","angular14" "504","jks" "504","meteor-autoform" "504","dynamic-allocation" "504","coefficients" "504","regedit" "504","android-ffmpeg" "504","gemfire" "504","screen-rotation" "504","react-datepicker" "504","google-identity" "503","cntk" "503","date-parsing" "503","saga" "503","csrf-token" "503","infrastructure-as-code" "503","delphi-xe6" "503","pde" "503","navigationcontroller" "503","osb" "503","openiddict" "502","ant-design-pro" "502","dateadd" "502","ado.net-entity-data-model" "502","uploading" "502","cakephp-model" "502","wave" "502","angularjs-material" "502","descriptor" "502","os.path" "502","buffering" "502","libgit2sharp" "502","tablecellrenderer" "502","raw-sockets" "502","android-cursorloader" "502","gesturedetector" "502","office365-apps" "502","mpi4py" "502","stdclass" "501","manpage" "501","admin-on-rest" "501","cck" "501","unsatisfiedlinkerror" "501","ajax4jsf" "501","fasterxml" "501","gs-vlookup" "501","mod-security" "501","synonym" "501","shap" "501","dotnet-cli" "501","color-space" "501","flutter-plugin" "501","static-code-analysis" "501","email-templates" "500","multipeer-connectivity" "500","ef-core-2.1" "500","eclipse-emf" "500","phabricator" "500","x-frame-options" "500","apostrophe" "500","sendgrid-api-v3" "500","wsimport" "500","rdfs" "500","toggleclass" "500","polly" "500","peoplesoft" "500","prepend" "499","television" "499","multiplatform" "499","json-server" "499","ruamel.yaml" "499","onfocus" "499","cox-regression" "499","coupon" "499","viewpagerindicator" "499","dokku" "499","strace" "499","zurb-foundation-6" "499","httplistener" "499","asciidoc" "499","searchkick" "499","bidirectional" "498","react-native-web" "498","fltk" "498","dealloc" "498","friendly-id" "498","dataprovider" "498","mgcv" "498","invisible" "498","r-factor" "498","reticulate" "498","sprite-sheet" "498","asp.net-mvc-viewmodel" "498","mcmc" "498","fog" "498","autosize" "497","nextcloud" "497","pulumi" "497","psutil" "497","ndef" "497","writefile" "497","cocoon-gem" "497","levels" "497","sql-server-agent" "497","tablelayoutpanel" "497","stateful" "497","compiler-flags" "496","tshark" "496","ng-file-upload" "496","pkg-config" "496","jss" "496","django-sessions" "496","pci" "496","delaunay" "496","domxpath" "496","android-annotations" "496","formgroups" "496","type-systems" "496","np" "496","actionview" "496","spotipy" "496","angular17" "496","bho" "496","artifact" "496","tikz" "495","skiasharp" "495","kurento" "495","facebook-prophet" "495","aws-dms" "495","t-test" "495","modelstate" "495","libtool" "495","refinerycms" "495","mjpeg" "494","basex" "494","fgetcsv" "494","page-break" "494","rcharts" "494","rdl" "494","android-billing" "494","uirefreshcontrol" "494","google-text-to-speech" "493","xmlwriter" "493","akka-cluster" "493","ruby-1.9.3" "493","android-snackbar" "493","code-signing-certificate" "493","bubble-chart" "493","java-3d" "493","assimp" "493","health-monitoring" "493","having-clause" "492","intel-fpga" "492","function-declaration" "492","wchar-t" "492","joystick" "492","angular-meteor" "492","gstreamer-1.0" "492","pdfminer" "492","delphi-xe8" "492","azure-webjobssdk" "492","reduction" "492","nvarchar" "492","tizen-web-app" "492","strict" "492","google-earth-plugin" "492","custom-font" "492","berkeley-db" "492","theorem-proving" "491","separation-of-concerns" "491","jprogressbar" "491","coverage.py" "491","two-factor-authentication" "491","rate" "491","lucee" "491","normals" "491","drop" "491","history.js" "491","angular2-changedetection" "490","unity3d-2dtools" "490","chrome-web-store" "490","plaintext" "490","blackberry-jde" "490","pager" "490","agent-based-modeling" "490","mongodb-compass" "490","swagger-editor" "490","buildpack" "490","javacc" "490","number-theory" "490","scipy-optimize-minimize" "490","resizable" "490","heap-dump" "489","relational-division" "489","pkcs#12" "489","magrittr" "489","objdump" "489","poltergeist" "489","stringbuffer" "489","stroke" "488","dcg" "488","cascadingdropdown" "488","symfony-3.3" "488","icommand" "488","pwm" "488","eps" "488","8051" "488","form-control" "488","objectid" "488","npm-package" "488","elasticsearch-painless" "488","shebang" "487","candlestick-chart" "487","fault" "487","document.write" "487","desktop-bridge" "487","android-studio-2.2" "487","twincat" "487","pysnmp" "487","point-of-sale" "487","numerical" "487","cstring" "487","estimation" "487","dacpac" "487","msvcrt" "486","grok" "486","ggvis" "486","slick-3.0" "486","mamp-pro" "486","survival" "486","libc++" "486","winui" "486","game-loop" "486","dreamhost" "486","uiapplication" "486","jags" "486","project-structure" "486","flutter-packages" "486","usbserial" "485","ecmascript-2016" "485","grizzly" "485","paas" "485","xmlnode" "485","spring-retry" "485","hot-reload" "485","azure-devops-extensions" "485","brightness" "485","asp.net-authorization" "485","node-mongodb-native" "485","perceptron" "485","hubspot" "485","tidyeval" "485","mechanicalturk" "484","primeng-datatable" "484","truststore" "484","addthis" "484","data-augmentation" "484","microprocessors" "484","ring" "484","android-2.3-gingerbread" "484","rails-postgresql" "484","gearman" "484","higher-order-components" "484","persistent-storage" "483","slideup" "483","jdom" "483","processing.js" "483","jenkins-declarative-pipeline" "483","weighted-average" "483","xssf" "483","jcl" "483","laravel-dusk" "483","android-sdk-manager" "483","ocmock" "483","digital-certificate" "483","loopback4" "483","quantization" "482","vue-props" "482","jmsserializerbundle" "482","onkeyup" "482","android-sdk-2.3" "482","gtk2" "482","jquery-dialog" "482","infinity" "482","doparallel" "482","side-effects" "482","legacy-code" "482","iterable-unpacking" "482","ceph" "482","qtwebengine" "481","babylonjs" "481","laravel-cashier" "481","fasttext" "481","dna-sequence" "481","opcode" "481","wordpress-plugin-creation" "481","mismatch" "481","itemrenderer" "481","eve" "481","euler-angles" "481","etcd" "481","evaluate" "481","flutter-sliver" "481","autobahn" "480","dll-injection" "480","dock" "480","dynamic-library" "480","turing-machines" "480","twebbrowser" "480","pyopenssl" "480","format-specifiers" "480","jaws-screen-reader" "480","memory-efficient" "480","passbook" "480","google-polyline" "480","heap-corruption" "479","flood-fill" "479","nsdocument" "479","mondrian" "479","inverse" "479","boundary" "479","suspend" "479","ripple" "479","express-handlebars" "479","executor" "479","spark-graphx" "479","dart-html" "479","static-assert" "478","reindex" "478","ftdi" "478","sharp" "478","famo.us" "478","denormalization" "478","mojarra" "478","pong" "478","sieve-of-eratosthenes" "478","outline" "478","asp.net-mvc-5.2" "478","rails-activejob" "478","textselection" "478","genexus" "478","qdialog" "478","power-management" "477","eclipse-kepler" "477","data-storage" "477","pam" "477","aws-documentdb" "477","inputbox" "477","rascal" "477","vertices" "477","google-slides" "476","sqlxml" "476","app-engine-flexible" "476","python-mock" "476","unnest" "476","nsnotifications" "476","magento-1.6" "476","express-validator" "476","abstract-data-type" "476","sqlite-net" "476","autodoc" "476","il" "475","filechooser" "475","class-variables" "475","multiprocess" "475","chromebook" "475","meteorite" "475","google-tv" "475","nested-routes" "475","building" "475","orc" "475","revision" "475","mitmproxy" "475","ui-grid" "475","screensaver" "475","gem5" "475","tokbox" "475","memory-model" "475","monkeyrunner" "475","flutter-go-router" "474","yolov8" "474","marklogic-9" "474","page-lifecycle" "474","jsrender" "474","carthage" "474","ruby-on-rails-4.1" "474","ruby-2.0" "474","jquery-tools" "474","aapt" "474","short-circuiting" "474","stun" "474","precompile" "473","opl" "473","ptrace" "473","pci-e" "473","java-ee-8" "473","fork-join" "473","mac-app-store" "473","nettcpbinding" "473","largenumber" "473","last-modified" "473","rerender" "473","start-activity" "472","weekday" "472","eclipse-pde" "472","matcher" "472","multimedia" "472","blackjack" "472","createfile" "472","k3s" "472","samesite" "472","typo3-10.x" "472","presentation" "472","alpha-transparency" "472","zend-studio" "471","file-manager" "471","catia" "471","checkedlistbox" "471","rubocop" "471","hstore" "471","dyld" "471","hsv" "471","f#-interactive" "471","dialogfragment" "471","reference-counting" "471","react-google-maps" "471","zendesk" "470","mathml" "470","matlab-compiler" "470","slash" "470","fixed-width" "470","smpp" "470","manim" "470","imessage" "470","htmlspecialchars" "470","sha512" "470","asp.net-apicontroller" "470","poker" "470","polygons" "470","react-final-form" "470","submission" "470","statements" "470","linker-scripts" "469","intercept" "469","imaging" "469","capybara-webkit" "469","ucanaccess" "469","vgg-net" "469","ipod-touch" "469","amazon-data-pipeline" "469","mrtk" "468","eclipse-luna" "468","git-filter-branch" "468","ssrs-2016" "468","jsessionid" "468","imagepicker" "468","confirmation" "468","kdtree" "468","internet-connection" "468","onelogin" "468","macos-monterey" "468","caanimation" "468","azure-static-web-app" "468","strophe" "468","google-cloud-datalab" "468","pytorch-dataloader" "468","use-reducer" "467","anychart" "467","grails-controller" "467","angularjs-ng-include" "467","input-field" "467","code-splitting" "467","jackson2" "467","gauge" "467","mobilefirst-server" "467","game-maker" "467","cfc" "467","spatstat" "467","autofocus" "466","webpack-style-loader" "466","localtime" "466","data-retrieval" "466","postman-collection-runner" "466","openresty" "466","laravel-queue" "466","queryselector" "466","su" "465","laravel-filament" "465","pandas-datareader" "465","jsr223" "465","openerp-8" "464","skmaps" "464","map-projections" "464","cherry-pick" "464","django-middleware" "464","rss-reader" "464","facebook-wall" "464","onpause" "464","blowfish" "464","codepages" "464","dotnetzip" "463","ddd-repositories" "463","clisp" "463","apache-spark-2.0" "463","hour" "463","frama-c" "463","redundancy" "463","geckofx" "463","dimensional-modeling" "463","nodatime" "463","react-chartjs-2" "463","haskell-lens" "463","google-slides-api" "462","fedex" "462","xquery-sql" "462","plantuml" "462","wallet" "462","mezzanine" "462","depth-buffer" "462","intervention" "462","writer" "462","spring-scheduled" "462","motionevent" "462","react-highcharts" "462","layoutparams" "462","precompiled-headers" "462","foreman" "461","cbind" "461","managed-c++" "461","html-webpack-plugin" "461","portrait" "461","pocketsphinx" "461","excel-charts" "460","feature-engineering" "460","integer-arithmetic" "460","ngx-datatable" "460","nextflow" "460","uniq" "460","urldecode" "460","django-import-export" "460","pure-virtual" "460","intl" "460","bootbox" "460","erc20" "460","rdflib" "460","cockroachdb" "460","asynccallback" "460","download-manager" "460","hoisting" "460","sqldependency" "460","android-intentservice" "460","nswag" "460","commandbutton" "460","testcomplete" "460","actionresult" "460","linear-interpolation" "460","iif" "460","folding" "459","graphic" "459","filehelpers" "459","wildcard-subdomain" "459","calc" "459","razor-2" "459","mink" "459","letter" "459","nstask" "459","logrotate" "459","android-keypad" "459","ios16" "459","etw" "459","laravel-jetstream" "459","google-smart-home" "458","pry" "458","supabase-database" "458","attached-properties" "458","tabitem" "458","today-extension" "458","scheduledexecutorservice" "458","openni" "458","lasso-regression" "458","proximity" "458","electron-forge" "457","ffprobe" "457","clang-tidy" "457","django-tests" "457","aws-batch" "457","dynamics-crm-365" "457","blockingqueue" "457","playwright-test" "457","okta-api" "457","lightbox2" "457","userid" "456","content-disposition" "456","froala" "456","cancancan" "456","windows-sharepoint-services" "456","recipe" "456","native-code" "456","aggregateroot" "456","boost-serialization" "456","kafka-python" "456","net-http" "456","extentreports" "456","google-cloud-data-fusion" "456","q-learning" "456","google-container-registry" "456","nightmare" "455","phasset" "455","phpbb3" "455","catalog" "455","castle-activerecord" "455","doctest" "455","service-reference" "455","scaffold" "455","visualsvn" "455","directions" "455","nodelist" "455","monotouch.dialog" "455","node-fetch" "455","darknet" "455","zipkin" "454","date-difference" "454","pan" "454","json4s" "454","unordered-set" "454","android-developer-api" "454","oledbcommand" "454","android-layout-weight" "454","google-fonts" "454","google-openid" "453","in-memory" "453","jxl" "452","jconsole" "452","mvcsitemapprovider" "452","selectors-api" "452","airplay" "452","creation" "452","optionmenu" "452","country" "452","entry-point" "452","aql" "452","atg" "452","fragmenttransaction" "452","esp-idf" "452","angular-formly" "452","angular-flex-layout" "452","cgpath" "452","touchesbegan" "452","array-map" "451","jboss-eap-7" "451","mysql-5.6" "451","punctuation" "451","viewchild" "451","visual-studio-addins" "451","netflix" "451","azure-openai" "451","radius" "451","elastic-map-reduce" "451","speech-synthesis" "451","stm32cubeide" "451","stdarray" "451","pre-commit" "451","gmt" "450","ddev" "450","window-managers" "450","single-responsibility-principle" "450","recurring-billing" "450","pdi" "450","azure-cdn" "450","azure-cosmosdb-mongoapi" "450","ws-federation" "450","corrupt" "450","ionic-view" "450","wix3.7" "450","android-graphview" "450","azure-functions-runtime" "450","tls1.3" "450","locks" "450","peerjs" "450","centos8" "450","mediator" "450","mbed" "450","linode" "450","google-mirror-api" "449","frp" "449","filepicker" "449","simulate" "449","vbulletin" "449","uistatusbar" "449","uiappearance" "449","v4l2" "448","maven-archetype" "448","gravityforms" "448","ssis-2008" "448","sharekit" "448","react-spring" "448","fat-free-framework" "448","vibration" "448","rasa-core" "448","strong-typing" "447","finalizer" "447","rpart" "447","intune" "447","application.properties" "447","easyadmin" "447","radgridview" "447","sceneform" "447","sql-scripts" "447","android-motionlayout" "447","parallels" "447","font-awesome-5" "446","anomaly-detection" "446","locationlistener" "446","shared-element-transition" "446","alerts" "446","rollover" "446","crashlytics-android" "446","monetdb" "446","visual-c++-6" "446","nullable-reference-types" "446","openxlsx" "446","angularjs-factory" "446","getopts" "446","using-statement" "446","google-nativeclient" "445","adminlte" "445","vs-extensibility" "445","kubernetes-secrets" "445","formidable" "445",".net-4.6" "445","visual-web-developer" "445","libjpeg" "445","azure-queues" "445","xcode13" "445","asp.net-webpages" "445","esbuild" "445","event-bus" "445","preference" "445","health-check" "444","anti-patterns" "444","nameservers" "444","jradiobutton" "444","ota" "444","office-scripts" "444","node.js-connect" "444","testng-dataprovider" "444","partial-classes" "444","compojure" "443","react-pdf" "443","python-dateutil" "443","kubeflow" "443","aws-elasticsearch" "443","sessionfactory" "443","jqtouch" "443","luajit" "443","rasterio" "443","rails-console" "443","mesosphere" "443","google-cloud-monitoring" "443","automl" "443","haxm" "443","alt" "443","powerbi-custom-visuals" "443","mshtml" "442","programmatically-created" "442","roi" "442","aws-msk" "442","windows-scripting" "442","pbkdf2" "442","dust.js" "442","hotchocolate" "442","sasl" "442","minizinc" "442","bridge" "442","syntactic-sugar" "442","timeoutexception" "442","garbage" "442","uicontrol" "442","railo" "442","com+" "442","message-driven-bean" "442","linkbutton" "442","sub-array" "441","interactive-brokers" "441","slidingdrawer" "441","fips" "441","voxel" "441","metatrader4" "441","pty" "441","error-reporting" "441","bug-tracking" "441","ratingbar" "441","lemmatization" "441","xcode4.6" "441","tabpanel" "441","sqldataadapter" "441","officer" "441","vaadin-grid" "441","google-play-developer-api" "440","react-navigation-bottom-tab" "440","termux" "440","fluent-interface" "440","decimal-point" "440","try-catch-finally" "440","slot" "440","function-templates" "440","pundit" "440","android-screen-support" "440","google-account" "440","legend-properties" "440","aspect" "440","google-finance" "440","monit" "440","chart.js2" "440","zipcode" "440","avatar" "440","zend-db-table" "439","mxgraph" "439","clearcase-ucm" "439","kubernetes-service" "439","calibration" "439","hp-quality-center" "439","diffie-hellman" "439","requestfactory" "439","zedgraph" "439","solidworks" "439","stdtuple" "438","keyvaluepair" "438","kendo-chart" "438","optimistic-locking" "438","grpc-python" "438","htmlwidgets" "438","appstore-sandbox" "438","sapi" "438","rigid-bodies" "438","synthesis" "438","ampersand" "438","go-ethereum" "438","setfocus" "438","dir" "438","androiddesignsupport" "438","digest" "438","opengl-4" "438","continuous" "438","esxi" "438","web-analytics" "438","haversine" "438","lidar" "437","greatest-common-divisor" "437","dispatch-async" "437","modelmapper" "437","ns-3" "437","atoi" "437","v-model" "437","retry-logic" "437","jaeger" "437","sql-agent-job" "437","preflight" "437","tflearn" "437","vaadin14" "436","recyclerview-layout" "436","hyperledger-chaincode" "436","dask-dataframe" "436","ringtone" "436","misra" "436","mirroring" "436","ab-testing" "436","dft" "436","android-jetpack-compose-material3" "436","perlin-noise" "436","glkit" "436","spacebars" "435","fluent-ui" "435","yii-components" "435","find-occurrences" "435","gprs" "435","sass-loader" "435","grunt-contrib-watch" "435","hashlib" "435","expansion" "435","activexobject" "435","bayesian-networks" "435","bem" "435","tpu" "435","autodesk-designautomation" "434","decrement" "434","dataloader" "434","jtds" "434","app-router" "434","posix-select" "434","scala-gatling" "434","gojs" "434","kryo" "434","associative" "434","j" "434","c++23" "434","cursor-position" "434","google-places-autocomplete" "433","jce" "433","llama" "433","datomic" "433","ibm-doors" "433","oracle11gr2" "433","jmh" "433","azure-batch" "433","tx-news" "433","nested-if" "433","ractivejs" "433","mpeg" "433","emf" "433","precision-recall" "432","skin" "432","distributed-caching" "432","fusedlocationproviderapi" "432","dataadapter" "432","angular-validation" "432","pbs" "432","ensemble-learning" "432","rijndael" "432","build-tools" "432","setattribute" "432","angular2-aot" "432","custom-renderer" "432","android-navigationview" "432","beagleboard" "432","gnat" "432","autologin" "432","embedded-database" "431","multinomial" "431","class-validator" "431","transpiler" "431","physics-engine" "431","xml-signature" "431","bitbucket-api" "431","fast-ai" "431","navision" "431","quickcheck" "431","office-ui-fabric" "430","category-theory" "430","rust-diesel" "430","datetime-parsing" "430","myeclipse" "430","savechanges" "430","pydub" "430","objective-c-category" "430","spy" "430","azure-repos" "430","motorola" "429","fuseki" "429","kudu" "429","ruby-1.9" "429","variable-length-array" "429","derived" "429","spring-data-r2dbc" "429","border-layout" "429","jvectormap" "429","jung" "429","typesafe-activator" "429","minidom" "429","rangeslider" "429","geany" "429","google-directory-api" "429","spatial-query" "429","metalkit" "429","event-driven" "429","text-analysis" "429","parser-combinators" "429","subset-sum" "428","case-statement" "428","xen" "428","aes-gcm" "428","ibm-integration-bus" "428","django-permissions" "428","microsoft-entra-id" "428","mysql-json" "428","delphi-11-alexandria" "428","nscollectionview" "428","virtual-inheritance" "428","actioncontroller" "428","movie" "428","android-pageradapter" "428","mdf" "427","yodlee" "427","floor" "427","vs-web-site-project" "427","vmware-workstation" "427","disabled-input" "427","function-composition" "427","azure-api-apps" "427","jquery-tabs" "427","android-input-method" "427","android-debug" "427","rabbitmq-exchange" "427","gdbserver" "427","petapoco" "427","gets" "427","throughput" "427","webgl2" "427","asciidoctor" "426","xmlpullparser" "426","biztalk-2013" "426","rtc" "426","metro-bundler" "426","katana" "426","newtons-method" "426","facebook-insights" "426","view-helpers" "426","angularjs-http" "426","linphone" "425","deeplearning4j" "425","plane" "425","vscode-snippets" "425","django-apps" "425","p2" "425","binutils" "425","push-back" "425","canonical-link" "425","hmvc" "425","low-latency" "425","move-constructor" "425","tfrecord" "425","concourse" "425","train-test-split" "424","backtrace" "424","fbo" "424","llvm-c++-api" "424","manjaro" "424","sentinel" "424","mako" "424","service-locator" "424","wpml" "424","internet-radio" "424","audiotrack" "424","newman" "424","netfilter" "424","winhttp" "424","brightscript" "424","openquery" "424","msgpack" "424","theming" "423","cloudflare-workers" "423","chunked-encoding" "423","django-2.0" "423","jinternalframe" "423","google-vr" "423","aws-lambda-layers" "423","grpc-go" "423","vmware-clarity" "423","16-bit" "423","build-system" "423","plink" "423","contract" "423","python-zipfile" "423","perspectivecamera" "422","xpath-1.0" "422","fseek" "422","ccsprite" "422","camelcasing" "422","windows-media-player" "422","microsoft-fakes" "422","pdf-viewer" "422","mod-jk" "422","wpf-4.0" "422","octal" "422","frameset" "422","javascriptserializer" "422","motion-detection" "422","cups" "422","mousedown" "422","react-dnd" "422","startswith" "421","gitkraken" "421","matplotlib-animation" "421","directshow.net" "421","picasa" "421","xps" "421","rmysql" "421","grails-3.0" "421","kendo-mobile" "421","spring-micrometer" "421","nrwl" "421","ampl" "421","donut-chart" "421","scip" "421","responsiveness" "421","login-script" "421","quadratic" "421","maven-dependency-plugin" "421","stubbing" "420","ansible-awx" "420","vue-reactivity" "420","undefined-symbol" "420","circular-buffer" "420","flash-media-server" "420","nested-function" "420","spring-mongodb" "420","turbo-c++" "420","turn" "420","pyrocms" "420","forgot-password" "420","mobile-browser" "420","uima" "420","spinnaker" "420","gephi" "420","google-nearby" "419","react-native-webview" "419","stan" "419","vue-chartjs" "419","vscode-devcontainer" "419","phylogeny" "419","flake8" "419","swingx" "419","shared-objects" "419","siri" "419","design-time" "419","vlcj" "419","minesweeper" "419","azure-vm-scale-set" "419","dimensionality-reduction" "419","meta-boxes" "419","mel" "419","bibtex" "418","git-extensions" "418","backbone-routing" "418","whois" "418","groupbox" "418","rrdtool" "418","spring-cloud-contract" "418","open3d" "418","android-service-binding" "418","entitlements" "418","buildpath" "418","col" "418","coding-efficiency" "418","magento-soap-api" "418","itunes-store" "418","evolutionary-algorithm" "418","acs" "418","papaparse" "418","qsqlquery" "417","xtend" "417","gregorian-calendar" "417","slim-3" "417","apache-iotdb" "417","fbconnect" "417","capitalization" "417","superscript" "417","onvif" "417","windows-update" "417","systems-programming" "417","leveldb" "417","netsh" "417","httpcookie" "417","message-passing" "417","autorelease" "417","scrollmagic" "417","qt3d" "417","mql5" "417","power-bi-report-server" "417","stimulusjs" "416","transient" "416","php-openssl" "416","livecharts" "416","language-server-protocol" "416","python-importlib" "416","card" "416","varbinary" "416","jquery-easyui" "416","tizen-wearable-sdk" "416","androidhttpclient" "416","react-fullstack" "416","getdate" "416","text-formatting" "415","ssrs-grouping" "415","sqrt" "415","git-fetch" "415","telerik-reporting" "415","vuetifyjs3" "415","wcag" "415","blueprint-osgi" "415","svcutil.exe" "415","output-buffering" "415","model-fitting" "415","xalan" "415","mnesia" "415","excel-tables" "415","elevated-privileges" "415","heidisql" "414","django-socialauth" "414","serverside-javascript" "414","robo3t" "414","keylogger" "414","enterprise-guide" "414","gwt2" "414","node-streams" "414","scnnode" "414","drone.io" "414","longlistselector" "414","get-request" "414","spread-syntax" "414","google-drive-shared-drive" "414","sortedlist" "413","apache-commons-net" "413","filehandle" "413","yelp" "413","fbsdk" "413","fetchxml" "413","squeak" "413","fuzzy-logic" "413","adblock" "413","microk8s" "413","pycuda" "413","interprocess" "413","azure-container-service" "413","brush" "413","wix3.6" "413","asp.net-core-middleware" "413","nsviewcontroller" "413","uianimation" "413","xacml" "413","mpich" "413","google-cloud-shell" "413","storage-access-framework" "413","qobject" "413","preg-replace-callback" "413","multi-gpu" "413","qtip2" "412","definitelytyped" "412","translate-animation" "412","bitmapdata" "412","angular-service-worker" "412","django-oscar" "412","awesome-wm" "412","htmlpurifier" "412","worklight-server" "412","shoutcast" "412","xcode-instruments" "412","table-valued-parameters" "412","not-exists" "412","isapi" "412","touch-id" "411","reminders" "411","prisma-graphql" "411","implements" "411","firebreath" "411","first-responder" "411","python-3.11" "411","hsm" "411","superagent" "411","moment-timezone" "411","woocommerce-subscriptions" "411","virtual-keyboard" "411","openlayers-6" "411","jacoco-maven-plugin" "411","spread" "411","computation" "411","usort" "411","utf8mb4" "411","line-plot" "410","file-association" "410","voyager" "410","google-webfonts" "410","openacc" "410","nslocalizedstring" "410","sanitize" "410","gedit" "410","openrefine" "410","haar-classifier" "410","strongly-typed-dataset" "410","hazelcast-imap" "410","flying-saucer" "410","msgbox" "410","state-monad" "410","url-shortener" "409","tensorflow-federated" "409","xpcom" "409","laravel-elixir" "409","uiviewanimationtransition" "409","circe" "409","android-search" "409","build.xml" "409","siddhi" "409","knockout-3.0" "409","hapi" "409","cagradientlayer" "409","qnetworkaccessmanager" "409","email-headers" "409","auto-indent" "409","scriptlet" "409","theos" "409","zeep" "408","eclipse-wtp" "408","flash-message" "408","kustomize" "408","jmeter-4.0" "408","awesomium" "408","cppcheck" "408","box2d-iphone" "408","pytest-django" "408","amazon-dynamodb-streams" "408","iisnode" "408","avalonia" "407","maui-blazor" "407","snakeyaml" "407","filepicker.io" "407","explicit" "407","azure-runbook" "407","protoc" "407","node-oracledb" "407","mongotemplate" "407","ember-router" "407","flutter-hive" "406","dbplyr" "406","ecmascript-next" "406","divider" "406","disconnect" "406","rowcount" "406","gpo" "406","singlestore" "406","dataimporthandler" "406","azure-diagnostics" "406","ambiguity" "406","libuv" "406","system.out" "406","lettuce" "406","tauri" "406","tablemodel" "406","dialogflow-cx" "406","penetration-testing" "406","quantlib" "406","sunspot-rails" "406","msdtc" "405","jboss-weld" "405","slime" "405","gridlayoutmanager" "405","fluent-assertions" "405","frequency-analysis" "405","inline-styles" "405","audit-logging" "405","python-webbrowser" "405","require-once" "405","quantum-computing" "404","listobject" "404","ckfinder" "404","slicers" "404","square-root" "404","sirikit" "404","cancellation-token" "404","uno-platform" "404","apple-sign-in" "404","android-statusbar" "404","attention-model" "404","codeigniter-url" "404","scopes" "404","timeit" "404","google-crawlers" "404","forceclose" "404","solace" "403","xserver" "403","github-desktop" "403","discount" "403","language-translation" "403","placement-new" "403","runge-kutta" "403","wavelet" "403","postal-code" "403","type-constraints" "403","type-alias" "403","svg.js" "403","java-10" "403","shallow-copy" "403","gadt" "403","galera" "403","podfile" "403","assertj" "403","nvidia-jetson" "403","hwnd" "403","quartz-core" "402","cloud-hosting" "402","vue-resource" "402","multiple-select" "402","gil" "402","circuit-breaker" "402","chrome-custom-tabs" "402","opticalflow" "402","aws-auto-scaling" "402","inline-formset" "402","java-security" "402","coercion" "402","do-loops" "402","external-tables" "402","showdialog" "402","asp.net-routing" "402","uielement" "402","beanstalkd" "402","pandas-styles" "402","qtip" "402","flutter-state" "401","jelastic" "401","imdb" "401","owncloud" "401","microsoft-graph-calendar" "401","object-lifetime" "401","redisson" "401","cglib" "401","subtotal" "401","maven-jetty-plugin" "401","avasset" "400","php-5.4" "400","backreference" "400","react-navigation-drawer" "400","websecurity" "400","srand" "400","php-ini" "400","fluent-bit" "400","bintray" "400","checkin" "400","rebus" "400","row-level-security" "400","keymapping" "400","html-datalist" "400","typeface" "400","py-langchain" "400","coq-tactic" "400","sql-server-2012-express" "400","web-essentials" "400","conditional-rendering" "399","xtragrid" "399","dcom" "399","cassandra-2.1" "399","django-1.8" "399","advantage-database-server" "399","selectedvalue" "399","configuration-management" "399","sitecore-mvc" "399","delphi-5" "399","saprfc" "399","oracle-xe" "399","extjs6-classic" "399","rails-geocoder" "399","google-distancematrix-api" "399","excel-dna" "399","react-intl" "399","amadeus" "399","subform" "399","autoboxing" "398","xtable" "398","sails-mongo" "398","xmltype" "398","opus" "398","service-provider" "398","in-place" "398","twilio-programmable-chat" "398","swashbuckle.aspnetcore" "398","miglayout" "398","timeserieschart" "398","tag-helpers" "398","tkinter-button" "398","azure-sdk" "398","leanback" "398","google-cloud-automl" "398","nodejs-server" "398","ienumerator" "398","autosave" "397","smartcard-reader" "397","srcset" "397","pixelsense" "397","ngmodel" "397","cidr" "397","chinese-locale" "397","service-layer" "397","venn-diagram" "397","jfrog-cli" "397","ruby-on-rails-5.1" "397","mongodb-indexes" "397","navigation-properties" "397","direct3d11" "397","spring-validator" "397","tkinter-layout" "397","uiscrollviewdelegate" "397","stoppropagation" "397","google-rich-snippets" "397","arr" "397","multibinding" "397","hexdump" "396","standards-compliance" "396","lit" "396","social-media" "396","manual" "396","undo-redo" "396","ankhsvn" "396","azure-devops-server-2019" "396","applinks" "396","bootstrap-multiselect" "396","intersystems-cache" "396","azure-analysis-services" "396","migradoc" "396","audiorecord" "396","fragmentstatepageradapter" "396","plotly-express" "396","exiftool" "396","r2dbc" "396","npm-publish" "396","spectrum" "396","prometheus-operator" "396","commonsware-cwac" "396","restfb" "396","mule-el" "396","prestashop-1.5" "396","emit" "396","sdp" "396","bgi" "396","tiled" "396","yq" "395","eclipse-indigo" "395","skinning" "395","instant-messaging" "395","recaptcha-v3" "395","vendor" "395","kernel-extension" "395","wand" "395","data-class" "395","swift-extensions" "395","springdoc-openapi-ui" "395","ribbonx" "395","objectbox" "395","microsoft-test-manager" "395","re2" "395","tfidfvectorizer" "395","struts2-jquery" "395","autograd" "394","django-1.7" "394","lang" "394","functools" "394","capl" "394","aws-xray" "394","atk4" "394","broker" "394","express-graphql" "394","mplot3d" "394","mouseout" "394","mono.cecil" "394","subject" "394","batik" "394","zbar" "393","lmfit" "393","clean-urls" "393","flume-ng" "393","sliding" "393","indexoutofrangeexception" "393","filepond" "393","alexa-voice-service" "393","epson" "393","pyproject.toml" "393","dot-product" "393","angular15" "393","reselect" "393","cudnn" "393","batch-normalization" "392","jdbi" "392","griddb" "392","flatbuffers" "392","jszip" "392","ruby-grape" "392","pycord" "392","apple-developer" "392","box-shadow" "392","powerapps-formula" "392","postgresql-13" "392","formal-languages" "392","javers" "392","android-anr-dialog" "392","py-telegram-bot-api" "392","egl" "392","ios8.1" "392","android-loadermanager" "392","string-aggregation" "392","webpack-encore" "391","apache-commons-dbcp" "391","renderpartial" "391","laravel-3" "391","firebase-app-check" "391","xml-documentation" "391","pandas-loc" "391","method-call" "391","spring-data-couchbase" "391","surveymonkey" "391","nested-sets" "391","formal-verification" "391","cocos2d-android" "391","orchestration" "391","fabric8" "391","generic-collections" "391","launch4j" "390","pagedlist" "390","role" "390","infrastructure" "390","devart" "390","vim-syntax-highlighting" "390","java-memory-model" "390","network-analysis" "390","nosetests" "390","lookbehind" "390","angular2-http" "390","parfor" "390","emv" "389","mvc-mini-profiler" "389","jmf" "389","named" "389","django-rest-framework-simplejwt" "389","jquery-callback" "389","koala" "389","xcode15" "389","azure-rest-api" "389","express-jwt" "389","subversive" "389","tornadofx" "389","maximize" "388","sshd" "388","ecmascript-2017" "388","image-loading" "388","fullcalendar-3" "388","circular-list" "388","platformio" "388","receiver" "388","key-value-coding" "388","windows-mobile-6.5" "388","error-log" "388","jquery-ui-resizable" "388","violin-plot" "388","facebook-canvas" "388","rapidjson" "388","azure-front-door" "388","azure-storage-queues" "388","redraw" "388","texas-instruments" "388","ember-simple-auth" "387","ssh.net" "387","graphene-django" "387","git-cherry-pick" "387","socketserver" "387","laravel-authentication" "387","soft-delete" "387","dm-script" "387","doctrine-1.2" "387","android-studio-2.3" "387","jquery-jtable" "387","facade" "387","amazon-simpledb" "387","azure-maps" "387","cert-manager" "387","meshlab" "387","perl-data-structures" "387","autoloader" "387","authorize-attribute" "387","gmail-addons" "387","has-one" "387","array-push" "386","background-position" "386","vstest" "386","skew" "386","aeson" "386","rxtx" "386","roleprovider" "386","boost-geometry" "386","twitter-streaming-api" "386","wstring" "386","eol" "386","visualstatemanager" "386","azure-iot-sdk" "386","quarkus-panache" "386","ascii-art" "385","cloning" "385","jsqmessagesviewcontroller" "385","bipartite" "385","fsockopen" "385","facebook-sdk-3.0" "385","nsset" "385","popper.js" "385","object-storage" "385","code-translation" "385","kotlin-native" "385","digest-authentication" "385","spring-web" "385","nonlinear-functions" "385","cupy" "385","getattr" "385","sti" "385","autocad-plugin" "384","xulrunner" "384","dbix-class" "384","directx-12" "384","incomplete-type" "384","singularity-container" "384","avx512" "384","ajv" "384","boost-program-options" "384","easing" "384","dynamic-loading" "384","enumerator" "384","facebook-audience-network" "384","pyobjc" "384","ui-select" "384","opensaml" "384","contourf" "384","activereports" "384","quadtree" "384","pre" "384","qtabwidget" "384","allegro" "383","matplotlib-3d" "383","phing" "383","llama-index" "383","jslider" "383","mapr" "383","named-parameters" "383","data-driven-tests" "383","k6" "383","html-rendering" "383","html-escape-characters" "383","onkeypress" "383","nerdtree" "383","tablecell" "383","cognos-10" "383","typegraphql" "383","xcode6.1" "383","dsn" "383","bytecode-manipulation" "383","string-conversion" "383","ocx" "383","offlineapps" "383","login-control" "383","qsub" "382","bixby" "382","piecewise" "382","catel" "382","overpass-api" "382","chunking" "382","adafruit" "382","calendarview" "382","angular-ngselect" "382","twitter-bootstrap-2" "382","shoulda" "382","redmine-plugins" "382","podspec" "382","test-coverage" "382","leakcanary" "382","usage-statistics" "382","url-pattern" "382","qtcore" "381","template-haskell" "381","youtrack" "381","file-locking" "381","castle" "381","gpx" "381","rspec3" "381","javadb" "381","code-documentation" "381","exponentiation" "381","openscenegraph" "381","custom-lists" "381","medical" "380","stacked" "380","ef-core-3.0" "380","flash-memory" "380","import-from-csv" "380","python-2.5" "380","rotational-matrices" "380","azure-app-service-envrmnt" "380","network-drive" "380","radar-chart" "380","scoring" "380","copying" "380","iscroll" "380","cgridview" "380","angular-changedetection" "380","collectionviewsource" "380","scrollpane" "379","yajra-datatable" "379","try-with-resources" "379","blackberry-cascades" "379","chroot" "379","db4o" "379","simplesamlphp" "379","kestrel" "379","blueprint" "379","julia-jump" "379","dynamics-nav" "379","sapper" "379","oci8" "379","shipping-method" "379","testthat" "379","webos" "378","mvc-editor-templates" "378","jcenter" "378","graph-traversal" "378","react-native-paper" "378","apl" "378","swr" "378","sniffing" "378","image-stitching" "378","dataverse" "378","aws-amplify-cli" "378","angular-strap" "378","sigint" "378","qwt" "378","rest-assured-jsonpath" "378","liferay-theme" "378","autosys" "378","zig" "377","figma" "377","cloudera-manager" "377","friend-function" "377","jxbrowser" "377","ndk-build" "377","deobfuscation" "377","visual-composer" "377","caddy" "377","azure-rm" "377","gams-math" "377","cgroups" "377","stripes" "377","lc3" "377","spl" "377","argument-dependent-lookup" "376","chown" "376","content-length" "376","wayland" "376","windows-community-toolkit" "376","nsdocumentdirectory" "376","equivalent" "376","easyphp" "376","boost-interprocess" "376","android-background" "376","sightly" "376","openurl" "376","nswindowcontroller" "376","x264" "376","metabase" "376","ms-release-management" "375","jenkins-workflow" "375","php-gd" "375","anorm" "375","back4app" "375","findcontrol" "375","plaid" "375","frida" "375","kubernetes-statefulset" "375","simultaneous" "375","nested-resources" "375","mongoimport" "375","asp.net-core-tag-helpers" "375","isometric" "375","currency-formatting" "375","summarization" "375","topology" "375","starling-framework" "375","stdbind" "374","fluent-ffmpeg" "374","tensorrt" "374","smarty3" "374","padrino" "374","android-timepicker" "374","facebook-iframe" "374","null-pointer" "374","dexie" "374","openvino" "374","mle" "374","http-method" "374","scylla" "374","stl-algorithm" "374","complextype" "374","article" "373","decoupling" "373","hyperledger-fabric-ca" "373","mysql-real-escape-string" "373","darwin" "373","doctrine-query" "373","cross-reference" "373","delta" "373","google-closure-library" "373","f#-data" "373","pysftp" "373","windows-terminal" "373","objectlistview" "373","itemssource" "373","dimple.js" "373","digit" "373","mpmovieplayer" "373","mpmusicplayercontroller" "373","resolver" "373","image-capture" "373","web-deployment-project" "373","mediastream" "373","maven-failsafe-plugin" "372","template-matching" "372","directus" "372","laravel-collection" "372","snappy" "372","unusernotificationcenter" "372","pulseaudio" "372","windows-container" "372","jls" "372","openflow" "372","writetofile" "372","audiotoolbox" "372","azure-redis-cache" "372","drilldown" "372","nonce" "372","getattribute" "372","qfiledialog" "372","webauthn" "372","linked-data" "372","yugabytedb" "371","ef-core-6.0" "371","interbase" "371","catboost" "371","apache-pulsar" "371","sharepoint-api" "371","aws-glue-data-catalog" "371","psd" "371","sifr" "371","attributerouting" "371",".net-1.1" "371","dropshadow" "371","android-deep-link" "371","prometheus-node-exporter" "371","activation" "371","array-filter" "371","idp" "370","flink-cep" "370","default-parameters" "370","sentence" "370","python-unittest.mock" "370","indexer" "370","packets" "370","flashlight" "370","django-i18n" "370","crt" "370","jgroups" "370","onnxruntime" "370","nativequery" "370","delphi-10.4-sydney" "370","branch-prediction" "370","execvp" "370","ply" "370","css-specificity" "370","line-numbers" "370","star-schema" "370","for-comprehension" "370","solana-web3js" "369","declarative" "369","ssi" "369","defaulttablemodel" "369","sql-server-profiler" "369","palette" "369","binaryformatter" "369","mandelbrot" "369","rounding-error" "369","windows-10-desktop" "369","data-import" "369","just-audio" "369",".so" "369","hint" "369","plinq" "369","azure-files" "369","android-optionsmenu" "369","ews-managed-api" "369","qtquickcontrols2" "368","gist" "368","whoosh" "368","render-to-texture" "368","pimcore" "368","swiftui-tabview" "368","fuseesb" "368","django-nonrel" "368","pdftotext" "368","android-wake-lock" "368","nsmutableurlrequest" "368","libevent" "368","cocos2d-js" "368","3-tier" "368","3d-reconstruction" "368","tab-completion" "368","magento-rest-api" "368","rails-models" "368","regexp-substr" "368","x-axis" "368","generate" "368","testunit" "368","mtom" "367","default-arguments" "367","filedialog" "367","jspdf-autotable" "367","p4v" "367","paginator" "367","sencha-touch-2.1" "367","avkit" "367","cross-apply" "367","django-rest-viewsets" "367","cross-entropy" "367","mib" "367","signtool" "367","nsmenu" "367","navicat" "367","jrubyonrails" "367","lua-patterns" "367","lwp" "367","setvalue" "367","udid" "367","mach-o" "367","netbeans-6.9" "367","raml" "367","javascript-debugger" "367","uid" "367","android-r8" "367","iphone-developer-program" "367","hevc" "367","identity-column" "366","kubernetes-pvc" "366","cross-correlation" "366","sequelize-typescript" "366","facebook-pixel" "366","django-validation" "366","modifier" "366","www-mechanize" "366","two-way-binding" "366","sap-basis" "366","mongodump" "366","google-checkout" "366","brunch" "366","netbeans-plugins" "366","asp.net-mvc-scaffolding" "366","dotnetnuke-module" "366","openrowset" "366","spnego" "366","react-bootstrap-table" "366","transcoding" "366","image-conversion" "366","utility" "366","prettyphoto" "365","jsni" "365","cascading" "365","single-quotes" "365","methodology" "365","windows-phone-8-emulator" "365","documentum" "365","django-template-filters" "365","cancellationtokensource" "365","savestate" "365","dynamic-import" "365","hotmail" "365","viewbox" "365","strstr" "365","glpk" "365","urlopen" "365","scriptaculous" "364","fileinfo" "364","ansi-sql" "364","xmllint" "364","kendo-scheduler" "364","readxl" "364","azure-boards" "364","hp-ux" "364","nstimeinterval" "364","existential-type" "364","hibernate-5.x" "364","textjoin" "364","changeset" "364","accounting" "364","youtube-livestreaming-api" "364","script-task" "364","arrow-keys" "364","ticker" "363","vspackage" "363","primevue" "363","primereact" "363","mapped-types" "363","simpy" "363","sbt-native-packager" "363","jvisualvm" "363","microsoft-translator" "363","randomaccessfile" "363","notifyicon" "363","tanstackreact-query" "363","mobile-phones" "363","azure-load-balancer" "363","android-memory" "363","request-promise" "363","conceptual" "363","structured-data" "363","arcmap" "362","truncation" "362","fakeiteasy" "362","readme" "362","rebuild" "362","desire2learn" "362","sim-card" "362","nsight" "362","samsung-galaxy" "362","postgresql-8.4" "362","expandoobject" "362","numberpicker" "362","c#-to-f#" "362","collaborative-filtering" "362","chartkick" "362","zustand" "362","hector" "362","url-mapping" "361","jmenu" "361","reason" "361","saving-data" "361","visual-c++-2010" "361","cognos-bi" "361","android-fonts" "361","laravel-sail" "361","memorycache" "361","react-animated" "361","google-translation-api" "361","cythonize" "361","bignum" "361","measurement-protocol" "360","gitlab-ce" "360","rust-polars" "360","catalina" "360","firebase-test-lab" "360","faye" "360","boost-filesystem" "360","android-storage" "360","deterministic" "360","pdftron" "360","3des" "360","3dtouch" "360","orange" "360","javafxports" "360","winpcap" "360","spring-test-mvc" "360","xcode7.3" "360","reactive-streams" "360","event-viewer" "360","late-binding" "360","change-tracking" "360","qlistview" "360","compiler-bug" "360","google-plus-one" "360","pre-commit.com" "359","aot" "359","backspace" "359","feedparser" "359","ulimit" "359","app.yaml" "359","react-three-drei" "359","oracle-data-integrator" "359","inflate" "359","spring-data-jdbc" "359","nsmutableattributedstring" "359","jasypt" "359","buildout" "359","type-deduction" "359","bridging-header" "359","type-families" "359","ubercart" "359","isomorphic-javascript" "359","mkoverlay" "359","nullptr" "359","compare-and-swap" "359","toolbox" "359","android-management-api" "358","skrollr" "358","treeviewitem" "358","unbind" "358","fresco" "358","distortion" "358","flatlist" "358","kendo-dropdown" "358","scala-2.8" "358","silverstripe-4" "358","dense-rank" "358","domain-model" "358","libpq" "358","objectanimator" "358","radial-gradients" "358","bulk-load" "358","stringio" "358","test-kitchen" "358","strip-tags" "358","android-popupwindow" "357","gitlab-omnibus" "357","ssh-agent" "357","rxjs-pipeable-operators" "357","jspinner" "357","factory-boy" "357","ibm-rad" "357","nao-robot" "357","spring-integration-sftp" "357","system.io.file" "357","machine-translation" "357","dojox.grid.datagrid" "357","time-format" "357","referential-integrity" "357","openpgp" "357","google-datalayer" "357","stripe-connect" "357","android-notification-bar" "357","ios-extensions" "357","second-level-cache" "356","ebnf" "356","grocery-crud" "356","blazemeter" "356","wc" "356","appveyor" "356","inode" "356","rar" "356","registrykey" "356","collect" "355","list-initialization" "355","vsx" "355","fuzzy-comparison" "355","fasm" "355","alfresco-webscripts" "355","init.d" "355","visionos" "355","fragment-backstack" "355","restrict" "355","http-request" "355","egg" "355","strongname" "355","statefulwidget" "355","amazon-connect" "355","hdf" "355","ussd" "354","decomposition" "354","termination" "354","fuzzy" "354","marketplace" "354","caldav" "354","modular" "354","spring-profiles" "354","boost-propertytree" "354","r-grid" "354","pymupdf" "354","video-editing" "354","shorthand" "354","aspose.words" "354","dgrid" "354","tapply" "354","scrapyd" "354","prototype-programming" "354","duckdb" "354","activeresource" "354","angular-fullstack" "354","duplicate-data" "354","traefik-ingress" "353","xv6" "353","gridpane" "353","dd" "353","dcos" "353","react-native-video" "353","cdo-climate" "353","rs485" "353","nsrunloop" "353","ioerror" "353","rhandsontable" "353","fputcsv" "353","scandir" "353","prop" "353","http-response-codes" "353","androidplot" "353","ilmerge" "353","usergroups" "353","arules" "353","avassetexportsession" "353","mbeans" "352","livecycle" "352","flowlayout" "352","base-url" "352","selectedindex" "352","silent" "352","nebular" "352","boxlayout" "352","dxf" "352","dynamicquery" "352","iocp" "352","mixed-content" "352","coldfusion-2016" "352","fortran95" "352","dropdownlistfor" "352","android-paging-3" "352","ignore" "351","xsd.exe" "351","cloud-init" "351","web-standards" "351","maui-community-toolkit" "351","in-app" "351","piping" "351","django-mptt" "351","docbook" "351","gpu-shared-memory" "351","spring-boot-admin" "351","boost-bind" "351","oscommerce" "351","mermaid" "351","acfpro" "351","google-coral" "351","qabstractitemmodel" "351","octopress" "351","active-directory-group" "351","topshelf" "351","zoneddatetime" "351","web-chat" "350","multiset" "350","skia" "350","php-telegram-bot" "350","progress-db" "350","mailmessage" "350","n-queens" "350","mod-perl" "350","android-studio-2.0" "350","wndproc" "350","broom" "350","android-homebutton" "350","elevation" "350","angularjs-components" "350","shelve" "350","as.date" "350","subscriptions" "349","economics" "349","vs-unit-testing-framework" "349","mupdf" "349","ef-core-5.0" "349","imbalanced-data" "349","flame" "349","cdf" "349","checkmarx" "349","pagerank" "349","unirest" "349","shared-directory" "349","reagent" "349","rssi" "349","avcapturedevice" "349","bower-install" "349","vigenere" "349","atmelstudio" "349","kops" "349","convention" "349","angular-controller" "349","dtype" "349","request-mapping" "349","ogre" "349","acumatica-kb" "349","pre-increment" "349","automated-refactoring" "349","avalondock" "348","tensorflow-probability" "348","ng-view" "348","function-calls" "348","filesystemobject" "348","packing" "348","aws-device-farm" "348","java-5" "348","3d-model" "348","winscp-net" "348","drush" "348","ivr" "348","activation-function" "348","android-radiobutton" "348","either" "348","resilience4j" "348","google-code" "348","zoom-sdk" "348","qtimer" "348","arrows" "347","multi-user" "347","multipleselection" "347","listagg" "347","photoswipe" "347","salesforce-communities" "347","jarsigner" "347","minimagick" "347","nvda" "347","testng-eclipse" "347","text-rendering" "347","leaflet.markercluster" "347","reserved-words" "347","genetic-programming" "347","iphone-6" "347","qpid" "347","google-maps-static-api" "347","spacy-3" "347","stimulsoft" "346","size-t" "346","vpython" "346","xmonad" "346","dateformatter" "346","hypothesis-test" "346","jitsi" "346","cpack" "346","boost-log" "346","rhomobile" "346","wlst" "346","synchronize" "346","random-access" "346","siebel" "346","difflib" "346","radix-sort" "346","toastr" "346","noexcept" "346","xbap" "346","dijit.form" "346","quirks-mode" "346","color-palette" "346","react-native-camera" "346","nimbus" "346","leap-motion" "346","scrollspy" "345","aem-6" "345","ultrawingrid" "345","ng-template" "345","icarousel" "345","cakephp-2.4" "345","dynamics-business-central" "345","networkd3" "345","gwtp" "345","ios17" "345","excel-365" "345","command-line-tool" "345","elasticsearch-2.0" "345","paper-elements" "345","gml" "345","concurrentdictionary" "344","vuelidate" "344","data-recovery" "344","data-partitioning" "344","nextjs-image" "344","silent-installer" "344","android-auto" "344","double-pointer" "344","downgrade" "344","bulletphysics" "344","cabal-install" "344","reference-type" "344","css-multicolumn-layout" "344","sumproduct" "344","sos" "344","mediawiki-extensions" "343","multivalue" "343","git-add" "343","const-correctness" "343","owl-carousel-2" "343","bindinglist" "343","cp-sat" "343","workflow-activity" "343","scala-ide" "343","azcopy" "343","post-processing" "343","microsoft-identity-platform" "343","obd-ii" "343","magmi" "343",".net-4.7.2" "343",".net-core-2.0" "343","netlink" "343","luigi" "343","xbox" "343","scoped-storage" "343","qwebengineview" "343","dts" "343","gethashcode" "343","memory-profiling" "343","aruco" "343","imagefield" "343","amazon-cloudsearch" "343","sunburst-diagram" "342","vue-apollo" "342","listeners" "342","unique-index" "342","financial" "342","smartgit" "342","rust-macros" "342","iccube" "342","ibm-datapower" "342","document-root" "342","mongo-java-driver" "342","jquery-validation-engine" "342","demo" "342","nsrange" "342","entity-framework-4.3" "342","bluehost" "342","pyopencl" "342","android-api-levels" "342","lwip" "342","javafx-11" "342","dovecot" "342","expert-system" "342","proxy-classes" "342","customdialog" "342","elixir-mix" "342","webpack-hmr" "342","flutter-ios" "342","maven-jaxb2-plugin" "341","inspector" "341","castle-dynamicproxy" "341","connection-refused" "341","vnet" "341","uncaught-exception" "341","appender" "341","jmenuitem" "341","datainputstream" "341","word-frequency" "341","abcpdf" "341","form-helpers" "341","type-level-computation" "341","screen-recording" "341","drawtext" "341","drupal-webform" "341","textblob" "341","arraycollection" "340","dita" "340","contentcontrol" "340","ovh" "340","flex4.6" "340","fits" "340","crosswalk" "340","application-loader" "340","tablecelleditor" "340","gobject" "340","libsodium" "340","quickfixj" "340","hadoop-partitioning" "340","spray-json" "340","duplex" "340","cublas" "340","spacemacs" "339","eeprom" "339","cleartool" "339","manifest.mf" "339","volumes" "339","facebook-share" "339","canoe" "339","named-scope" "339","sitecore7.2" "339","kernighan-and-ritchie" "339","bootstrap-popover" "339","gtag.js" "339","opencv3.1" "339","fpdi" "339","pyright" "339","sql-server-2014-express" "339","np-complete" "339","redis-sentinel" "339","mmenu" "339","sql-merge" "339","opengl-compat" "339","spring-thymeleaf" "339","iterm" "339","identity-management" "339","gnuradio-companion" "338","eclipse-neon" "338","swiftui-navigationstack" "338","file-watcher" "338","sni" "338","vault" "338","recycle" "338","angularjs-ng-options" "338","cs-cart" "338","mongodb-replica-set" "338","onlongclicklistener" "338","ws" "338","paytm" "338","kotlin-extension" "338","f5" "338","code-readability" "338","author" "338","titanium-modules" "338","escpos" "338","activity-finish" "338","heremaps" "338","seconds" "337","jbuilder" "337","imagesource" "337","affinity" "337","file-processing" "337","dayjs" "337","vba7" "337","publisher" "337","html5boilerplate" "337","countvectorizer" "337",".obj" "337","facebook-likebox" "337","android-fusedlocation" "337","openstack-nova" "337","sql-server-2008-express" "337","event-delegation" "337","moodle-api" "337","android-lint" "337","thinktecture-ident-server" "337","google-secret-manager" "337","solaris-10" "337","git-rewrite-history" "337","arrayobject" "336","flutter-desktop" "336","dataformat" "336","django-unittest" "336","server-push" "336","hsts" "336","susy-compass" "336","postman-pre-request-script" "336","javascriptcore" "336","code-access-security" "336","ondestroy" "336","permgen" "336","accumulate" "336","linter" "336","gmsmapview" "335","multi-project" "335","renaming" "335","switching" "335","value-objects" "335","root-framework" "335","country-codes" "335","simpleadapter" "335","information-extraction" "335","typename" "335","guzzle6" "335","pepper" "335","zend-form-element" "335","glyph" "335","z-order" "334","sknode" "334","teams-toolkit" "334","python-3.2" "334","veracode" "334","cpu-cores" "334","2-way-object-databinding" "334","facebook-chatbot" "334","vertex-buffer" "334","uidocumentinteraction" "334","monthcalendar" "334","sungridengine" "334","tflite" "334","flutter-local-notification" "334","securityexception" "333","mwaa" "333","json-serialization" "333","python-extensions" "333","namecheap" "333","r-lavaan" "333","nsmenuitem" "333","crc16" "333","azure-container-apps" "333","bootstrap-selectpicker" "333","hottowel" "333","android-fullscreen" "333","scipy.stats" "333","asp.net-blazor" "333","reset-password" "333","node-request" "333","compass-geolocation" "333","amazon-glacier" "333","maxmind" "332","gridpanel" "332","flowlayoutpanel" "332","next-router" "332","appearance" "332","data-integrity" "332","robovm" "332","docplex" "332","scala-java-interop" "332","modular-arithmetic" "332","gbm" "332","mlr" "332","acid" "332","multibyte" "331","mux" "331","datetime-conversion" "331","date-comparison" "331","connected-components" "331","var-dump" "331","django-email" "331","nats.io" "331","justify" "331","android-audiorecord" "331","quicklook" "331","tabwidget" "331","rackspace-cloud" "331","httpsurlconnection" "331","scribe" "331","media-source" "330","remotewebdriver" "330","telemetry" "330","wifip2p" "330","feedback" "330","voting" "330","lagom" "330","import-csv" "330","rust-rocket" "330","django-file-upload" "330","faster-rcnn" "330","auditing" "330","osx-leopard" "330","microsoft-ui-automation" "330","tablespace" "330","coordinate" "330","azure-sdk-python" "330","devexpress-windows-ui" "330","bzip2" "330","test-suite" "330","splinter" "330","force.com" "330","emmeans" "330","idl-programming-language" "330","starlette" "329","mutablelivedata" "329","remoteview" "329","localizable.strings" "329","react-native-fbsdk" "329","flask-migrate" "329","firebase-crash-reporting" "329","django-widget" "329","datagridcomboboxcolumn" "329","one-definition-rule" "329","onenote-api" "329","network-traffic" "329","object-reference" "329","nosql-aggregation" "329","elastic-load-balancer" "329","odoo-16" "329","md5sum" "328","matter.js" "328","probability-distribution" "328","datetimeindex" "328","snort" "328","data-access" "328","recover" "328","roboguice" "328","oracle18c" "328","wavefront" "328","angularjs-ng-route" "328","rollingfileappender" "328","onscroll" "328","twitterapi-python" "328","java.util.date" "328","minimal-apis" "328","context-switch" "328","openshift-client-tools" "328","xa" "328","playing-cards" "328","spinlock" "328","nic" "328","monomac" "328","geode" "328","mrjob" "328","statsd" "328","array-algorithms" "328","static-initialization" "327","tensorflow-hub" "327","deezer" "327","php-8.1" "327","sql-tuning" "327","apk-expansion-files" "327","smart-table" "327","chilkat" "327","kusto-explorer" "327","flask-restplus" "327","vonage" "327","model-validation" "327","jquery-cookie" "327","range-v3" "327","3d-modelling" "327","associated-types" "327","gdk" "327","google-cloud-scheduler" "327","spoofing" "327","limits" "327","tidesdk" "327","parser-generator" "326","trend" "326","disabled-control" "326","contactless-smartcard" "326","data-integration" "326","capitalize" "326","opscenter" "326","dwr" "326","inflate-exception" "326","pymongo-3.x" "326","terragrunt" "326","angular16" "326","httplib" "326","amazon-linux" "326","topological-sort" "326","submit-button" "326","partial-specialization" "325","yield-return" "325","phpcodesniffer" "325","backbone-model" "325","cifs" "325","unicode-escapes" "325","sender" "325","gprof" "325","supportmapfragment" "325","wit.ai" "325","jasmine-node" "325","tabula" "325","react-beautiful-dnd" "325","office-2007" "325","persian" "325","qtwidgets" "325","argo-workflows" "325","google-picker" "325","static-ip-address" "325","arbitrary-precision" "324","cloud9" "324","telecommunication" "324","datepickerdialog" "324","symfony-3.2" "324","function-parameter" "324","vuex-modules" "324","unity-editor" "324","asynchttpclient" "324","typescript1.8" "324","dom4j" "324","convex-optimization" "324","lead" "324","lotus-formula" "324","hcl" "324","qt4.8" "324","mui-datatable" "323","bash-completion" "323","anonymous-methods" "323","mass-assignment" "323","pandas-resample" "323","django-1.11" "323","bitcode" "323","mallet" "323","pimpl-idiom" "323","unsigned-char" "323","database-relations" "323","coverity" "323","opencart-module" "323","spring-repositories" "323","html5-filesystem" "323","nsstream" "323","viewdata" "323","gzipstream" "323","openlayers-5" "323","modbus-tcp" "323","android-fingerprint-api" "323","custom-errors" "323","react-big-calendar" "323","text-recognition" "323","duck-typing" "323","script-tag" "323","bazel-rules" "322","dbnull" "322","termios" "322","webviewclient" "322","integer-programming" "322","phar" "322","flask-security" "322","uiwebviewdelegate" "322","round-robin" "322","win32-process" "322","react-transition-group" "322","aws-php-sdk" "322","pci-compliance" "322","karma-mocha" "322","revolution-slider" "322","ordinal" "322","typescript-decorator" "322","bus" "322","azure-rbac" "322","command-pattern" "322","react-lifecycle" "322","changelog" "322","conditional-types" "322","allegro5" "322","linguistics" "322","autosar" "322","dart-async" "322","autoprefixer" "322","amazon-rekognition" "322","fmt" "321","yii2-model" "321","jsoncpp" "321","python-appium" "321","router-outlet" "321","kindle-fire" "321","django-storage" "321","del" "321","coreclr" "321","ext4" "321","mimekit" "321","drupal-taxonomy" "321","plumber" "321","xamarin.uitest" "321","sqlparameter" "321","asp.net-core-7.0" "321","last.fm" "321","lru" "321","pester" "321","pgbouncer" "321","angular4-router" "321","qscrollarea" "321","user-interaction" "321","webix" "321","top-n" "320","editorconfig" "320","math.h" "320","cl" "320","temporary-objects" "320","yaml-cpp" "320","flatpickr" "320","page-object-gem" "320","filesaver.js" "320","data-management" "320","g1gc" "320","microprofile" "320","akamai" "320","android-sharing" "320","apple-maps" "320","android-textinputedittext" "320","pymodbus" "320","rackspace" "320","xcode14" "320","text-size" "320","react-konva" "320","mbprogresshud" "320","hce" "320","ifs" "320","thread-local-storage" "319","teamcity-9.0" "319","graylog" "319","php4" "319","bitwise-and" "319","name-mangling" "319","velocity.js" "319","wso2-iot" "319","silverlight-2.0" "319","pearson-correlation" "319","tabactivity" "319","orthographic" "319","accelerate-framework" "319","tmp" "319","play-json" "319","vfs" "319","scraper" "319","gentoo" "319","test-bench" "319","gen-server" "319","genesis" "319","peer" "319","laravel-seeding" "319","msbuild-4.0" "319","hdmi" "319","quandl" "319","alphabet" "319","zend-route" "319","web-mediarecorder" "319","panoramas" "318","rxdart" "318","aws-cloudwatch-log-insights" "318","windows-messages" "318","database-table" "318","keyboard-hook" "318","routerlink" "318","boost-variant" "318","sap-cloud-sdk" "318","sfsafariviewcontroller" "318","object-files" "318","shoes" "318","digital" "318","android-event" "318","spidermonkey" "318","towers-of-hanoi" "318","amazon-opensearch" "318","mdbootstrap" "318","msix" "318","glimpse" "317","jenkins-agent" "317","telnetlib" "317","yahoo-pipes" "317","kubernetes-cronjob" "317","kernel32" "317","swarm" "317","jquery-load" "317","twython" "317","borrowing" "317","inorder" "317","blogspot" "317","libtorch" "317","sql-limit" "317","qlist" "317","projects" "317","on-duplicate-key" "317","esapi" "317","zepto" "317","imagelist" "317","google-sheets-macros" "317","google-schemas" "316","eclipse-mars" "316","fluentui-react" "316","backticks" "316","chipmunk" "316","advanced-installer" "316","waf" "316","jgrasp" "316","recursive-backtracking" "316","rte" "316","bourbon" "316","nestedscrollview" "316","spring-batch-admin" "316","buildbot" "316","outlook-web-app" "316","drawstring" "316","jackson-dataformat-xml" "316","xcb" "316","hudson-plugins" "316","elasticsearch-7" "316","cufon" "316","sonarqube5.1" "316","sortedset" "315","replacewith" "315","pg-restore" "315","telegram-api" "315","slots" "315","php-7.3" "315","runas" "315","xml-attribute" "315","design-principles" "315","ar.js" "315","nserror" "315","pyrogram" "315","broadleaf-commerce" "315","orchardcms-1.6" "315","openstack-swift" "315","uigraphicscontext" "315","nsurlsessiondownloadtask" "315","nouislider" "315","xceed" "315","dup2" "315","google-cloud-dns" "315","eventlet" "315","ofbiz" "314","tryparse" "314","consensus" "314","apache-mina" "314","runtime-permissions" "314","fxmlloader" "314","real-time-data" "314","cakephp-1.2" "314","unwind-segue" "314","bolt-cms" "314","dynamic-forms" "314","oozie-coordinator" "314","object-recognition" "314","modelattribute" "314","operands" "314","dart-isolates" "314","mdichild" "314","autopostback" "313","phonegap-pushplugin" "313","circuit" "313","socialengine" "313","mapquest" "313","apache-tiles" "313","python-embedding" "313","jira-rest-java-api" "313","recurring" "313","gpt-3" "313","workitem" "313","apple-vision" "313","jrebel" "313","salesforce-service-cloud" "313","libtiff" "313","overhead" "313","wireshark-dissector" "313","convergence" "313","notin" "313","notion-api" "313","galleria" "313","tabpage" "313","android-radiogroup" "313","search-suggestion" "312","eddystone" "312","pingfederate" "312","appcompatactivity" "312","datefield" "312","ups" "312","mongo-java" "312","nsnotification" "312","audit-trail" "312","woocommerce-theming" "312","azure-service-principal" "312","scim" "312","long-press" "312","cometd" "312","zurb-foundation-5" "312","octobercms-plugins" "312","autodesk-data-management" "312","powershell-5.1" "311","xticks" "311","wechat" "311","checkpoint" "311","laravel-11" "311","image-preprocessing" "311","xml-comments" "311","pagemethods" "311","oraclereports" "311","psr-4" "311","metatrader5" "311","virtualtreeview" "311","doorkeeper" "311","numa" "311","cordova-2.0.0" "311","ios5.1" "311","httponly" "311","spool" "311","qiskit" "311","webcrypto-api" "311","zombie-process" "311","alpha-beta-pruning" "311","subsequence" "311","google-photos" "311","google-search-appliance" "310","ansible-tower" "310","liskov-substitution-principle" "310","mvccontrib" "310","symmetricds" "310","aws-cloud9" "310","name-lookup" "310","angular-router-guards" "310","nest-api" "310","infrared" "310","dynamic-controls" "310","open-uri" "310","jai" "310","centos5" "310","cellular-network" "310","http-compression" "310","qbxml" "310","multibranch-pipeline" "309","pixel-shader" "309","undetected-chromedriver" "309","xiaomi" "309","mfcc" "309","fault-tolerance" "309","azure-devops-self-hosted-agent" "309","dynamic-columns" "309","ganache" "309","dotnetnuke-7" "309","mktime" "309","bulkupdate" "309","estimote" "309","es6-proxy" "309","activemerchant" "309","ctest" "309","ios-4.2" "309","sharpsvn" "309","stylelint" "308","replicate" "308","jdbc-odbc" "308","removeall" "308","data-transform" "308","ceil" "308","nfa" "308","servo" "308","fancytree" "308","pybrain" "308","jmeter-3.2" "308","rownum" "308","pose-estimation" "308","appointment" "308","dill" "308","scalatra" "308","actionevent" "308","qfile" "308","stocks" "308","android-lvl" "308","msbi" "308","maxscript" "308","amazon-redshift-spectrum" "308","stdset" "307","reliability" "307","mutability" "307","chrome-native-messaging" "307","adobe-reader" "307","seq2seq" "307","windows-kernel" "307","grape-api" "307","mongojs" "307","svnkit" "307","typed-arrays" "307","externalinterface" "307","vk" "307","orientation-changes" "307","pmml" "307","centroid" "307","react-map-gl" "307","launch-screen" "307","omnisharp" "307","utm" "307","compile-time-constant" "306","standard-error" "306","gridcontrol" "306","python-jira" "306","goutte" "306","crosswalk-runtime" "306","angular-material-6" "306","detach" "306","twilio-click-to-call" "306","opcache" "306","worklight-studio" "306","nsmutablestring" "306","tlb" "306","tclientdataset" "306","gamepad" "306","android-navigation-graph" "306","genetics" "306","pelican" "306","ipados" "306","always-encrypted" "305","primefaces-extensions" "305","defined" "305","selectedindexchanged" "305","playframework-2.6" "305","maintainability" "305","data-protection" "305","function-prototypes" "305","akka-persistence" "305","cruisecontrol" "305","session-management" "305","jgrapht" "305","variadic-macros" "305","bootstrap-sass" "305","eonasdan-datetimepicker" "305","cornerradius" "305","sandcastle" "305","pyflink" "305","nw.js" "305","hierarchicaldatatemplate" "305","notnull" "305","numericupdown" "305","azure-java-sdk" "305","openocd" "305","large-data-volumes" "305","shell-extensions" "305","tpm" "305","arc4random" "305","power-platform" "305","maven-compiler-plugin" "305","subgraph" "305","linefeed" "304","cmyk" "304","react-native-image-picker" "304","debian-based" "304","addressing-mode" "304","django-autocomplete-light" "304","incompatibility" "304","blurry" "304","infopath2010" "304","detailview" "304","mkdocs" "304","android-bundle" "304","nomachine-nx" "304","retain-cycle" "304","perfmon" "304","eventbrite" "304","questdb" "304","autorun" "304","email-spam" "304","startactivityforresult" "303","lithium" "303","mute" "303","litespeed" "303","intellij-13" "303","listen" "303","runspace" "303","selenide" "303","vowpalwabbit" "303","chronometer" "303","appdata" "303","css-filters" "303","readdir" "303","dask-delayed" "303","waitpid" "303","wpf-style" "303","cowplot" "303","forex" "303","tablecolumn" "303","aspose-cells" "303","higher-kinded-types" "303","memory-segmentation" "303","mopub" "303","pentaho-cde" "303","paper-trail-gem" "303","emoticons" "303","webmin" "303","flutter-image" "302","sjplot" "302","matrix-indexing" "302","imgui" "302","xml2" "302","meteor-helper" "302","joomla1.7" "302","csc" "302","jms-topic" "302","nse" "302","bounce" "302","codelite" "302","objectcontext" "302","kubeadm" "302","knime" "302","ocelot" "302","noise-reduction" "302","tailwind-ui" "302","opensql" "302","getch" "302","leaflet.draw" "302","stringi" "302","cumulocity" "302","nodejs-stream" "302","param" "302","spannable" "302","stdlist" "302","stepper" "302","qtcpsocket" "301","integrity" "301","clang-static-analyzer" "301","apache2.2" "301","mutual-authentication" "301","stack-frame" "301","cimg" "301","django-3.0" "301","advanceddatagrid" "301","docker-toolbox" "301","twitter-typeahead" "301","pos" "301","poppler" "301","nbconvert" "301","typelib" "301","tabbarcontroller" "301","hibernate-4.x" "301","asp.net-mvc-5.1" "301","android-icons" "301","expandable" "301","itfoxtec-identity-saml2" "301","textkit" "301","angular-chart" "301","megamenu" "301","iphone-4" "301","subshell" "300","flock" "300","ciimage" "300","chemistry" "300","nano" "300","vehicle-routing" "300","cakephp-2.x" "300","django-taggit" "300","html-editor" "300","neat" "300","influxdb-2" "300","konva" "300","network-interface" "300","ubuntu-11.04" "300","mlr3" "300","controlsfx" "300","cg" "300","parameterized-query" "300","concept" "300","glass-mapper" "300","amazon-cloudtrail" "300","mediacontroller" "300","tidytext" "299","fgetc" "299","uniswap" "299","apim" "299","django-filters" "299","turfjs" "299","gtk4" "299","forth" "299","extending" "299","libssh2" "299","system.net" "299","node-sqlite3" "299","burp" "299","cab" "299","execcommand" "299","eureka-forms" "299","mov" "299","yui3" "299","mdc" "299","solid-js" "299","lightningchart" "298","flutter-bottomnavigation" "298","jsse" "298","content-assist" "298","apktool" "298","css3pie" "298","sesame" "298","route-provider" "298","simplejson" "298","calllog" "298","simplepie" "298","serial-number" "298","passport-facebook" "298","kapt" "298","settings.bundle" "298","ksoap" "298","c++-coroutine" "298","asp.net-core-1.1" "298","cakebuild" "298","azure-form-recognizer" "298","qtspim" "298","touchableopacity" "297","template10" "297","filefield" "297","sna" "297","kubeflow-pipelines" "297","jsdoc3" "297","cc" "297","django-pagination" "297","intptr" "297","amf" "297","winforms-interop" "297","to-date" "297","google-image-search" "297","zigbee" "296","printdocument" "296","squash" "296","live-tile" "296","stacked-bar-chart" "296","xilinx-ise" "296","anime.js" "296","googlevis" "296","realsense" "296","kendo-datasource" "296","onion-architecture" "296","dwarf" "296","sat" "296","960.gs" "296","rhel6" "296","sql-date-functions" "296","spring-webflow-2" "296","copy-elision" "296","hmacsha1" "296","testing-library" "296","angular-elements" "296","textureview" "296","project-template" "296","logparser" "296","odoo-view" "296","ninject.web.mvc" "296","glsles" "296","sunspot-solr" "296","sharpdevelop" "296","pane" "295","procfile" "295","team-explorer" "295","xtrareport" "295","django-annotate" "295","dbase" "295","adview" "295","rocket.chat" "295","factorization" "295","hypervisor" "295","asyncfileupload" "295","bufferedinputstream" "295","microstrategy" "295","vm-implementation" "295","hockeyapp" "295","polymer-3.x" "295","pointfree" "295","omnipay" "295","using-directives" "295","webpack-file-loader" "294","apache-age" "294","stable-baselines" "294","relaycommand" "294","dbmigrate" "294","smtp-auth" "294","rpg" "294","operations" "294","boost-regex" "294","sap-iq" "294","tunneling" "294","onerror" "294","spring-logback" "294","wrappanel" "294","signal-handling" "294","abstracttablemodel" "294","videochat" "294","richedit" "294","magento-2.3" "294","gatsby-image" "294","c#-to-vb.net" "294","tinymce-5" "294","sql-optimization" "294","husky" "294","react-css-modules" "294","long-running-processes" "294","sony-smartwatch" "294","soundmanager2" "294","transactional-replication" "294","cyanogenmod" "293","floating-point-conversion" "293","graph-tool" "293","tempdata" "293","representation" "293","jcifs" "293","smime" "293","simplehttpserver" "293","ndepend" "293","boost-spirit-x3" "293","opam" "293","erlang-shell" "293","kaa" "293","godaddy-api" "293","visual-studio-2003" "293","outlook-2013" "293","rabl" "293","contextmenustrip" "293","ta-lib" "293","nuget-server" "293","peg" "293","es6-module-loader" "293","react-dropzone" "293","daphne" "292","smali" "292","yeoman-generator-angular" "292","multipage" "292","triplestore" "292","xmlbeans" "292","laragon" "292","rstan" "292","fancybox-3" "292","blit" "292","spring-data-gemfire" "292","bloom-filter" "292","invisible-recaptcha" "292","vimeo-player" "292","r-dbi" "292","fragment-tab-host" "292","audiocontext" "292","extensibility" "292","contrast" "292","gate" "292","iso8583" "292","android-ibeacon" "292","azure-resource-group" "292","node.js-addon" "292","accord.net" "292","charat" "292","ios-camera" "292","storefront" "292","looker" "292","ppm" "292","subdocument" "291","background-subtraction" "291","livy" "291","psych" "291","key-pair" "291","android-wear-data-api" "291","openai-whisper" "291","cortana" "291","spring-authorization-server" "291","android-settings" "291","boost-beast" "291","brightcove" "291","mit-scratch" "291","system.net.mail" "291","viewwillappear" "291","observableobject" "291","playn" "291","bullet" "291","mlogit" "291","xcframework" "291","hamming-distance" "291","logitech" "291","collatz" "291","pervasive" "291","mql" "291","eslint-config-airbnb" "291","cucumber-serenity" "291","cyclomatic-complexity" "291","ie8-compatibility-mode" "291","mdns" "291","panic" "291","paradigms" "290","nextjs-dynamic-routing" "290","jsonresponse" "290","django-cors-headers" "290","blackberry-playbook" "290","xmltable" "290","page-load-time" "290","pycryptodome" "290","documents" "290","variable-length" "290","superfish" "290","swift-concurrency" "290","swc" "290","visual-studio-sdk" "290","excel-indirect" "290","copy-item" "290","android-compose-textfield" "290","azure-functions-core-tools" "290","getresource" "290","elasticsearch-java-api" "290","huggingface-datasets" "290","collider" "290","flutter-pageview" "290","static-classes" "290","zend-view" "290","arff" "289","squirrel-sql" "289","laradock" "289","lampp" "289","kubelet" "289","adfs3.0" "289","fiware-cygnus" "289","aero" "289","dnsmasq" "289","grails3" "289","docker-swarm-mode" "289","winappdriver" "289","urlclassloader" "289","bold" "289","delimited" "289","inkcanvas" "289","android-version" "289","abac" "289","notice" "289","pebble-watch" "289","persistent-volume-claims" "289","angular2-testing" "289","change-data-capture" "289","laravel-lighthouse" "289","genfromtxt" "289","eiffel" "289","google-cloud-tasks" "289","stockquotes" "289","msg" "289","google-my-business-api" "288","yoast" "288","fizzbuzz" "288","nextjs14" "288","xfce" "288","animated" "288","html.actionlink" "288","jquery-effects" "288","kartik-v" "288","password-recovery" "288","mod-python" "288","onmouseout" "288","openejb" "288","macos-ventura" "288","libavformat" "288","mobile-devices" "288","logitech-gaming-software" "288","lte" "288","hybridauth" "288","charindex" "288","toolstrip" "288","sparc" "288","yui-compressor" "287","ec2-ami" "287","skshapenode" "287","listpreference" "287","websphere-6.1" "287","sketchup" "287","teradatasql" "287","terminal-services" "287","adal.js" "287","affiliate" "287","marketo" "287","nhibernate-criteria" "287","xml.etree" "287","self-signed-certificate" "287","containerd" "287","django-login" "287","avmutablecomposition" "287","airtable" "287","optparse" "287","karma-coverage" "287","boost-mpl" "287","paw-app" "287","luxon" "287","pydicom" "287","c++-modules" "287","protobuf-java" "287","column-width" "287","log4net-appender" "287","textchanged" "287","storing-data" "287","ld-preload" "287","ios-bluetooth" "287","leading-zero" "287","binance-api-client" "287","ikvm" "287","bibliography" "287","thickbox" "287","bc" "287","custom-server-controls" "286","trayicon" "286","flutter-android" "286","file-storage" "286","bitarray" "286","pairwise" "286","apm" "286","bin-packing" "286","mysql-error-1054" "286","keyboardinterrupt" "286","oracle-spatial" "286","sirishortcuts" "286","rasterizing" "286",".class-file" "286","hibernate-entitymanager" "286","eventual-consistency" "286","beego" "285","repr" "285","cloud-document-ai" "285","slimdx" "285","react-slick" "285","tedious" "285","full-outer-join" "285","addchild" "285","real-mode" "285","real-time-updates" "285","docker-in-docker" "285","writeablebitmap" "285","tweak" "285","gssapi" "285","minmax" "285","pygraphviz" "285","typescript-types" "285","pypyodbc" "285","broadcasting" "285","scjp" "285","nvidia-jetson-nano" "285","azure-sql-managed-instance" "285","hk2" "285","memory-layout" "285","http-request-parameters" "285","uv-mapping" "285","iequalitycomparer" "284","square-bracket" "284","dct" "284","private-methods" "284","treegrid" "284","wicket-6" "284","react-native-gesture-handler" "284","imei" "284","lame" "284","jlink" "284","julian-date" "284","spring-restdocs" "284","gtfs" "284","openblas" "284","jquery-ui-tooltip" "284","spring-security-ldap" "284","delayed-execution" "284","android-adapterview" "284","android-5.1.1-lollipop" "284","kotlinx.serialization" "284","spring-statemachine" "284","r.js" "284","noscript" "284","drools-guvnor" "284","ios-universal-app" "284","http-status-code-504" "284","ipsec" "284","launching-application" "284","elasticsearch-6" "284","nock" "284","array-difference" "283","fclose" "283","stackexchange-api" "283","sendfile" "283","flet" "283","soft-keyboard" "283","voice-recording" "283","symfony-security" "283","django-custom-user" "283","aiml" "283","windowsiot" "283","rom" "283","aws-lambda-edge" "283","postman-testcase" "283","azure-cosmosdb-gremlinapi" "283","path-variables" "283","exim" "283","istio-gateway" "283","dexterity" "283","diamond-problem" "283","point-in-polygon" "283","qlpreviewcontroller" "283","lcov" "283","tetris" "283","ekevent" "283","spatial-index" "283","prerequisites" "283","parent-pom" "283","idempotent" "282","react-native-svg" "282","jformattedtextfield" "282","github-copilot" "282","socat" "282","adobe-edge" "282","packagist" "282","unary-operator" "282","receipt" "282","durandal-2.0" "282","set-intersection" "282","scenarios" "282","chartjs-2.6.0" "282","mpeg2-ts" "282","linear-search" "282","zen-cart" "282","preloading" "281","wia" "281","flutterflow" "281","stable-diffusion" "281","phpwebsocket" "281","kindle" "281","rotativa" "281","aws-sdk-go" "281","sharepoint-clientobject" "281","cardinality" "281","rowfilter" "281","internal-storage" "281","gui-testing" "281","rfcomm" "281","for-xml-path" "281","opentracing" "281","xaf" "281","scala-reflect" "281","uint8t" "281","android-nested-fragment" "281","longitudinal" "281","ios8-share-extension" "281","laravel-valet" "281","ess" "281","beeline" "281","cydia" "281","begininvoke" "280","skaffold" "280","cnosdb" "280","banner-ads" "280","weibull" "280","laravelcollective" "280","finally" "280","play-billing-library" "280","uniform" "280","avplayeritem" "280","agents-jade" "280","wildfly-9" "280","google-client" "280",".net-remoting" "280","r-forestplot" "280","typeid" "280","pyscript" "280","android-bottomnav" "280","devstack" "280","hibernate-onetomany" "280","redis-cli" "280","mkv" "280","activator" "280","node.js-fs" "280","multifile-uploader" "280","haskell-platform" "280","fmod" "280","folderbrowserdialog" "280","hexo" "279","class-hierarchy" "279","sse2" "279","trendline" "279","disaster-recovery" "279","confluence-rest-api" "279","smartface.io" "279","ruta" "279","ibooks" "279","redbean" "279","air-native-extension" "279","hotspot" "279","jquery-tokeninput" "279","azure-data-studio" "279","junit-jupiter" "279","postgresql-14" "279","lexical-scope" "279","objection.js" "279","systemc" "279","shadcnui" "279","redefinition" "279","hindi" "279","mlops" "279","sql-job" "279","android-mvp" "279","memory-mapping" "279","mean.io" "279","ilist" "279","tibco-ems" "278","livechat" "278","gridster" "278","temporal" "278","react-native-elements" "278","xuggler" "278","snmp4j" "278","nextcord" "278","chromadb" "278","i386" "278","icollection" "278","serve" "278","twain" "278","opencmis" "278","spring-cloud-function" "278","surefire" "278","bloodhound" "278",".net-4.6.1" "278","ribbon-control" "278","android-date" "278","highmaps" "278","android-ble" "278","tizen-native-app" "278","hubot" "278","ctrl" "278","partition-by" "278","mui-x-data-grid" "278","webmail" "277","gitattributes" "277","graylog2" "277","federation" "277","sql-timestamp" "277","s3cmd" "277","k-fold" "277","inequality" "277","angularjs-resource" "277","indoor-positioning-system" "277","datagridtemplatecolumn" "277","angular-observable" "277","ibdesignable" "277","dynamic-language-runtime" "277","invoke-webrequest" "277","code-conversion" "277","rdkit" "277","shake" "277","xcode3.2" "277","acra" "277","google-geolocation" "277","http-put" "277","access-rights" "277","lazy-sequences" "277","zynq" "277","gmap.net" "276","mutt" "276","react-rails" "276","matlab-coder" "276","graphql-subscriptions" "276","django-formwizard" "276","idataerrorinfo" "276","data-ingestion" "276","pushwoosh" "276","realurl" "276","jlayeredpane" "276","coverflow" "276","pdf-reader" "276","code-metrics" "276","org.json" "276","vml" "276","uimenucontroller" "276","android-gesture" "276","azure-signalr" "276","taskkill" "276","stream-processing" "276","iphone-6-plus" "276","sheetjs" "276","autotest" "276","web.config-transform" "276","cypress-cucumber-preprocessor" "275","deedle" "275","relevance" "275","react-ref" "275","ujs" "275","xml-drawable" "275","divi" "275","undirected-graph" "275","segment-tree" "275","python-curses" "275","importrange" "275","wasm-bindgen" "275","dmg" "275","canny-operator" "275","faraday" "275","wcag2.0" "275","roman-numerals" "275","ontouch" "275","turtle-rdf" "275","nattable" "275","openfl" "275","domino-designer-eclipse" "275","outofrangeexception" "275","pytest-mock" "275","kotlin-stateflow" "275","dht" "275","pytorch-geometric" "275","mongorestore" "275","lpsolve" "275","lazycolumn" "275","eleventy" "275","node-inspector" "275","flutter-video-player" "275","autolisp" "274","cmake-gui" "274","blacklist" "274","django-1.5" "274","data-stream" "274","jpackage" "274","nested-object" "274","scalacheck" "274","delphi-6" "274","innertext" "274","coremltools" "274","hotwire-rails" "274","onitemclick" "274","r-corrplot" "274","codesandbox" "274","syslog-ng" "274","netlify-cms" "274","railscasts" "274","azure-search-.net-sdk" "274","g-wan" "274","location-services" "274","toml" "274","ektron" "274","idhttp" "274","google-plus-signin" "274","amazon-dynamodb-index" "274","heat" "274","search-box" "274","sharpziplib" "274","conemu" "274","usart" "273","yii1.x" "273","jclouds" "273","decentralized-applications" "273","sqlyog" "273","page-title" "273","ng-zorro-antd" "273","docking" "273","djongo" "273","turbo-c" "273","android-13" "273","mahout-recommender" "273","knockout-mvc" "273","lenses" "273","kotlin-exposed" "273","visual-c#-express-2010" "273","copy-protection" "273","busboy" "273","tld" "273","highcharts-ng" "273","resource-files" "273","across" "273","quantstrat" "273","static-typing" "273","scripting-language" "272","terminal-emulator" "272","yocto-recipe" "272","cloud-storage" "272","vue-loader" "272","pkce" "272","imread" "272","xlsm" "272","adsi" "272","redactor" "272","axlsx" "272","opencover" "272","pdflib" "272","octobercms-backend" "272","pyephem" "272",".post" "272","m2crypto" "272","nvidia-docker" "272","nominatim" "272","spritebuilder" "272","nunit-console" "272","ollydbg" "272","google-cloud-load-balancer" "272","textformfield" "272","laravel-permission" "272","offline-mode" "272","mtls" "272","sonos" "272","traceroute" "272","emma" "271","class-template" "271","weasyprint" "271","dcast" "271","clojure-java-interop" "271","django-1.9" "271","undefined-index" "271","jsonresult" "271","r-tree" "271","jquery-forms-plugin" "271","nsautoreleasepool" "271","opencpu" "271","applescript-objc" "271","observablelist" "271","kotlin-js" "271","browser-plugin" "271","null-coalescing-operator" "271","accumulator" "271","qbytearray" "271","hyper" "271","subscriber" "271","toplevel" "271","imagedownload" "270","mathematical-expressions" "270","ansi" "270","cmath" "270","ng-style" "270","fileserver" "270","dynamic-tables" "270","nested-for-loop" "270","code-inspection" "270","rijndaelmanaged" "270","wix3.8" "270","uipopover" "270","xcode5.1" "270","screensharing" "270","ios-darkmode" "270","specman" "270","getfiles" "269","barrier" "269","ffmpeg-php" "269","template-toolkit" "269","processstartinfo" "269","fine-tuning" "269","kubernetes-deployment" "269","rx.net" "269","rxandroidble" "269","fuzzing" "269","xmldom" "269","calico" "269","document-body" "269","grafana-variable" "269","inline-editing" "269","pdf-conversion" "269","modern-ui" "269","core-telephony" "269","boost-test" "269","r-exams" "269","express-router" "269","abc" "269","jaspersoft-studio" "269","exchange-server-2007" "269","azure-storage-files" "269","quotation-marks" "269","sqlgeography" "269","nlohmann-json" "269","proj" "269","resourcemanager" "269","react-helmet" "269","imagefilter" "268","back-testing" "268","php-internals" "268","bindparam" "268","json-query" "268","sinon-chai" "268","data-distribution-service" "268","fail2ban" "268","dynamic-variables" "268","aws-sdk-net" "268","jqxgrid" "268","degrees" "268","javafx-webengine" "268","pydrive" "268","isolation" "268","bytesio" "268","po" "268","angular-i18n" "268","node-http-proxy" "268","mpmediaitem" "268","accumulo" "268","comma-operator" "268","google-talk" "268","time.h" "268","medical-imaging" "267","template-templates" "267","multiple-choice" "267","apache-iceberg" "267","app-id" "267","symfony-2.7" "267","ng2-bootstrap" "267","cscope" "267","windows-iot-core-10" "267","wcf-web-api" "267","facebook-timeline" "267","spring-cloud-task" "267","portainer" "267","hsl" "267","bootstrap-carousel" "267","google-apps-script-addon" "267","wix-react-native-navigation" "267","uidocument" "267","ironruby" "267","geom" "267","heartbeat" "267","array-splice" "267","start-process" "266","flurl" "266","maskedtextbox" "266","photosframework" "266","webtest" "266","weak-ptr" "266","apache-calcite" "266","underscore.js-templating" "266","jscrollbar" "266","laravel-forge" "266","casbah" "266","avspeechsynthesizer" "266","icomparable" "266","induction" "266","oracle-coherence" "266","dynamics-365-operations" "266","wshttpbinding" "266","invalid-argument" "266","svn-checkout" "266","coin-change" "266","shadowbox" "266","viewengine" "266","pygments" "266","amazon-selling-partner-api" "266","m2m" "266","osascript" "266","drupal-9" "266","nsurlsessiondatatask" "266","nsurlcache" "266","c#-9.0" "266","mlp" "266","mmu" "266","versions" "266","trailing-slash" "266","web-application-firewall" "266","webflow" "266","empty-list" "266","artoolkit" "266","pascals-triangle" "265","siteminder" "265","citations" "265","locate" "265","overleaf" "265","in-clause" "265","jmenubar" "265","keras-2" "265","spring-messaging" "265","android-studio-2.1" "265","pcsc" "265","pcf" "265","wss-3.0" "265","azure-devops-pipelines" "265","mit-scheme" "265","codesys" "265","fpu" "265","azure-vm" "265","dtrace" "265","react-modal" "265","stringtemplate" "265","alteryx" "265","torrent" "264","babel-polyfill" "264","react-navigation-v6" "264","prism-4" "264","skypedeveloper" "264","fields-for" "264","bad-alloc" "264","tripledes" "264","mutual-exclusion" "264","int64" "264","sshfs" "264","selectionchanged" "264","unboxing" "264","dbal" "264","chutzpah" "264","jsonstore" "264","angularjs-ng-change" "264","ibm-connections" "264","jira-agile" "264","azure-app-configuration" "264","opendir" "264","salesforce-marketing-cloud" "264","opa" "264","azerothcore" "264","atomikos" "264","libreoffice-basic" "264","dom-traversal" "264","amazon-waf" "264","fortran-iso-c-binding" "264","kotlinx.coroutines" "264","numpy-einsum" "264","hash-function" "264","raft" "264","opengl-es-3.0" "264","android-push-notification" "264","memory-limit" "264","elasticsearch-net" "264","angular-cli-v6" "264","mongrel" "264","google-data-api" "264","dancer" "264","gnome-shell" "263","graphical-logo" "263","apache-config" "263","youtube-analytics-api" "263","catkin" "263","afnetworking-3" "263","datepart" "263","appcelerator-alloy" "263","mapbox-marker" "263","circleci-2.0" "263","data-persistence" "263","django-q" "263","avconv" "263","server-error" "263","fastq" "263","aws-aurora-serverless" "263","uno" "263","delphi-2006" "263","mongo-cxx-driver" "263","jvm-crash" "263","inputmismatchexception" "263","dynamics-ax-2012-r2" "263","typesafe" "263","wordpress-jetpack" "263","schematron" "263","uipasteboard" "263","uiresponder" "263","ocunit" "263","spotlight" "263","before-filter" "263","webhdfs" "263","transaction-isolation" "263","linkify" "262","telegram-webhook" "262","multiple-domains" "262","yadcf" "262","edit-distance" "262","bjam" "262","runner" "262","credential-providers" "262","jmonkeyengine" "262","dxgi" "262","guile" "262","rc" "262","amazon-swf" "262","mithril.js" "262","midlet" "262","modelbinders" "262","x87" "262","numerical-analysis" "262","nuspec" "262","cache-manifest" "262","hiera" "262","pyusb" "262","proxmox" "262","angular2-formbuilder" "262","spreadsheetgear" "262","ldd" "262","authorize" "262","webdriver-manager" "262","batterylevel" "262","helix-3d-toolkit" "261","react-server-components" "261","lmdb" "261","yarn-v2" "261","dead-letter" "261","debian-buster" "261","filenet-p8" "261","react-quill" "261","photokit" "261","cng" "261","connect-by" "261","nexus-7" "261","file-structure" "261","page-tables" "261","flash-cs3" "261","data-generation" "261","datagridviewcombobox" "261","angularjs-orderby" "261","recoiljs" "261","angular-unit-test" "261","natural-sort" "261","botocore" "261","magnetometer" "261","face-api" "261","system-properties" "261","hapi-fhir" "261","plsql-package" "261","taylor-series" "261","qlayout" "261","http-proxy-middleware" "261","lcdui" "261","google-fit-sdk" "261","ipopt" "261","ursina" "261","here-maps-rest" "261","web-forms-for-marketers" "261","armv8" "260","mutiny" "260","procedures" "260","jetpack-compose-navigation" "260","maven-central" "260","citrus-framework" "260","contentobserver" "260","django-2.2" "260","socket-timeout-exception" "260","dbexpress" "260","undeclared-identifier" "260","chatterbot" "260","variable-names" "260","vagrant-windows" "260","pushsharp" "260","optgroup" "260","turborepo" "260","arabic-support" "260","nsexception" "260","e4x" "260","android-async-http" "260","view-scope" "260","rating-system" "260","tnsnames" "260","elastica" "260","google-cloud-networking" "260","restler" "260","iphone-standalone-web-app" "260","google-cloud-console" "260","cgi-bin" "260","spark-streaming-kafka" "260","parallel.for" "259","remap" "259","relocation" "259","ssms-2012" "259","basichttpbinding" "259","data-science-experience" "259","distributed-tracing" "259","laravel-api" "259","xfbml" "259","xp-cmdshell" "259","owin-middleware" "259","pycairo" "259","microsoft-edge-extension" "259","vcenter" "259","farsi" "259","blink" "259","model-view" "259","android-tabactivity" "259","cppunit" "259","html-heading" "259","nwjs" "259","wolframalpha" "259","shim" "259","mime-message" "259","orb" "259","buefy" "259","viewdidappear" "259","azure-traffic-manager" "259","ack" "259","merge-replication" "259","license-key" "259","thumb" "259","liferay-aui" "259","statistical-test" "259","headset" "258","listiterator" "258","math.net" "258","dataoutputstream" "258","run-length-encoding" "258","language-model" "258","imageurl" "258","angular-upgrade" "258","simple-schema" "258","jitpack" "258","pthread-join" "258","jmock" "258","jpopupmenu" "258","dynamic-binding" "258","ooad" "258","dynamic-content" "258","boost-multi-index" "258","wsadmin" "258","sap-cloud-platform" "258","winrar" "258","rights" "258","android-7.1-nougat" "258","osrm" "258","mixed" "258","nucleo" "258","proxy-server" "258","react-native-cli" "258","nmea" "258","panels" "258","auto-populate" "258","conduit" "258","partial-application" "258","embedded-v8" "257","react-native-reanimated-v2" "257","transliteration" "257","local-database" "257","cncontact" "257","templatetags" "257","multivariate-testing" "257","webusercontrol" "257","ng-packagr" "257","pitch" "257","imx6" "257","constructor-injection" "257","fileshare" "257","unity3d-editor" "257","socketchannel" "257","factory-method" "257","favorites" "257","anko" "257","rollapply" "257","swfupload" "257","kali-linux" "257","nslocale" "257","on-screen-keyboard" "257","nsinteger" "257","setting" "257","sigmoid" "257","sphinx4" "257","projectile" "257","zio" "257","zingchart" "257","qtquickcontrols" "257","autoresizingmask" "257","mui-x" "257","prettyfaces" "257","flutterwebviewplugin" "257","suffix" "257","premake" "256","ant-contrib" "256","data-sharing" "256","mapkitannotation" "256","sendinput" "256","cbc-mode" "256","google-vpc" "256","cannot-find-symbol" "256","angular-leaflet-directive" "256","dwm" "256","jquery-svg" "256","kanban" "256","random-effects" "256","halide" "256","leap-year" "256","laravel-mail" "256","solid-state-drive" "256","arcgis-server" "256","sonarcloud" "256","ie-developer-tools" "256","user-defined" "255","integrate" "255","truncated" "255","reply" "255","apache-curator" "255","backbone-relational" "255","swiftui-animation" "255","bisection" "255","selenium-iedriver" "255","python-c-extension" "255","appendto" "255","unsafe-pointers" "255","aws-pinpoint" "255","microsoft365" "255","django-managers" "255","watchconnectivity" "255","nslookup" "255","moles" "255","otrs" "255","abstract-factory" "255","google-ad-manager" "255","javascript-automation" "255","setuid" "255","setlocale" "255","redhawksdr" "255","sqlite.swift" "255","qmenu" "255","stormpath" "255","pyttsx3" "255","event-driven-design" "255","strncpy" "255","hwioauthbundle" "255","activity-diagram" "255","string-search" "255","terraform-template-file" "255","getaddrinfo" "255","webots" "255","zfs" "255","predis" "255","pass-data" "254","tel" "254","deck.gl" "254","procedural-programming" "254","dde" "254","xelatex" "254","pairing" "254","console.writeline" "254","variable-expansion" "254","rotatetransform" "254","puppet-enterprise" "254","docpad" "254","negation" "254","entity-framework-6.1" "254","openfeign" "254","facebook-graph-api-v2.0" "254","ringcentral" "254","random-walk" "254","bundle-identifier" "254","nstimezone" "254","no-www" "254","plone-4.x" "254","vga" "254","plunker" "254","stochastic" "254","chapel" "254","menustrip" "254","ctime" "254","google-maps-flutter" "254","tracker" "254","completion" "254","ideavim" "254","torque" "254","flyout" "253","tree-shaking" "253","eclipse-gef" "253","dbgrid" "253","react-native-textinput" "253","socket.io-1.0" "253","xmp" "253","snapchat" "253","microsoft-band" "253","svn-externals" "253","bot-framework-composer" "253","sammy.js" "253","code-editor" "253","ubuntu-11.10" "253","android-binder" "253","f#-3.0" "253","opentsdb" "253","tabnavigator" "253","vespa" "253","poedit" "253","companion-object" "253","geometry-surface" "253","office-2010" "253","react-forms" "253","automapping" "253","gke-networking" "252","groovyshell" "252","backendless" "252","clause" "252","fitbit" "252","apiblueprint" "252","uiviewrepresentable" "252","nanohttpd" "252","dart-webui" "252","window-handles" "252","nativescript-plugin" "252","nco" "252","mongoexport" "252","mixed-mode" "252","magento-2.0" "252","type-punning" "252","r-faq" "252","opentype" "252","isapi-rewrite" "252","open-policy-agent" "252","sql-null" "252","sql-server-ce-4" "252","c1-cms" "252","strawberry-perl" "252","custom-events" "252","staticresource" "252","glusterfs" "252","multilinestring" "252","eml" "251","markov" "251","php-include" "251","barcode-printing" "251","laminas-api-tools" "251","mapbox-ios" "251","ng2-smart-table" "251","adaboost" "251","mantis" "251","simplification" "251","robospice" "251","data-entry" "251","jqgrid-formatter" "251","wso2-cep" "251","detours" "251","wso2-micro-integrator" "251","tuckey-urlrewrite-filter" "251","amazon-textract" "251","shortcut-file" "251","java-metro-framework" "251","vichuploaderbundle" "251","amd-gpu" "251","scatter3d" "251","tcpsocket" "251","scintilla" "251","splitter" "251","test-data" "251","propagation" "251","geom-point" "251","laravel-scout" "251","google-deployment-manager" "251","throws" "251","urlrequest" "251","archiva" "250","cloud-sql-proxy" "250","py4j" "250","google-trends" "250","faunadb" "250","windows-mixed-reality" "250","criteriaquery" "250","capacity" "250","cakephp-2.2" "250","aws-certificate-manager" "250","open-closed-principle" "250","dynamics-crm-webapi" "250","bootstrap-grid" "250","gulp-uglify" "250","blockui" "250","libclang" "250","forkjoinpool" "250","viewport-units" "250","virtual-destructor" "250","assetbundle" "250","spork" "250","beep" "250","sparklines" "250","zone" "250","sugarorm" "249","flask-mail" "249","keyboard-layout" "249","jitsi-meet" "249","wal" "249","winbugs" "249","single-instance" "249","calabash-android" "249","warden" "249","dataform" "249","jmeter-maven-plugin" "249","red" "249","hotswap" "249","spring-orm" "249","visualizer" "249","osx-server" "249","letters" "249","object-oriented-database" "249","regsvr32" "249","podcast" "249","openjdk-11" "249","devise-confirmable" "249","hashicorp" "249","radcombobox" "249","pointer-events" "249","rad-studio" "249","hive-metastore" "249","actionfilterattribute" "249","python-watchdog" "249","locked" "249","dailymotion-api" "249","amazon-elasticsearch" "249","scroller" "248","baseline" "248","cleardb" "248","webpage-screenshot" "248","editorfor" "248","django-cache" "248","blast" "248","sequelpro" "248","purely-functional" "248","cross-site" "248","svelte-store" "248","sigterm" "248","html4" "248","mod-pagespeed" "248","turbo" "248","spring-mongo" "248","nsimageview" "248","cowboy" "248","bootstrap-accordion" "248","lzma" "248","outlook-2016" "248","setwindowshookex" "248","kohana-orm" "248","xcode9-beta" "248","sproutcore" "248","tomahawk" "248","generate-series" "248","mpeg-4" "248","cfquery" "248","tomcat5.5" "248","odac" "248","mbunit" "248","conditional-comments" "248","beyondcompare" "247","sql-to-linq-conversion" "247","flex-mobile" "247","white-framework" "247","anonymous-inner-class" "247","greenrobot-eventbus" "247","gridlines" "247","pinax" "247","bitrate" "247","datastep" "247","ngx-charts" "247","cdo.message" "247","avplayerlayer" "247","ibm-blockchain" "247","docker-multi-stage-build" "247","ajp" "247","spring-mvc-test" "247","shrink" "247","visual-studio-setup-proje" "247","lego-mindstorms" "247","differentiation" "247","gwt-platform" "247","olingo" "247","custom-data-type" "247","google-cloud-kms" "247","hunspell" "247","party" "247","static-content" "247","compiler-options" "247","ignite-ui" "246","gitlab-ci.yml" "246","apache-commons-fileupload" "246","background-fetch" "246","telebot" "246","dead-code" "246","marmalade" "246","getview" "246","finite-element-analysis" "246","confluent-kafka-python" "246","python-cryptography" "246","django-2.1" "246","rrule" "246","mysql-5.5" "246","camunda-modeler" "246","react-suspense" "246","oracleclient" "246","kdevelop" "246","app-transport-security" "246","polymer-starter-kit" "246","inventory-management" "246","ion-auth" "246","mojo" "246","dynatree" "246","format-string" "246","google-artifact-registry" "246","foselasticabundle" "246","codeigniter-datamapper" "246","sigma.js" "246","pfobject" "246","asgi" "246","touchesmoved" "246","linq-to-twitter" "246","amazon-linux-2" "246","flutter-http" "246","usb-debugging" "245","cisco-ios" "245","vs-web-application-project" "245","phpoffice" "245","transport" "245","vuepress" "245","uitest" "245","flac" "245","chronicle" "245","cartesian" "245","binaryreader" "245","puppeteer-sharp" "245","bounded-wildcard" "245","hotlinking" "245","openedx" "245","openwhisk" "245","uipinchgesturerecognizer" "245","model-checking" "245","executenonquery" "245","non-deterministic" "245","contingency" "245","cursors" "245","q-lang" "245","omniauth-facebook" "245","metaplex" "245","argc" "245","emacs23" "245","spark-ar-studio" "245","sun" "245","ihttphandler" "245","maven-profiles" "244","php-5.2" "244","mutators" "244","clistctrl" "244","github-enterprise" "244","xmlslurper" "244","file-put-contents" "244","wasapi" "244","unity3d-unet" "244","google-workspace-add-ons" "244","upcasting" "244","guidewire" "244","dynamic-typing" "244","appx" "244","jqwidget" "244","fragment-identifier" "244","shadowing" "244","netstream" "244","codeigniter-routing" "244","t4mvc" "244","tabbedpage" "244","java-ee-5" "244","isodate" "244","sp-send-dbmail" "244","openzeppelin" "244","exchangelib" "244","openvswitch" "244","azure-vpn" "244","google-groups" "244","sorl-thumbnail" "243","mathnet-numerics" "243","intel-pin" "243","printing-web-page" "243","sitemesh" "243","flexigrid" "243","flow-router" "243","multiplexing" "243","lit-html" "243","integer-promotion" "243","socrata" "243","json-web-token" "243","python-ldap" "243","snapkit" "243","ng-bind-html" "243","childviewcontroller" "243","cross-origin-read-blocking" "243","reasoning" "243","vacuum" "243","postconstruct" "243","openbsd" "243","sbatch" "243","grunt-contrib-uglify" "243","mongo-go" "243","pbx" "243","interlocked" "243","nested-table" "243","appium-desktop" "243","google-ai-platform" "243","google-authenticator" "243","dojox.grid" "243","osc" "243","external-accessory" "243","brightway" "243","libpqxx" "243","jasmine-jquery" "243","6502" "243","analytic-functions" "243","pointer-to-pointer" "243","nlb" "243","nlp-question-answering" "243","nitrousio" "243","access-log" "243","access-specifier" "243","angular2-highcharts" "243","preferencefragment" "243","ilogger" "243","autoformatting" "243","automationanywhere" "243","encog" "242","jaydata" "242","antlrworks" "242","pgpool" "242","pacman" "242","select-string" "242","sniffer" "242","aws-glue-spark" "242","ajax.beginform" "242","ruby-datamapper" "242","android-support-design" "242","nsdecimalnumber" "242","satellite" "242","atlas" "242","code-push" "242","builder-pattern" "242","typescript-compiler-api" "242","retina" "242","raise" "242","sysfs" "242","68000" "242","libx264" "242","drupal-forms" "242","mixing" "242","hashchange" "242","text-manipulation" "242","spatialite" "242","glassfish-4.1" "242","sonarqube-ops" "242","predicatebuilder" "242","heading" "242","qtmultimedia" "241","stackblitz" "241","procfs" "241","vscode-code-runner" "241","apn" "241","unchecked" "241","dashing" "241","recycle-bin" "241","dms" "241","kibana-7" "241","vao" "241","cracking" "241","spring-boot-starter" "241","jquery-ui-selectable" "241","pooling" "241","howler.js" "241","application-restart" "241","twitter-bootstrap-tooltip" "241","juce" "241","lexicographic" "241","codeceptjs" "241","virtual-hosts" "241","netflix-ribbon" "241","reflector" "241","notificationcenter" "241","dev-to-production" "241","expo-router" "241","custom-exceptions" "241","geos" "241","ejb-2.x" "241","sonata-user-bundle" "241","zappa" "241","quantifiers" "240","eclipse-oxygen" "240","filamentphp" "240","print-preview" "240","transitive-dependency" "240","mapfragment" "240","malware-detection" "240","safearealayoutguide" "240","blank-line" "240","database-permissions" "240","unlock" "240","aws-policies" "240","false-positive" "240","single-spa" "240","grpc-web" "240","hash-collision" "240","gazebo-simu" "240","dryioc" "240","asp.net-core-viewcomponent" "240","restcomm" "240","command-substitution" "240","oembed" "240","httpservice" "240","zsh-completion" "240","project-organization" "240","hexagonal-tiles" "240","zeroclipboard" "240","qtsql" "240","hdp" "240","ti-basic" "239","fcntl" "239","phase" "239","producer" "239","dispatch-queue" "239","software-quality" "239","bins" "239","pinch" "239","chunked" "239","ruby-on-rails-6.1" "239","rowwise" "239","pycaret" "239","intro.js" "239","coremidi" "239","application-design" "239","android-selector" "239","jwplayer6" "239","wtl" "239","delve" "239","orchardcms-1.8" "239","google-books" "239","raylib" "239","double-precision" "239","tinymce-plugins" "239","non-nullable" "239","monoids" "239","promisekit" "239","logic-programming" "239","passkit" "239","alpha-vantage" "238","react-native-scrollview" "238","react-native-stylesheet" "238","material-design-in-xaml" "238","ecmascript-harmony" "238","construct" "238","xhtml2pdf" "238","ngoninit" "238","data-munging" "238","sentence-transformers" "238","rx-cocoa" "238","rx-kotlin" "238","django-media" "238","rebar" "238","cakephp-2.5" "238","craftcms" "238","payumoney" "238","bluestacks" "238","m4a" "238","device-admin" "238","exp" "238","xcode6.3" "238","eventaggregator" "238","event-propagation" "238","reactable" "238","propertyinfo" "238","loopj" "238","text-based" "238","log-likelihood" "237","flutter-appbar" "237","repeatingalarm" "237","inbox" "237","selenium2library" "237","method-signature" "237","crossrider" "237","facebox" "237","ndis" "237","jquery-click-event" "237","superglobals" "237","delta-live-tables" "237","victory-charts" "237","libphonenumber" "237","video-thumbnails" "237","jar-signing" "237","xcasset" "237","isinstance" "237","performselector" "237","geth" "237","argumentexception" "237","sublimerepl" "236","wicket-1.5" "236","slack-commands" "236","gremlinpython" "236","mailx" "236","incompatibletypeerror" "236","pandasql" "236","fileutils" "236","cropperjs" "236","animate-cc" "236","wikitude" "236","icomparer" "236","routed-events" "236","blockingcollection" "236","ionic-react" "236","invocationtargetexception" "236","hpa" "236","borland-c++" "236","navmesh" "236","onsaveinstancestate" "236","form-fields" "236","lftp" "236","rhodes" "236","broken-pipe" "236","right-join" "236","regasm" "236","non-clustered-index" "236","xbrl" "236","null-layout-manager" "236","gatsby-plugin" "236","android-chips" "236","react-devtools" "236","ios-app-group" "236","projection-matrix" "236","node-crypto" "236","sp-executesql" "236","sudoers" "236","quadratic-programming" "236","footable" "236","energy" "236","qstandarditemmodel" "236","google-identity-toolkit" "236","thread-priority" "236","pango" "236","alloy-ui" "235","xwpf" "235","apache-commons-logging" "235","react-redux-form" "235","apacheds" "235","json-normalize" "235","childwindow" "235","json-simple" "235","const-cast" "235","imessage-extension" "235","cbcentralmanager" "235","aws-cloudformation-custom-resource" "235","cakeyframeanimation" "235","rserve" "235","vector-database" "235","jpos" "235","input-mask" "235","horizontal-scaling" "235","mining" "235","winrt-async" "235","visual-studio-templates" "235","netflix-feign" "235","network-share" "235",".net-micro-framework" "235","koa2" "235","android-actionbaractivity" "235","azure-pipelines-tasks" "235","cookiecutter-django" "235","chartist.js" "235","pep" "235","genome" "235","cfnetwork" "235","parity" "235","usecallback" "234","ghost" "234","jekyll-extensions" "234","deeplink" "234","coap" "234","sizing" "234","my.cnf" "234","gravatar" "234","github-package-registry" "234","xliff" "234","flask-mongoengine" "234","sentence-similarity" "234","distribute" "234","python-socketio" "234","pushkit" "234","server-side-includes" "234","ready-api" "234","cronexpression" "234","animator" "234","ruby-1.9.2" "234","kibana-5" "234","document-database" "234","core-ui" "234","dynamics-ax-2012-r3" "234","jquery-steps" "234","asyncpg" "234","formattable" "234","ui-design" "234","exec-maven-plugin" "234","notificationmanager" "234","redis-py" "234","mplayer" "234","lsof" "234","chaquopy" "234","textedit" "234","http-streaming" "234","reqwest" "233","multipartentity" "233","phonegap-cli" "233","yo" "233","ef-model-first" "233","sqltransaction" "233","plasticscm" "233","vnc-server" "233","pic18" "233","catransform3d" "233","kendo-dataviz" "233","inetaddress" "233","keyword-search" "233","do.call" "233","post-redirect-get" "233","tweetsharp" "233","couchbase-sync-gateway" "233","grpc-node" "233","module-pattern" "233","jquery-mobile-listview" "233","android-app-signing" "233","word-2010" "233","libssh" "233","domaincontroller" "233","typeguards" "233","virtual-address-space" "233","lexikjwtauthbundle" "233","significance" "233","mkfifo" "233","nodetool" "233","downsampling" "233","azure-identity" "233","qdockwidget" "233","achievements" "233","speaker" "233","haskell-snap-framework" "233","custom-validators" "233","mechanize-python" "233","starttls" "233","sonarqube-web" "233","globalplatform" "233","gnome-shell-extensions" "233","spark-avro" "232","sta" "232","webservices-client" "232","reproducible-research" "232","sslstream" "232","web-storage" "232","teamcity-8.0" "232","vst" "232","prisma2" "232","phone-state-listener" "232","slowdown" "232","daxstudio" "232","jsreport" "232","hyperthreading" "232","fax" "232","jms-serializer" "232","alexa-slot" "232","wp-api" "232","android-wear-2.0" "232","detectron" "232","spring-data-solr" "232","revision-history" "232","android-8.1-oreo" "232","build-server" "232","xctestcase" "232","reentrantlock" "232","scala-option" "232","bun" "232","azure-sentinel" "232","bytearrayoutputstream" "232","qmessagebox" "232","restlet-2.0" "232","react-data-grid" "232","collectd" "232","nm" "232","android-screen" "232","string-view" "232","restrictions" "232","geometry-shader" "232","preorder" "232","google-location-services" "232","powershell-7.0" "232","shieldui" "232","tr1" "231","insomnia" "231","banking" "231","prng" "231","fluent-migrator" "231","sl4a" "231","ng-modules" "231","pageviews" "231","windows-rt" "231","docker-run" "231","windowing" "231","document-classification" "231","cprofile" "231","deneb" "231","kannel" "231","ionic6" "231","monaca" "231","woothemes" "231","libvlcsharp" "231","revenuecat" "231","codemagic" "231","minix" "231","libtorrent" "231","mipmaps" "231","codeship" "231","vis.js-network" "231","digital-logic" "231","tarfile" "231","core.async" "231","asp.net-identity-3" "231","generated-code" "231","activeandroid" "231","latin1" "231","ios8-today-widget" "231","touches" "231","glu" "231","sortablejs" "231","concurrent-programming" "231","section508" "231","ilnumerics" "230","cmder" "230","clearfix" "230","laravel-authorization" "230","rust-crates" "230","python-cffi" "230","jsgrid" "230","ico" "230","rolify" "230","windows-desktop-gadgets" "230","alasql" "230","wss4j" "230","cost-management" "230","ax" "230","determinants" "230","pebble-sdk" "230","magento2.2" "230","syntastic" "230","google-apps-script-api" "230","orleans" "230","google-cast-sdk" "230","typesafe-config" "230","azure-management-api" "230","uicollectionviewcompositionallayout" "230","openjfx" "230","directadmin" "230","directory-listing" "230","scikits" "230","xbox360" "230","maven-publish" "230","thor" "230","ifc" "230","usb-otg" "230","archetypes" "230","cvxopt" "230","linux-containers" "230","headless-cms" "230","mse" "229","pheatmap" "229","react-native-push-notification" "229","tensorflow2.x" "229","getuikit" "229","featuretools" "229","unification" "229","categorization" "229","pagerslidingtabstrip" "229","xml-libxml" "229","servicestack.redis" "229","rsocket" "229","ps1" "229","appinsights" "229","swift4.1" "229","jwk" "229","coredns" "229","application-lifecycle" "229","absolute-value" "229","google-assistant" "229","network-printers" "229","lwp-useragent" "229","hibernate-ogm" "229","die" "229","uipath-studio" "229","assembly-resolution" "229","directoryinfo" "229","comexception" "229","activesync" "229","ios6.1" "229","text-cursor" "229","google-material-icons" "229","sctp" "229","amazon-fire-tv" "229","binance-smart-chain" "229","maven-javadoc-plugin" "228","clgeocoder" "228","web-performance" "228","report-viewer2010" "228","soapheader" "228","apiconnect" "228","cellular-automata" "228","xlconnect" "228","binary-heap" "228","ccavenue" "228","appcode" "228","finalize" "228","discriminator" "228","avcapture" "228","optimistic-concurrency" "228","mysql5" "228","jpgraph" "228","vbe" "228","angular-routerlink" "228","dynamic-proxy" "228","bootstrap-tags-input" "228","errorlevel" "228","wso2-das" "228","foundry-code-repositories" "228","ko.observablearray" "228","magento-1.9.1" "228","nxp-microcontroller" "228","f#-fake" "228","android-4.3-jelly-bean" "228","devenv" "228","geopoints" "228","office-2013" "228","logstash-file" "227","dbset" "227","mx-record" "227","laravel-controller" "227","jsonata" "227","aesthetics" "227","fusion" "227","django-1.4" "227","cassini" "227","ng-build" "227","keystone" "227","django-rest-framework-jwt" "227","rsqlite" "227","windows-mobile-6" "227","nativescript-telerik-ui" "227","wso2-integration-studio" "227","brownie" "227","android-backup-service" "227","python-2.4" "227","rakefile" "227","cordova-plugin-fcm" "227","asp.net5" "227","redgate" "227","openoffice-writer" "227","game-theory" "227","android-internet" "227","lsf" "227","response-time" "227","commerce" "227","lightswitch-2013" "227","suffix-tree" "227","securestring" "227","maven-dependency" "227","image-caching" "227","max-flow" "227","endpoints" "227","git-squash" "227","qt5.5" "226","background-thread" "226","replaykit" "226","ssrs-expression" "226","dbconnection" "226","smil" "226","displayobject" "226","marklogic-10" "226","constructor-overloading" "226","constant-expression" "226","xerces-c" "226","metasploit" "226","realm-list" "226","uploader" "226","fbjs" "226","junction-table" "226","pdfa" "226","aws-sts" "226","kafkajs" "226","kodi" "226","sid" "226","riot.js" "226","timedelay" "226","x11-forwarding" "226","rabbitmqctl" "226","uistepper" "226","r5rs" "226","isr" "226","asp.net-roles" "226","azure-security" "226","pex" "226","certificate-authority" "226","testlink" "226","sourcetree" "226","flutter-inappwebview" "226","maven-war-plugin" "226","zend-server" "226","google-photos-api" "225","flickity" "225","treetable" "225","whatsapi" "225","ansible-role" "225","ggraph" "225","flat" "225","uitextviewdelegate" "225","python-gstreamer" "225","laravel-6.2" "225","unexpected-token" "225","chrome-devtools-protocol" "225","dashdb" "225","rpath" "225","django-wsgi" "225","micronaut-data" "225","canjs" "225","django-debug-toolbar" "225","nestjs-config" "225","onhover" "225","spring-boot-3" "225","oserror" "225","lexical" "225","orbit" "225","formatexception" "225","pygithub" "225","kmz" "225","nuget-spec" "225","null-check" "225","scrapy-pipeline" "225","refit" "225","tint" "225","xaringan" "225","assemble" "225","itextpdf" "225","tiptap" "225","httpbackend" "225","zpl-ii" "225","nicedit" "225","spl-autoload-register" "225","powerset" "225","scriptengine" "225","tiktok" "225","traminer" "224","basic4android" "224","git-gui" "224","clerk" "224","edx" "224","vue-directives" "224","ggrepel" "224","dateinterval" "224","apache-synapse" "224","fipy" "224","frequency-distribution" "224","metpy" "224","dockpanel" "224","win64" "224","jib" "224","django-deployment" "224","gradio" "224","nsevent" "224","svc" "224","rangy" "224","komodo" "224","shutdown-hook" "224","sql-agent" "224","gamma-distribution" "224","handlers" "224","pointcut" "224","uirepeat" "224","control-characters" "224","nszombie" "224","mesa" "224","odm" "224","urlloader" "224","parallel-foreach" "224","asdf" "224","mdiparent" "224","web-farm" "224","composable" "223","apache-commons-beanutils" "223","clangd" "223","firebase-extensions" "223","adbannerview" "223","capturing-group" "223","purge" "223","watchservice" "223","unity-ui" "223","database-metadata" "223","boost-fusion" "223","onload-event" "223","kamailio" "223","couchapp" "223","inverted-index" "223","google-analytics-sdk" "223","java-21" "223","seurat" "223","luarocks" "223",".net-core-2.2" "223","fp-ts" "223","mixture-model" "223","normalizr" "223","regression-testing" "223","dot-emacs" "223","xbmc" "223","asp.net-core-routing" "223","taskscheduler" "223","excel-web-addins" "223","gaussianblur" "223","laravel-request" "223","textscan" "223","propertychanged" "223","string-to-datetime" "223","android-kernel" "223","metamodel" "223","spim" "223","zend-validate" "223","mt4" "223","gnucobol" "223","trace32" "223","alpakka" "222","transmission" "222","graphlab" "222","contentpresenter" "222","package-lock.json" "222","uivisualeffectview" "222","ccxt" "222","cartesian-coordinates" "222","djoser" "222","joomla-k2" "222","ruby-2.1" "222","css-in-js" "222","sharepoint-2016" "222","aws-userpools" "222","invariants" "222","knights-tour" "222","new-window" "222","8-bit" "222","tdengine" "222","nsundomanager" "222","sql-in" "222","istringstream" "222","sqlmodel" "222","sql-server-2008r2-express" "222","asp.net-core-mvc-2.0" "222","mouseup" "222","terracotta" "222","office365-restapi" "222","laravel-spark" "222","moqui" "222","lateral-join" "222","protected-mode" "222","memory-corruption" "222","thread-dump" "222","parsefloat" "222","subtype" "222","fmi" "222","enhanced-ecommerce" "222","qualifiers" "222","bellman-ford" "222","email-ext" "221","cobalt" "221","slam" "221","dbvisualizer" "221","graphiql" "221","uitableviewsectionheader" "221","firebird-3.0" "221","chatroom" "221","sharepoint-rest-api" "221","rms" "221","aws-databricks" "221","simpleitk" "221","optional-arguments" "221","informatica-cloud" "221","ioredis" "221","der" "221","env" "221","google-api-ruby-client" "221","object-slicing" "221","orientdb2.2" "221","to-char" "221","table-relationships" "221","dropout" "221","exceptionhandler" "221","moc" "221","mpns" "221","metafor" "221","react-class-based-component" "221","currentlocation" "221","lossless-compression" "221","string-substitution" "221","stormcrawler" "221","pfuser" "221","ip-geolocation" "221","ios8.3" "221","ifft" "221","automatic-properties" "221","static-site-generation" "220","react-player" "220","apachebench" "220","file-manipulation" "220","react-native-fs" "220","webspeech-api" "220","cbperipheral" "220","chrome-web-driver" "220","rsacryptoserviceprovider" "220","call-graph" "220","css-calc" "220","native-ads" "220","android-viewgroup" "220","erpnext" "220","spring-resttemplate" "220","raspberry-pi-zero" "220","rhel8" "220","contextual-action-bar" "220","xamdatagrid" "220","polylang" "220","azure-logic-app-standard" "220","non-english" "220","open-telemetry-collector" "220","tableviewer" "220","sqlite3-ruby" "220","dtmf" "220","elfinder" "220","qpython" "220","angular-formbuilder" "220","react-boilerplate" "220","angular4-httpclient" "220","git-post-receive" "220","zombie.js" "220","alv" "220","toplink" "219","ecma" "219","deferred-execution" "219","localserver" "219","youtube-channels" "219","mat-file" "219","intel-edison" "219","vstack" "219","github-for-mac" "219","immer.js" "219","selectall" "219","keypad" "219","data-files" "219","android-vision" "219","jquery-cycle2" "219","jvmti" "219","gtktreeview" "219","mikro-orm" "219","oauth2client" "219","orocommerce" "219","kruskals-algorithm" "219","viber" "219","java-annotations" "219","cadence-workflow" "219","copy-on-write" "219","hidden-files" "219","dropdownbutton" "219","referer" "219","istio-sidecar" "219","diagrammer" "219","spdy" "219","morse-code" "219","layer-list" "219","trailing" "219","yslow" "219","qtreewidgetitem" "219","uti" "219","seam2" "218","graphhopper" "218","classnotfound" "218","adventureworks" "218","ftp-server" "218","selenium-extent-report" "218","mapserver" "218","ag-grid-ng2" "218","valueconverter" "218","database-security" "218","docker-for-mac" "218","mylyn" "218","grafana-alerts" "218","appwrite" "218","grunt-usemin" "218","inputstreamreader" "218","nsstatusitem" "218","hoverintent" "218","macruby" "218","libspotify" "218","rcpparmadillo" "218","pyo3" "218","m4" "218","outbound" "218","android-bottomsheetdialog" "218","cookie-httponly" "218","android-hardware" "218","execve" "218","asp.net-dynamic-data" "218","tarantool" "218","control-m" "218","periodic-task" "218","getimagedata" "218","tess4j" "218","google-gemini" "218","lower-bound" "218","qmediaplayer" "218","foreach-loop-container" "218","berkshelf" "218","secure-coding" "218","spark-view-engine" "218","scrollbars" "218","ifconfig" "217","installshield-le" "217","matplotlib-widget" "217","jboss-tools" "217","clover" "217","sqlx" "217","selectinput" "217","fisheye" "217","bitcoind" "217","s3fs" "217","kubernetes-networkpolicy" "217","mapnik" "217","xml-sitemap" "217","datacolumn" "217","fat32" "217","service-fabric-stateful" "217","opshub" "217","singlepage" "217","csla" "217","oracle-jet" "217","capacitor-plugin" "217","django-errors" "217","error-correction" "217","android-webservice" "217","twitter-api-v2" "217","azure-caching" "217","interrupted-exception" "217","influxql" "217","scalafx" "217","design-by-contract" "217","jquery-tooltip" "217","ucma" "217","android.mk" "217","coda" "217","lg" "217","javascript-intellisense" "217","isenabled" "217","devise-invitable" "217","plots.jl" "217","android-holo-everywhere" "217","reentrancy" "217","http-verbs" "217","httplib2" "217","elastic-ip" "217","activejdbc" "217","lora" "217","sdl-ttf" "217","fluttermap" "217","securitymanager" "217","gitversion" "217","best-in-place" "217","zbar-sdk" "216","llvm-gcc" "216","yolov4" "216","stackview" "216","ts-loader" "216","yii-url-manager" "216","jaxp" "216","ng-hide" "216","flannel" "216","adorner" "216","swisscomdev" "216","man-in-the-middle" "216","biztalk-2016" "216","dispatchertimer" "216","rowsum" "216","pusher-js" "216","real-time-clock" "216","gpt-2" "216","recursive-descent" "216","waterfall" "216","updatemodel" "216","servicestack-text" "216","watson-discovery" "216","cpprest-sdk" "216","inter-process-communicat" "216","patchwork" "216","raw" "216","wix3.11" "216","miktex" "216","android-augmented-reality" "216","android-automotive" "216","build-definition" "216","libusb-1.0" "216","ocsp" "216","node-serialport" "216","timetable" "216","asteriskami" "216","azureml-python-sdk" "216","tinyxml" "216","hmisc" "216","contextpath" "216","channel-api" "216","strimzi" "216","exact-match" "216","proxies" "216","powershell-module" "216","mscorlib" "216","state-pattern" "216","hawtio" "216","haxeflixel" "216","parametric-polymorphism" "215","background-size" "215","sspi" "215","maven-antrun-plugin" "215","installscript" "215","symbolicatecrash" "215","sendto" "215","kubernetes-health-check" "215","cics" "215","sensormanager" "215","owner" "215","rpostgresql" "215","vcl-styles" "215","jira-xray" "215","denial-of-service" "215","inputaccessoryview" "215","nspopover" "215","http-1.1" "215","spring-security-rest" "215","cover" "215","rapids" "215","typo3-11.x" "215","virtual-dom" "215","object-initializers" "215","hls.js" "215","gwidgets" "215","izpack" "215","mobile-chrome" "215","tintcolor" "215","homekit" "215","angular-ivy" "215","logfiles" "215","odt" "215","alibaba-cloud" "215","mspec" "214","bapi" "214","dbms-scheduler" "214","vue-router4" "214","ssid" "214","jspx" "214","datastax-enterprise-graph" "214","unboundid-ldap-sdk" "214","xml-twig" "214","data-loss" "214","rowid" "214","unsubscribe" "214","joomla-template" "214","vagrant-provision" "214","realm-migration" "214","fb-hydra" "214","receipt-validation" "214","wadl" "214","alasset" "214","windowsformshost" "214","react-table-v7" "214","jts" "214","net.tcp" "214","gulp-concat" "214","svn-hooks" "214","macos-sonoma" "214","android-biometric-prompt" "214","dqn" "214","openshift-3" "214","register-transfer-level" "214","eventsource" "214","last-insert-id" "214","google-gadget" "214","angular-dynamic-components" "214","ogr" "214","flutter-textformfield" "214","qtnetwork" "214","particles.js" "214","ava" "213","probability-theory" "213","phpstan" "213","intel-oneapi" "213","trusted-web-activity" "213","sleep-mode" "213","live555" "213","affix" "213","datawindow" "213","bitrise" "213","binomial-coefficients" "213","cats-effect" "213","s#arp-architecture" "213","laravel-4.2" "213","facebook-sdk-4.x" "213","crossdomain.xml" "213","ptvs" "213","servercontrols" "213","single-threaded" "213","blueprint-css" "213","eofexception" "213","dynamic-routing" "213","html-content-extraction" "213","htmlunit-driver" "213","frappe" "213","rdoc" "213","luhn" "213","null-terminated" "213","tag-cloud" "213","spyne" "213","sqlpackage" "213","resource-leak" "213","qgridlayout" "213","oledbdataadapter" "213","google-cloud-python" "213","msw" "213","stm" "213","ifttt" "213","media-library" "213","web-bluetooth" "213","tftp" "213","git-tfs" "212","truthtable" "212","react-native-gifted-chat" "212","yandex" "212","apollo-federation" "212","nfc-p2p" "212","phrase" "212","rjs" "212","jmstemplate" "212","css-frameworks" "212","share-extension" "212","rnotebook" "212","win32ole" "212","groupwise-maximum" "212","negative-lookbehind" "212","spring-form" "212","apple-watch-complication" "212","orocrm" "212","visual-studio-2008-sp1" "212",".env" "212","microsoft-graph-files" "212","rich-snippets" "212","directoryentry" "212","numpy-ufunc" "212","gcp-ai-platform-notebook" "212","mod-alias" "212","asset-catalog" "212","devicetoken" "212","aspectj-maven-plugin" "212","dotcover" "212","angular2-ngmodel" "212","csv-import" "212","activity-indicator" "212","requestdispatcher" "212","states" "212","multer-s3" "212","webcam-capture" "212","sourcegenerators" "212","quarkus-rest-client" "212","baud-rate" "212","embedded-tomcat-8" "211","trial" "211","grav" "211","webusb" "211","client-go" "211","file-browser" "211","ll-grammar" "211","philips-hue" "211","gradle-dependencies" "211","hyperledger-sawtooth" "211","django-postgresql" "211","servant" "211","singlechildscrollview" "211","dl4j" "211","couchdb-futon" "211","kafka-topic" "211","spring-cloud-config-server" "211","android-textwatcher" "211","mongoid3" "211","jquery-jscrollpane" "211","influxdb-python" "211","jquery-gmap3" "211","developer-console" "211","orchardcms-1.7" "211","atlassian-plugin-sdk" "211","net-ssh" "211","drawrectangle" "211","redistributable" "211","dig" "211","nstoolbar" "211","tns" "211","asprepeater" "211","node.js-typeorm" "211","android-maven-plugin" "211","generated" "211","collapsable" "211","ogre3d" "211","par" "211","automatic-differentiation" "211","sts" "211","componentone" "211","qsqltablemodel" "211","iis-5" "211","gnu-coreutils" "211","qtablewidgetitem" "210","jco" "210","deconvolution" "210","class-transformer" "210","remote-control" "210","multiple-file-upload" "210","selendroid" "210","jsviews" "210","agi" "210","mybb" "210","mysqlimport" "210","kedro" "210","onmousedown" "210","html-parser" "210","sanic" "210","dynatrace" "210","pci-dss" "210","twilio-studio" "210","craco" "210","blobstorage" "210","code-folding" "210","knative" "210","highdpi" "210","dotfiles" "210","uicollectionviewflowlayout" "210","asp.net-core-8" "210","jakarta-migration" "210","elementwise-operations" "210","google-console-developer" "210","cgfloat" "210","maximo-anywhere" "210","autoregressive-models" "210","utilities" "210","ticket-system" "210","panning" "210","liferay-ide" "209","printer-control-language" "209","clientid" "209","jca" "209","graphml" "209","stacked-area-chart" "209","contain" "209","datamember" "209","xdp-bpf" "209","optuna" "209","vcf-variant-call-format" "209","angular-mock" "209","vast" "209","angularjs-ng-transclude" "209","airprint" "209","nskeyedunarchiver" "209","erlang-supervisor" "209","saved-searches" "209","type-theory" "209","anchor-solana" "209","amfphp" "209","google-apps-script-editor" "209","code-structure" "209","abbreviation" "209","janus" "209","form-authentication" "209","jacob" "209","business-logic-layer" "209","loose-coupling" "209","ninject-2" "209","moya" "209","rescue" "209","loess" "209","spiral" "209","lcs" "209","webfaction" "209","dapr" "209","identification" "209","archiving" "209","thunderbird-addon" "209","maven-site-plugin" "209","beta-testing" "209","autocorrect" "209","stencil-buffer" "209","autocommit" "208","floyd-warshall" "208","prims-algorithm" "208","jfoenix" "208","ggally" "208","multiple-users" "208","phpredis" "208","jdbcrealm" "208","listpicker" "208","ebcdic" "208","django-aggregation" "208","futuretask" "208","meteor-react" "208","sip-server" "208","namenode" "208","rebol3" "208","windows-identity" "208","html-sanitizing" "208","opencart2.3" "208","android-vibration" "208","sam" "208","mongodb-update" "208","azure-alerts" "208","visual-studio-macros" "208","build-script" "208","javascript-injection" "208","mobile-webkit" "208","playsound" "208","android-elevation" "208","drupal-commerce" "208","bytestring" "208","google-cloud-iot" "208","chars" "208","spotify-app" "208","meld" "208","qabstracttablemodel" "208","commandlink" "208","commoncrypto" "208","node-mssql" "208","protobuf-c" "208","trackbar" "208","start-job" "208","struts-tags" "208","limesurvey" "208","flutter-streambuilder" "208","zimbra" "208","bigcartel" "208","transclusion" "208","flutter-windows" "208","use-case-diagram" "207","jexcelapi" "207","tsqlt" "207","debian-jessie" "207","grib" "207","gitk" "207","js-amd" "207","django-1.6" "207","api-manager" "207","selenium4" "207","kube-dns" "207","verifyerror" "207","metricbeat" "207","calabash-ios" "207","aws-iot-core" "207","angular-ui-typeahead" "207","facebook-webhooks" "207","spring-boot-gradle-plugin" "207","nsopenpanel" "207","twilio-functions" "207","world-of-warcraft" "207","couchbase-view" "207","sustainsys-saml2" "207","video-conferencing" "207","extended-ascii" "207","facebook-app-requests" "207","rdata" "207","ranorex" "207","setattr" "207","visual-glitch" "207","wordpress-hook" "207","assemblyinfo" "207","open-json" "207","regexp-like" "207","dotfuscator" "207","redirecttoaction" "207","buttongroup" "207","tag-it" "207","irq" "207","ekeventstore" "207","geometryreader" "207","columnstore" "207","ace" "207","okd" "207","excel-2019" "207","comobject" "207","image-comparison" "207","securesocial" "207","sourceforge" "207","searchable" "206","vtigercrm" "206","ssms-2014" "206","widechar" "206","ssas-2008" "206","apache-commons-math" "206","matlab-app-designer" "206","slave" "206","apify" "206","imblearn" "206","labeling" "206","choicefield" "206","symbol-table" "206","chdir" "206","watchos-3" "206","card.io" "206","crontrigger" "206","reconnect" "206","unordered" "206","sign-in-with-apple" "206","jxls" "206","scala-2.11" "206","twig-extension" "206","post-commit" "206","susy" "206","brainfuck" "206","android-x86" "206","kmdf" "206","set-difference" "206","go-fiber" "206","java-http-client" "206","buildconfiguration" "206","todataurl" "206","uialertaction" "206","xcode9.2" "206","asp.net-boilerplate" "206","tkinter-text" "206","mobx-state-tree" "206","project-planning" "206","accurev" "206","ninject-extensions" "206","generic-type-argument" "206","moto" "206","mpfr" "206","webmethods" "206","alloc" "206","parameter-pack" "206","utf8-decode" "206","linkedin-jsapi" "205","graphql-codegen" "205","pg-search" "205","flower" "205","git-bare" "205","vtl" "205","rel" "205","configurable-product" "205","data-masking" "205","firebase-performance" "205","manage.py" "205","jtableheader" "205","python-hypothesis" "205","python-ggplot" "205","camel-ftp" "205","database-optimization" "205","jpeg2000" "205","pdf-form" "205","opendj" "205","ncbi" "205","bootstrap-tabs" "205","tui" "205","application-cache" "205","wt" "205","sap-gateway" "205","mailjet" "205","kramdown" "205","audioqueue" "205","revel" "205","levelplot" "205","lyx" "205","outsystems" "205","pyhook" "205","order-of-execution" "205","mobilenet" "205","gunzip" "205","cordova-ios" "205","uiblureffect" "205","lasagne" "205","accounts" "205","lua-api" "205","httpbuilder" "205","google-cloud-dataprep" "205","trait-objects" "205","autocorrelation" "205","allennlp" "205","prepare" "205","git-status" "204","removeeventlistener" "204","liveserver" "204","squish" "204","mvel" "204","listdir" "204","live-templates" "204","mxmlc" "204","xrm" "204","unicode-normalization" "204","jsonconvert" "204","binary-operators" "204","app.xaml" "204","address-bar" "204","rjdbc" "204","key-events" "204","ruby-1.8.7" "204","pubmed" "204","dynamicform" "204","androidviewclient" "204","sap-dotnet-connector" "204","networkonmainthread" "204","dollar-sign" "204","dokuwiki" "204","3nf" "204","build-dependencies" "204","tabcontainer" "204","gcdasyncsocket" "204","dragula" "204","text-search" "204","node.js-stream" "204","linear-equation" "204","linked-tables" "204","sublimelinter" "203","ef-core-7.0" "203","wijmo" "203","staggered-gridview" "203","jersey-1.0" "203","multiuserchat" "203","django-comments" "203","datapump" "203","disparity-mapping" "203","fsevents" "203","celltable" "203","freetype2" "203","avrdude" "203","jqgrid-php" "203","io-monad" "203","supercsv" "203","android-togglebutton" "203","android-switch" "203","jython-2.7" "203","onmousemove" "203","ranking-functions" "203","orgchart" "203","android-actionmode" "203","ezpublish" "203","facebook-chat" "203","sql-query-store" "203","opentbs" "203","uikit-dynamics" "203","vhd" "203","hardware-interface" "203","expo-av" "203","itemizedoverlay" "203","nomad" "203","android-inapp-purchase" "203","google-cloud-endpoints-v2" "203","oidc-client-js" "203","commandbinding" "203","merging-data" "203","qtcharts" "203","bevy" "202","background-music" "202","fibers" "202","umbraco6" "202","jshell" "202","cds" "202","angular-nvd3" "202","wakeup" "202","servicenow-rest-api" "202","readprocessmemory" "202","rpn" "202","cpu-speed" "202","ioncube" "202","azure-ad-b2b" "202","payflowpro" "202","spring-framework-beans" "202","information-theory" "202","pydot" "202","raw-data" "202","side-menu" "202","code-composer" "202","game-maker-studio-2" "202","custom-object" "202","google-cloud-print" "202","cfhttp" "202","activity-recognition" "202","elgg" "202","laravel-pagination" "202","qsortfilterproxymodel" "202","maven-tomcat-plugin" "202","google-speech-to-text-api" "202","zend-auth" "202","parallel-testing" "202","heightmap" "202","forcats" "202","gitosis" "202","panorama-control" "201","ddp" "201","multiple-definition-error" "201","main-activity" "201","bit.ly" "201","ng-map" "201","flash-cc" "201","disjoint-sets" "201","pandas.excelwriter" "201","adwhirl" "201","cross-domain-policy" "201","falconframework" "201","pst" "201","mfc-feature-pack" "201","mysql-cluster" "201","rna-seq" "201","rrd" "201","spring-cloud-aws" "201","wp-admin" "201","lync-2013" "201","shadow-mapping" "201","vimdiff" "201","siemens" "201","dolphindb" "201","polkadot" "201","hibernate-tools" "201","azure-servicebus-subscriptions" "201","azure-postgresql" "201","policies" "201","bytea" "201","executioncontext" "201","httpx" "201","strikethrough" "201","request.querystring" "201","special-folders" "201","custom-url" "201","ijulia-notebook" "201","email-address" "201","compiler-theory" "201","zend-navigation" "201","prefect" "201","powerdesigner" "201","msal-angular" "200","github-cli" "200","ansible-vault" "200","profiles" "200","localdatetime" "200","youcompleteme" "200","api-versioning" "200","symfony-routing" "200","python-camelot" "200","language-interoperability" "200","jtag" "200","kubernetes-apiserver" "200","mysql-slow-query-log" "200","wavesurfer.js" "200","wchar" "200","pyc" "200","canonicalization" "200","operations-research" "200","growl" "200","nestjs-typeorm" "200","twitter-bootstrap-rails" "200","guacamole" "200","inline-code" "200","facebook-group" "200","visual-c++-2008" "200","browsermob-proxy" "200","rakudo" "200","mage" "200","fparsec" "200","hgignore" "200","ods" "200","lean" "200","text-segmentation" "200","duende-identity-server" "200","color-mapping" "200","geohashing" "200","reactcsstransitiongroup" "200","dart2js" "200","auto-py-to-exe" "200","computer-forensics" "200","transaction-log" "200","glreadpixels" "200","querystringparameter" "200","preferencescreen" "199","jess" "199","phpspec" "199","maskedinput" "199","material3" "199","gettype" "199","yard" "199","base-conversion" "199","fflush" "199","phpcs" "199","multiple-axes" "199","cloudwatch-alarms" "199","squeryl" "199","xll" "199","python-imageio" "199","meteor-collection2" "199","dmd" "199","docker-api" "199","katex" "199","coupling" "199","invite" "199","twisted.web" "199","wql" "199","inversifyjs" "199","scala-breeze" "199","asynctaskloader" "199","javafx-3d" "199","forwarding-reference" "199","amplifyjs" "199","javaparser" "199","shinywidgets" "199","netmiko" "199","iverilog" "199","garrys-mod" "199","sqlmembershipprovider" "199","aslr" "199","uint64" "199","scorm2004" "199","dsym" "199","context.xml" "199","getpixel" "199","android-savedstate" "199","getimagesize" "199","lauterbach" "199","qaf" "199","custom-error-handling" "199","git-workflow" "199","tiles2" "199","identify" "199","identity-experience-framework" "198","bacon.js" "198","maui-windows" "198","loaddata" "198","treepanel" "198","flowbite" "198","whatsapp-cloud-api" "198","jflex" "198","phphotolibrary" "198","flutter-change-notifier" "198","import.io" "198","json-path-expression" "198","biztalk-mapper" "198","switchmap" "198","umd" "198","servletcontextlistener" "198","angular-moment" "198","sequence-points" "198","factor-analysis" "198","mfmessagecomposeviewcontroller" "198","hyphenation" "198","recorder" "198","onunload" "198","sap-web-ide" "198","sbt-plugin" "198","nestedrecyclerview" "198","spring-social-facebook" "198","google-assist-api" "198","minifilter" "198","ubuntu-13.10" "198","google-chat" "198","go-cd" "198","pyperclip" "198","nuxt-auth" "198","android-contextmenu" "198","angular-cdk-drag-drop" "198","custom-routes" "198","ios8-extension" "198","android-loader" "198","curl-multi" "198","mouse-position" "198","compose-recomposition" "198","gnustep" "198","hbm2ddl" "198","bcd" "198","solution-explorer" "198","gmm" "198","mediawiki-templates" "198","linq2db" "198","stdoptional" "198","urlparse" "198","usrp" "197","sklabelnode" "197","ssms-17" "197","multiview" "197","mathematica-8" "197","trust" "197","declarative-services" "197","product-quantity" "197","file-search" "197","dired" "197","symfony-3.1" "197","cartalyst-sentry" "197","pubspec" "197","jnienv" "197","varchar2" "197","hot-module-replacement" "197","twilio-video" "197","bnd" "197","postdata" "197","jasmine2.0" "197","codeplex" "197","rational-team-concert" "197","cognos-11" "197","java-stored-procedures" "197","ufw" "197","rethinkdb-javascript" "197","360-degrees" "197","iscroll4" "197","dingo-api" "197","devexpress-mvc" "197","chainer" "197","du" "197","node-cron" "197","centos6.5" "197","getselection" "197","angularjs-digest" "197","bigbluebutton" "197","mdxjs" "197","ilog" "197","dart-editor" "197","auto-ptr" "196","git-for-windows" "196","jdatechooser" "196","slcomposeviewcontroller" "196","gridsplitter" "196","getvalue" "196","installation-package" "196","mutation-testing" "196","remove-if" "196","smart-tv" "196","json-patch" "196","image-scanner" "196","rust-sqlx" "196","django-compressor" "196","kinvey" "196","win2d" "196","create-react-native-app" "196","kendo-ui-grid" "196","onpaint" "196","jquery-post" "196","android-touch-event" "196","easygui" "196","blockly" "196","extrapolation" "196","lvm" "196","networkextension" "196","astyanax" "196","objectdisposedexception" "196","shopify-api-node" "196","rdma" "196","java-14" "196","retention" "196","drupal-fapi" "196","plotnine" "196","gallio" "196","timefold" "196","ui-select2" "196","testrail" "196","elapsedtime" "196","geonames" "196","compose-multiplatform" "196","ash" "196","artisan-migrate" "196","dart-io" "196","alternate" "196","alwayson" "195","marklogic-dhf" "195","base-class-library" "195","ssrs-2014" "195","clos" "195","cloudera-quickstart-vm" "195","slick-2.0" "195","vuedraggable" "195","stage3d" "195","flutter-cupertino" "195","page-fault" "195","jsplitpane" "195","mantine" "195","dockerpy" "195","watchman" "195","watson-studio" "195","avqueueplayer" "195","caliburn" "195","crf" "195","pruning" "195","android-typeface" "195","native-web-component" "195","braces" "195","border-radius" "195","swiftlint" "195","wp-cli" "195","inf" "195","nedb" "195","enyo" "195","code-complexity" "195","obsolete" "195","mix-blend-mode" "195","orika" "195","gwt-gin" "195","regional-settings" "195","isql" "195","hardlink" "195","elasticsearch-py" "195","android-mediaprojection" "195","ipdb" "195","qos" "195","ms-access-forms" "195","zeroconf" "195","batching" "195","gjs" "195","gnome-3" "195","mbstring" "194","cmsis" "194","cmakelists-options" "194","backoffice" "194","intellij-15" "194","yaws" "194","ssh-keygen" "194","ng-switch" "194","sobel" "194","image-thresholding" "194","xlookup" "194","appauth" "194","find-replace" "194","imagenet" "194","callable-statement" "194","databricks-connect" "194","datagridviewcomboboxcell" "194","recompose" "194","icon-fonts" "194","capture-group" "194","input-type-file" "194","apple-music" "194","pathos" "194","nscoder" "194","invalid-characters" "194","android-scroll" "194","create-directory" "194","setcontentview" "194","pyshark" "194","magic-numbers" "194","android-doze" "194","xc8" "194","longest-substring" "194","spigot" "194","z80" "194","binaries" "194","arcobjects" "194","arrayfire" "194","bcc" "194","zend-mail" "194","part-of-speech" "194","zfcuser" "193","temporal-tables" "193","eclipse-rap" "193","regularized" "193","jenkins-blueocean" "193","apache-commons-io" "193","yamldotnet" "193","filechannel" "193","apache-hudi" "193","liquid-layout" "193","sshpass" "193","cider" "193","kvc" "193","vmware-player" "193","server.xml" "193","validationrules" "193","mysql-connect" "193","recompile" "193","docutils" "193","roundcube" "193","aws-organizations" "193","validationerror" "193","method-resolution-order" "193","puts" "193","hortonworks-sandbox" "193","equalizer" "193","jvm-bytecode" "193","spring-ioc" "193","jquery-inputmask" "193","supabase-js" "193","librdkafka" "193","sigkill" "193","pyscripter" "193","system.in" "193","ancestry" "193","knowledge-graph" "193","expression-evaluation" "193","todo" "193","sql-server-2005-express" "193","xamarin.essentials" "193","northwind" "193","opensl" "193","hydration" "193","ios-animations" "193","ipython-parallel" "193","textnode" "193","sonata-media-bundle" "193","qtconcurrent" "193","zodb" "193","zend-search-lucene" "193","mechanize-ruby" "193","themoviedb-api" "193","compose-desktop" "192","yarnpkg-v2" "192","jenssegers-mongodb" "192","livecycle-designer" "192","appdynamics" "192","apache-tez" "192","waitress" "192","dlsym" "192","docker-entrypoint" "192","kendo-combobox" "192","jfr" "192","watson-iot" "192","jitter" "192","ruby-hash" "192","fat" "192","appwidgetprovider" "192","apr" "192","satellite-image" "192","pass-through" "192","android-shape" "192","derived-table" "192","boost-hana" "192","superuser" "192","equations" "192","envelope" "192","dojox.charting" "192","midl" "192","wmp" "192","uint" "192","itemtouchhelper" "192","xcode10.1" "192","npm-run" "192","redirectstandardoutput" "192","azure-python-sdk" "192","ios-keyboard-extension" "192","resource-cleanup" "192","react-hot-loader" "192","laravel-websockets" "192","pentaho-report-designer" "192","multi-device-hybrid-apps" "192","alu" "192","sonarscanner" "192","biml" "192","url-parsing" "192","webjars" "192","google-mobile-ads" "192","scripting-bridge" "191","yosys" "191","unet-neural-network" "191","django-1.10" "191","casablanca" "191","rtweet" "191","wildfly-swarm" "191","simulated-annealing" "191","was" "191","wakanda" "191","iomanip" "191","visa" "191","javascriptmvc" "191","rdfa" "191","refluxjs" "191","isnumeric" "191","xap" "191","associativity" "191","lpc" "191","google-cloud-tpu" "191","angular-file-upload" "191","qmap" "191","mtp" "191","quart" "191","google-tasks-api" "191","muenchian-grouping" "191","hexagonal-architecture" "191","totp" "191","zenity" "190","vtd-xml" "190","procedural" "190","trinidad" "190","get-wmiobject" "190","vocabulary" "190","kubernetes-dashboard" "190","aws-parameter-store" "190","windows-defender" "190","docker-stack" "190","pushdown-automaton" "190","iaas" "190","ingress-controller" "190","twitch-api" "190","libs" "190","coil" "190","asp.net-authentication" "190","uicollectionreusableview" "190","nuitka" "190","non-greedy" "190","home-directory" "190","asp.net-core-localization" "190","qbfc" "190","activitygroup" "190","glow" "190","amazon-appstore" "190","bidi" "190","maven-resources-plugin" "190","asana-api" "190","steamworks-api" "190","script#" "190","tfx" "189","trix" "189","jcache" "189","gitea" "189","class-members" "189","matrix-factorization" "189","symfony-2.2" "189","xml-layout" "189","include-guards" "189","xpc" "189","circle-pack" "189","cargo" "189","sharepoint-apps" "189","w3wp" "189","grafana-templating" "189","avd-manager" "189","airflow-webserver" "189","rufus-scheduler" "189","sink" "189","core-video" "189","dynamic-class-loaders" "189","entity-framework-ctp5" "189","save-image" "189","worker-thread" "189","openfoam" "189","aws-sdk-java-2.0" "189","twilio-programmable-voice" "189","pyppeteer" "189","winlogon" "189","lzw" "189","fragmentation" "189","observedobject" "189","scaletransform" "189","business-catalyst" "189","dexguard" "189","tapi" "189","drjava" "189","drizzle" "189","android-configchanges" "189","gameplay-kit" "189","xcode-server" "189","r6" "189","http-status-code-429" "189","android-runonuithread" "189","getopt-long" "189","ipad-2" "189","test-runner" "189","zephyr-rtos" "189","avalonedit" "189","alphabetical-sort" "188","react-redux-firebase" "188","primeng-turbotable" "188","filelock" "188","intel-vtune" "188","livesearch" "188","in-app-update" "188","xeon-phi" "188","bixbystudio" "188","mapactivity" "188","kendo-datepicker" "188","django-fixtures" "188","aws-elb" "188","data-dictionary" "188","datacontractjsonserializer" "188","django-manage.py" "188","payu" "188","derived-types" "188","pathname" "188","invocation" "188","oozie-workflow" "188","outlook-calendar" "188","bspline" "188","sieve-algorithm" "188","java-server" "188","build-agent" "188","milo" "188","ob-start" "188","amcharts5" "188","mini-css-extract-plugin" "188","magento2.4" "188","face" "188","rhel5" "188","referrals" "188","quotations" "188","execute-immediate" "188","openstack-neutron" "188","scd" "188","changelistener" "188","huge-pages" "188","pyttsx" "188","httppostedfilebase" "188","getscript" "188","elasticsearch-mapping" "188","stateless-session-bean" "188","embedded-fonts" "188","emplace" "187","tron" "187","matlab-engine" "187","apache-cordova" "187","litedb" "187","caroufredsel" "187","carplay" "187","union-find" "187","chicken-scheme" "187","adk" "187","adventure" "187","kingfisher" "187","sitecore8.1" "187","warbler" "187","unity-networking" "187","puphpet" "187","angular-standalone-components" "187","angular-providers" "187","vugen" "187","angularjs-module" "187","jibx" "187","easynetq" "187","enum-class" "187","on-the-fly" "187","epplus-4" "187","authenticode" "187","formclosing" "187","minidump" "187","rft" "187","vips" "187","abstract-methods" "187","drf-yasg" "187","mixer" "187","gcp-load-balancer" "187","acpi" "187","terraform-modules" "187","mercurial-hook" "187","google-developer-tools" "187","looper" "187","logstash-jdbc" "187","android-paging-library" "187","angular2-pipe" "187","sealed" "187","pre-build-event" "187","tooltipster" "187","som" "187","hazelcast-jet" "187","state-space" "186","intercom" "186","gridsome" "186","graphframes" "186","file-attributes" "186","int32" "186","gio" "186","jenkins-api" "186","template-classes" "186","panda3d" "186","cheat-engine" "186","vote" "186","ng-controller" "186","apache-modules" "186","swipeview" "186","appfog" "186","binary-compatibility" "186","cedet" "186","unwrap" "186","metatable" "186","vendor-prefix" "186","ibm-mobile-services" "186","dependabot" "186","boosting" "186","infiniband" "186","mongodb-csharp-2.0" "186","detachedcriteria" "186","mailitem" "186","uberjar" "186","formio" "186","min-heap" "186","wkt" "186","otto" "186","network-security" "186","dokan" "186","android-14" "186","np-hard" "186","nuke" "186","tasklist" "186","spritebatch" "186","mobaxterm" "186","handwriting-recognition" "186","polybase" "186","dsa" "186","iphone-web-app" "186","progressive-enhancement" "186","promtail" "186","http-status-code-304" "186","qfilesystemmodel" "186","evil-mode" "186","qglwidget" "186","parseexception" "186","submatrix" "185","slowcheetah" "185","try-finally" "185","cleartimeout" "185","apache-jena" "185","apache-kafka-mirrormaker" "185","xhtml-1.0-strict" "185","ownerdrawn" "185","seh" "185","distcp" "185","distributed-database" "185","xml-configuration" "185","content-negotiation" "185","first-order-logic" "185","narrowing" "185","simple-form-for" "185","pushpin" "185","optional-chaining" "185","unreachable-code" "185","public-method" "185","dynamic-reports" "185","delphi-prism" "185","tws" "185","port-scanning" "185","netweaver" "185","system-verilog-assertions" "185","ubuntu-10.10" "185","kombu" "185","signed-apk" "185","mailcore2" "185","vertx-verticle" "185","didreceivememorywarning" "185","uimanageddocument" "185","openshift-enterprise" "185","azure-synapse-analytics" "185","c#-10.0" "185","execv" "185","android-diffutils" "185","gcc4" "185","xcode4.4" "185","aspose.pdf" "185","mention" "185","node-async" "185","ehcache-3" "185","google-cloud-ml-engine" "185","custom-authentication" "185","google-reader" "185","parse-tree" "185","maven-deploy-plugin" "185","dart-js-interop" "185","scsi" "185","qsettings" "185","qtkit" "185","usernotifications" "185","bbc-microbit" "184","staleelementreferenceexception" "184","master-theorem" "184","gitbook" "184","tstringgrid" "184","datastax-startup" "184","db2-zos" "184","unique-id" "184","nexus-5" "184","malformed" "184","xmlunit" "184","iasyncenumerable" "184","validationattribute" "184","journal" "184","serverless-architecture" "184","data-driven" "184","documentviewer" "184","keypoint" "184","windows-1252" "184","create-view" "184","pdfview" "184","android-studio-3.1" "184","twisted.internet" "184","inline-functions" "184","typecasting-operator" "184","hstack" "184","oauth-1.0a" "184","set-theory" "184","rapidxml" "184","domcrawler" "184","pyrebase" "184","kriging" "184","openscad" "184","spservices" "184","mockserver" "184","qvariant" "184","scichart" "184","android-mediasession" "184","qregexp" "184","combinators" "184","pyvmomi" "184","monk" "184","changestream" "184","iperf" "184","fody" "184","alljoyn" "184","web-inf" "184","tramp" "184","std-filesystem" "184","bde" "184","user-stories" "184","sunos" "184","iformfile" "183","release-mode" "183","jekyll-theme" "183","webvtt" "183","webrat" "183","react-native-testing-library" "183","instance-methods" "183","templatefield" "183","clojure.spec" "183","python-descriptors" "183","ng-bind" "183","smote" "183","packagemaker" "183","page-numbering" "183","ngrx-entity" "183","biztalk-2013r2" "183","swrl" "183","biztalk-2009" "183","joomla-component" "183","dat.gui" "183","oracle-fusion-middleware" "183","kendo-multiselect" "183","oracle-ebs" "183","kind" "183","tukey" "183","gtkmm3" "183","formcollection" "183","google-chrome-storage" "183","java-compiler-api" "183","rickshaw" "183","word-boundary" "183","attask" "183","pymel" "183","android-dark-theme" "183","spymemcached" "183","bytestream" "183","spoon" "183","etherscan" "183","project.json" "183","active-form" "183","census" "183","predictionio" "182","prismic.io" "182","class-attributes" "182","relative-import" "182","rep" "182","srt" "182","phonon" "182","swiftui-scrollview" "182","pinning" "182","v-select" "182","datapager" "182","python-sounddevice" "182","findelement" "182","django-timezone" "182","row-height" "182","server-configuration" "182","docusigncompositetmplts" "182","angular-schematics" "182","gradle-eclipse" "182","aio" "182","android-sliding" "182","pdf-parsing" "182","sbjson" "182","sim900" "182","postfix-operator" "182","libreoffice-base" "182","kong-plugin" "182","video-conversion" "182","pyproj" "182","bucklescript" "182","setjmp" "182","orbital-mechanics" "182","rippledrawable" "182","hole-punching" "182","x3d" "182","uimanager" "182","dtls" "182","homebrew-cask" "182","difftime" "182","chartboost" "182","access-point" "182","eventstoredb" "182","pessimistic-locking" "182","lost-focus" "182","spine.js" "182","oid" "182","oculusquest" "182","geocoder" "182","transcription" "182","thunk" "182","sulu" "181","smallrye" "181","client-side-scripting" "181","mathematical-morphology" "181","jbox2d" "181","page-factory" "181","pic32" "181","jspinclude" "181","python-2to3" "181","chord-diagram" "181","datetimeformatter" "181","jgraphx" "181","mysql-num-rows" "181","psobject" "181","ruby-c-extension" "181","mysql-error-1045" "181","aggregates" "181","windows-security" "181","turkish" "181","apportable" "181","nsapplication" "181","android-sdk-2.1" "181","power-automate-desktop" "181","winhttprequest" "181","exuberant-ctags" "181","pymunk" "181","ocl" "181","library-project" "181","wireframe" "181","magick++" "181","rhapsody" "181","redux-reducers" "181","openseadragon" "181","jackson-modules" "181","scenegraph" "181","android-internal-storage" "181","context-free-language" "181","scalding" "181","byref" "181","asp.net-mvc-validation" "181","assembly-binding-redirect" "181","r.net" "181","log4cxx" "181","mounted-volumes" "181","most-vexing-parse" "181","lr-grammar" "181","qbasic" "181","ninja-forms" "181","lowpass-filter" "181","seaside" "181","automation-testing" "181","glx" "181","subviews" "181","linq-to-dataset" "181","array-unique" "181","webpack-3" "181","mediainfo" "181","linux-capabilities" "181","zendesk-api" "181","subtyping" "181","stata-macros" "180","effective-java" "180","ssas-2012" "180","jelly" "180","phonegap-desktop-app" "180","slack-block-kit" "180","technical-indicator" "180","firebase-app-distribution" "180","selenium-edgedriver" "180","data-representation" "180","unix-ar" "180","watershed" "180","fact" "180","varnish-4" "180","icloud-drive" "180","anki" "180","meteor-up" "180","postdelayed" "180","blpapi" "180","bounded-contexts" "180","worklight-security" "180","extjs7" "180","significant-digits" "180","minecraft-fabric" "180","system.net.httpwebrequest" "180","acceleration" "180","home-assistant" "180","pocketpc" "180","tms" "180","mkpolyline" "180","uidocumentpickerviewcontroller" "180","galaxy-tab" "180","gyp" "180","scrapinghub" "180","ios9.3" "180","duplication" "180","tomcat10" "180","streamsets" "180","dagster" "180","maven-jar-plugin" "180","zelle-graphics" "180","hclust" "180","paradox" "180","thonny" "179","multi-window" "179","jes" "179","xsd-1.1" "179","tekton" "179","jdb" "179","grouplayout" "179","tray" "179","tstringlist" "179","bitbucket-cloud" "179","cons" "179","incognito-mode" "179","fivem" "179","snapcraft" "179","voting-system" "179","dirent.h" "179","django-admin-filters" "179","marginal-effects" "179","vcr" "179","simplecv" "179","service-fabric-stateless" "179","angular-local-storage" "179","dynamic-pivot" "179","apprequests" "179","dynamic-dispatch" "179","passport-google-oauth" "179","apple-musickit" "179","jquery-slider" "179","revealing-module-pattern" "179","return-value-optimization" "179",".net-core-2.1" "179","sys-refcursor" "179","bstr" "179","luasocket" "179","xbox-one" "179","azure-speech" "179","tabulate" "179","sqldatetime" "179","asp.net-mvc-controller" "179","azure-iot-central" "179","double-click-advertising" "179","non-relational-database" "179","uint32" "179","bundles" "179","nul" "179","retaincount" "179","geom-col" "179","text-decorations" "179","evm" "179","tethering" "179","dup" "179","spelling" "179","mongorepository" "179","generic-method" "179","solr-query-syntax" "179","d3-force-directed" "179","arch" "178","defaultlistmodel" "178","loadimage" "178","backcolor" "178","fido" "178","basecamp" "178","reactphp" "178","ghostdriver" "178","bad-gateway" "178","jsonschema2pojo" "178","binary-serialization" "178","smooks" "178","appcmd" "178","lalr" "178","chronicle-queue" "178","selectlistitem" "178","doctrine-extensions" "178","ibm-was" "178","windows-embedded-compact" "178","ibm-cloud-functions" "178","kendo-ui-mvc" "178","unused-variables" "178","vcalendar" "178","wagtail-streamfield" "178","pscustomobject" "178","bootstrapvalidator" "178","nspopupbutton" "178","azure-cloud-shell" "178","spring-config" "178","svnadmin" "178","spring-portlet-mvc" "178","app-startup" "178","openapi-generator-maven-plugin" "178","side-by-side" "178","left-recursion" "178","visnetwork" "178","objective-c-2.0" "178","wkwebviewconfiguration" "178","object-pooling" "178","auth-guard" "178","buildx" "178","domainservices" "178","typo3-6.1.x" "178","scrapy-shell" "178","playwright-typescript" "178","doublebuffered" "178","mmc" "178","c++builder-6" "178","angular-aot" "178","react-grid-layout" "178","android-ion" "178","mplfinance" "178","mpmath" "178","laravel-testing" "178","source-code-protection" "178","webi" "178","argmax" "178","vaadin23" "178","glmmtmb" "178","image-editing" "178","scss-lint" "178","mbedtls" "178","hdr" "178","fontforge" "178","tiling" "178","dac" "178","pgm" "177","jboss-4.2.x" "177","vuefire" "177","dedicated-server" "177","clrs" "177","printdialog" "177","volatility" "177","mariadb-10.3" "177","apartment-gem" "177","sharepointdocumentlibrary" "177","icheck" "177","mfi" "177","ibm-sbt" "177","alamofireimage" "177","html.beginform" "177","ponyorm" "177","application.cfc" "177","jqxhr" "177","jaxb2-maven-plugin" "177","synchronizationcontext" "177","vmware-fusion" "177","bresenham" "177","review-board" "177","lz4" "177","openx" "177","android-mediascanner" "177","http-status-code-406" "177","char-pointer" "177","oledbdatareader" "177","mongoskin" "177","luabind" "177","pyvisa" "177","headless-ui" "177","media-type" "177","struts1" "177","becomefirstresponder" "177","web-config-transform" "176","relaxng" "176","lnk2001" "176","debian-stretch" "176","privacy-policy" "176","interception" "176","connexion" "176","firefox4" "176","unique-values" "176","discourse" "176","select-query" "176","unistd.h" "176","freepbx" "176","semantic-release" "176","putchar" "176","pvlib" "176","vxml" "176","aggregate-initialization" "176","kendo-mvvm" "176","graphael" "176","grails-3.1" "176","wikidata-query-service" "176","css-content" "176","psychtoolbox" "176","wallet-connect" "176","fading" "176","upi" "176","rootscope" "176","mysql-event" "176","bootsfaces" "176","coturn" "176","nestjs-swagger" "176","crawler4j" "176","scalac" "176","write.table" "176","core-web-vitals" "176","tvml" "176","javax" "176","microsoft-r" "176","sgx" "176","javascript-engine" "176","shinymodules" "176","microsoft-teams-js" "176","4gl" "176","rego" "176","uicomponents" "176","npm-link" "176","plot-annotations" "176","har" "176","elastic-apm" "176","custom-model-binder" "176","strtol" "176","test-explorer" "176","cudf" "176","stringification" "176","android-runtime" "176","sorteddictionary" "176","textwrangler" "176","hcatalog" "176","shift-reduce-conflict" "176","endeca" "176","mbtiles" "176","subgrid" "175","wic" "175","vue-script-setup" "175","react-native-sectionlist" "175","jedi" "175","intel-ipp" "175","location-href" "175","photolibrary" "175","printstream" "175","pitest" "175","symfony3" "175","django-ckeditor" "175","disruptor-pattern" "175","variable-variables" "175","databound" "175","face-id" "175","neo4j.rb" "175","dyalog" "175","dynamic-jasper" "175","grub" "175","grunt-contrib-concat" "175","population" "175","atexit" "175","360-virtual-reality" "175","freeimage" "175","building-github-actions" "175","ktor-client" "175",".when" "175","lerp" "175","h.265" "175","iwebbrowser2" "175","nuxt-i18n" "175","tail-call-optimization" "175","hacklang" "175","azure-monitor" "175","reactjs.net" "175","react-google-charts" "175","qcheckbox" "175","nifti" "175","members" "175","mpmediapickercontroller" "175","subtree" "175","encodeuricomponent" "175","tfs-power-tools" "175","toupper" "175","lilypond" "175","ms-query" "175","auto-renewing" "175","amazon-polly" "175","stereoscopy" "175","batch-updates" "174","featherlight.js" "174","yahoo-mail" "174","yasm" "174","pretty-urls" "174","weebly" "174","clap" "174","react-native-listview" "174","procmail" "174","pandas-apply" "174","pid-controller" "174","symmetric" "174","umbraco8" "174","imagettftext" "174","cartodb" "174","symfony-cmf" "174","snowflake-connector" "174","image-preloader" "174","ibm-api-management" "174","metronic" "174","pugixml" "174","ptx" "174","microsoft-distributed-file-system" "174","jpype" "174","sharethis" "174","android-securityexception" "174","jwe" "174","equals-operator" "174","azure-deployment-slots" "174","surfaceholder" "174","wpallimport" "174","surveyjs" "174","cocoa-design-patterns" "174","network-monitoring" "174","netbeans6.8" "174","brave" "174","word-2007" "174","pyqgis" "174","system.web" "174","dopostback" "174","rexx" "174","sysctl" "174","time-t" "174","dih" "174","draw.io" "174","qvector" "174","handles" "174","plpython" "174","asp.net-optimization" "174","operand" "174","redcap" "174","ejabberd-module" "174","node-cluster" "174","launchmode" "174","fogbugz" "174","solr6" "174","mtu" "174","array-intersect" "174","tilde" "174","ieee" "174","partial-page-refresh" "173","eclipse-che" "173","web-reference" "173","liquibase-hibernate" "173","flow-control" "173","bitwise-xor" "173","filereference" "173","picture-in-picture" "173","safaridriver" "173","laravel-facade" "173","swig-template" "173","self-tracking-entities" "173","mhtml" "173","recurly" "173","uptime" "173","nrf52" "173","application-shutdown" "173","jwilder-nginx-proxy" "173","posthoc" "173","dynamic-html" "173","botkit" "173","couchbase-java-api" "173","pygal" "173","ocean" "173","audioqueueservices" "173","extent" "173","dotnetnuke-5" "173","taurus" "173","targeting" "173","tankauth" "173","reflow" "173","wysihtml5" "173","expo-go" "173","spotbugs" "173","cubit" "173","nio2" "173","topmost" "173","multilevel-analysis" "173","emeditor" "173","mediamuxer" "173","if-constexpr" "173","daisyui" "172","render.com" "172","ssms-16" "172","mastercard" "172","jax-rpc" "172","backup-strategies" "172","sqoop2" "172","bank" "172","data-pipeline" "172","fyne" "172","social-framework" "172","django-context" "172","adafruit-circuitpython" "172","appcelerator-studio" "172","xmla" "172","fitnesse-slim" "172","next-i18next" "172","oxygenxml" "172","adminhtml" "172","windowlistener" "172","dllregistration" "172","databricks-unity-catalog" "172","cs193p" "172","universe" "172","database-first" "172","camera-roll" "172","routed-commands" "172","blue-green-deployment" "172","errordocument" "172","dynamicobject" "172","onscrolllistener" "172","pydoc" "172","typhoon" "172","typescript1.5" "172","sys.path" "172","asynchronous-javascript" "172","auctex" "172","plotmath" "172","table-variable" "172","james" "172","tabletools" "172","tanstack" "172","devforce" "172","asp.net-controls" "172","testng.xml" "172","ldap3" "172","ollama" "172","performanceanalytics" "172","qcustomplot" "172","textmatebundles" "172","mp4parser" "172","tomcat8.5" "172","amazon-cloudwatch-metrics" "172","lines-of-code" "172","dangling-pointer" "172","particle-swarm" "172","parameter-expansion" "172","zipoutputstream" "172","suitetalk" "172","utl-file" "172","helm3" "172","tosca" "171","phpactiverecord" "171","livewires" "171","anythingslider" "171","sliding-tile-puzzle" "171","debuggervisualizer" "171","federated-learning" "171","bash-trap" "171","flash-builder4.5" "171","dispatchevent" "171","saaj" "171","jsxgraph" "171","python-rq" "171","xfa" "171","uitableviewrowaction" "171","binarywriter" "171","imagesharp" "171","fuzzyjoin" "171","google-voice" "171","serviceloader" "171","rtools" "171","ora-00904" "171","kie-workbench" "171","windows-app-sdk" "171","oracle-pro-c" "171","away3d" "171","angularjs-ng-show" "171","pcntl" "171","modelsummary" "171","fotorama" "171","newsstand-kit" "171","absolutelayout" "171","4g" "171","systemtime" "171","plivo" "171","dotcloud" "171","chained" "171","electronic-signature" "171","httpclientfactory" "171","ldif" "171","react-forwardref" "171","angular-event-emitter" "171","using-declaration" "171","maya-api" "171","userprincipal" "171","qt5.4" "171","struts-config" "171","script-component" "170","webxr" "170","xwiki" "170","reinstall" "170","wgs84" "170","listings" "170","incremental-build" "170","finagle" "170","sahi" "170","fileparsing" "170","page-curl" "170","package-name" "170","impdp" "170","semantic-mediawiki" "170","ng-messages" "170","chr" "170","safari-web-inspector" "170","selenium-grid2" "170","distance-matrix" "170","implicits" "170","datebox" "170","vaex" "170","mysqli-multi-query" "170","document-library" "170","mgtwitterengine" "170","workday-api" "170","suppress" "170","karma-webpack" "170","wso2-bam" "170","wow64" "170","type-declaration" "170","pyro" "170","magit" "170","authlib" "170","wordpress-featured-image" "170","formik-material-ui" "170","google-chrome-arc" "170","vitamio" "170","braintree-sandbox" "170",".net-core-rc2" "170","devexpress-wpf" "170","hibernate-spatial" "170","hivemq" "170","uidevice" "170","c++-faq" "170","regions" "170","handlebarshelper" "170","radians" "170","pervasive-sql" "170","cubic-spline" "170","member-variables" "170","httpresponsemessage" "170","mount-point" "170","ipython-magic" "170","string.h" "170","batch-insert" "170","linearlayoutmanager" "170","transactionmanager" "170","encoder-decoder" "170","bfg-repo-cleaner" "169","answer-set-programming" "169","eclipse-emf-ecore" "169","primeng-dropdowns" "169","ssrs-2017" "169","default-method" "169","repair" "169","flutter-build" "169","backpressure" "169","pipelining" "169","directsound" "169","mariadb-10.4" "169","dbd" "169","ng-pattern" "169","api-ai" "169","flask-session" "169","js-scrollintoview" "169","cascade-classifier" "169","v-data-table" "169","family-tree" "169","keras-tuner" "169","angular-ui-select" "169","grafana-api" "169","equivalence" "169","nss" "169","boost-build" "169","horizontallist" "169","enum-flags" "169","hotdeploy" "169","spring-properties" "169","libtooling" "169","system.net.webexception" "169","magicmock" "169","sideloading" "169","wiredtiger" "169","bsxfun" "169","kiwi-tcms" "169","brotli" "169","ransac" "169","visual-recognition" "169","code-signing-entitlements" "169","luau" "169","node-telegram-bot-api" "169","hippocms" "169","android-googleapiclient" "169","mpmediaquery" "169","long-double" "169","csvreader" "169","resignfirstresponder" "169","odata-v4" "169","loop-unrolling" "169","nnet" "169","preferredsize" "169","iequatable" "169","amazon-elastic-transcoder" "169","dart-mirrors" "169","stm32f7" "169","liipimaginebundle" "169","lightgallery" "169","qt4.7" "168","fetchall" "168","bag" "168","stack-pointer" "168","multiple-value" "168","ecdf" "168","city" "168","function-object" "168","jsonexception" "168","function-handle" "168","sensu" "168","distributed-cache" "168","bitblt" "168","ice" "168","grails-2.3" "168","role-base-authorization" "168","html-pdf" "168","dwg" "168","hresult" "168","in-house-distribution" "168","codekit" "168","for-xml" "168","libsndfile" "168","cocos3d" "168","vlan" "168","network-connection" "168","signaturepad" "168","android-connectivitymanager" "168","dialect" "168","highslide" "168","rad-controls" "168","direct3d9" "168","mersenne-twister" "168","octokit" "168","custom-domain" "168","geosphere" "168","resin" "168","resthighlevelclient" "168","channelfactory" "168","thrift-protocol" "168","webmock" "168","lightning" "168","user-defined-literals" "168","preconditions" "168","sonarqube-4.5" "168","mddialog" "167","markup-extensions" "167","remote-validation" "167","load-time-weaving" "167","flowable" "167","vue-material" "167","php-java-bridge" "167","flink-batch" "167","ssm" "167","principal" "167","ssml" "167","gigya" "167","fusedlocationproviderclient" "167","kubernetes-operator" "167","contao" "167","unhandled" "167","volttron" "167","rust-axum" "167","const-iterator" "167","confluent-kafka-dotnet" "167","pandas-profiling" "167","jsonmodel" "167","fscalendar" "167","aws-mobilehub" "167","ruby-2.3" "167","vector-tiles" "167","alchemyapi" "167","crystal-reports-8.5" "167","aws-powershell" "167","docusignconnect" "167","mfmailcomposer" "167","axwindowsmediaplayer" "167","portable-applications" "167","module-info" "167","htmltidy" "167","countdownlatch" "167","derived-column" "167","gulp-sourcemaps" "167","external-process" "167","object-model" "167","newlib" "167","oc4j" "167","pygsheets" "167","netmq" "167","google-analytics-filters" "167","showcaseview" "167","gooddata" "167","sysinternals" "167","drupal-themes" "167","gamma" "167","double-buffering" "167","bulkloader" "167","isnullorempty" "167","tofixed" "167","x-cart" "167","laravel-relations" "167","angular-e2e" "167","splat" "167","nintex-workflow" "167","ctf" "167","conda-build" "167","msal-react" "167","image-formats" "167","sony-xperia" "167","bbpress" "167","ms-wopi" "167","argb" "167","ember-cli-mirage" "167","mdc-components" "167","aliases" "167","automata-theory" "167","ietf-netmod-yang" "167","std-variant" "167","stm32f1" "166","deap" "166","skeleton-css-boilerplate" "166","multiscreen" "166","ff" "166","jsfl" "166","vqmod" "166","apiary.io" "166","indexpath" "166","mapped-drive" "166","cassandra-cli" "166","adyen" "166","session-scope" "166","dmarc" "166","windows-api-code-pack" "166","cancel-button" "166","jhipster-registry" "166","indirection" "166","postgresql-15" "166","http4s" "166","opencascade" "166","boost-preprocessor" "166","deploying" "166","jquery-on" "166","silverlight-oob" "166","jquery-pagination" "166","2checkout" "166",".app" "166","ancestor" "166","wmv" "166","typescript3.0" "166","extractor" "166","fqdn" "166","async-ctp" "166","mobiscroll" "166","jain-sip" "166","asp.net-mvc-views" "166","continuation-passing" "166","quicklisp" "166","highlight.js" "166","uint8array" "166","ekeventkit" "166","action-button" "166","stringdist" "166","lcm" "166","ios9.1" "166","cubes" "166","dummy-data" "166","columnheader" "166","lazyvgrid" "166","throwable" "166","stdasync" "166","likert" "166","solr5" "166","hbm" "166","traitsui" "166","sts-securitytokenservice" "166","google-optimize" "166","armv6" "166","usps" "165","flutter-alertdialog" "165","jcreator" "165","trunk" "165","gii" "165","react-native-vector-icons" "165","sizzle" "165","phppgadmin" "165","llblgenpro" "165","phishing" "165","sycl" "165","directx-10" "165","catch2" "165","apache-spark-standalone" "165","symfony-2.4" "165","api-doc" "165","simpletest" "165","wikidata-api" "165","update-attributes" "165","gplots" "165","puredata" "165","two-way" "165","jquery-blockui" "165","cpuid" "165","mongodb-stitch" "165","pyjnius" "165","mach" "165","wix4" "165","minimongo" "165","attr-accessor" "165",".net-4.6.2" "165","nsurlconnectiondelegate" "165","mkpinannotationview" "165","game-center-leaderboard" "165","openvms" "165","tinybutstrong" "165","android-looper" "165","google-cloud-cdn" "165","chaincode" "165","string-interning" "165","pyvista" "165","startupscript" "165","autocompleteextender" "165","argumentnullexception" "165","email-bounces" "165","structural-equation-model" "164","widevine" "164","react-native-tabnavigator" "164","groovy-console" "164","temporal-workflow" "164","jdom-2" "164","mat-select" "164","clipboarddata" "164","instant" "164","yahoo-weather-api" "164","php-password-hash" "164","cloneable" "164","banno-digital-toolkit" "164","fdt" "164","uniform-distribution" "164","sendgrid-templates" "164","xdotool" "164","configurable" "164","fuelux" "164","pjsua2" "164","saiku" "164","consolidation" "164","django-jsonfield" "164","dashcode" "164","crx" "164","fastercsv" "164","jmap" "164","c-api" "164","interpretation" "164","azure-app-registration" "164","spring-cloud-gcp" "164","azure-cli2" "164","wso2-governance-registry" "164","word-web-addins" "164","invoke-sqlcmd" "164","intershop" "164","android-wallpaper" "164",".d.ts" "164","video-codecs" "164","broccolijs" "164","system.data" "164","non-standard-evaluation" "164","reformatting" "164","aspnet-compiler" "164","asp.net-core-hosted-services" "164","tchar" "164","npm-build" "164","sql-drop" "164","devextreme-angular" "164","gdlib" "164","mod-deflate" "164","xcode-bots" "164","pmap" "164","toctree" "164","property-binding" "164","react-custom-hooks" "164","elki" "164","project-reference" "164","static-block" "164","sparqlwrapper" "164","spark-jobserver" "164","subproject" "164","tibco-business-works" "164","zipinputstream" "164","qsqldatabase" "163","flipview" "163","background-foreground" "163","clingo" "163","ecslidingviewcontroller" "163","teensy" "163","temenos-quantum" "163","yii2-user" "163","cloudhub" "163","file-comparison" "163","filelist" "163","catiledlayer" "163","python-interactive" "163","symfony-2.6" "163","datejs" "163","freezed" "163","file-pointer" "163","flann" "163","conflicting-libraries" "163","laminas" "163","select-case" "163","datalog" "163","cannon.js" "163","shareactionprovider" "163","createobject" "163","joomla1.6" "163","vbox" "163","service-principal" "163","angular-material-7" "163","grapesjs" "163","capifony" "163","kendo-window" "163","unsigned-long-long-int" "163","svnignore" "163","path-dependent-type" "163","dynamic-url" "163","powerapps-modeldriven" "163","boost-iostreams" "163","neighbours" "163","aquamacs" "163","pomelo-entityframeworkcore-mysql" "163","dynamic-feature-module" "163","winreg" "163","browser-feature-detection" "163","ocamlbuild" "163","libcrypto" "163","fpc" "163","woocommerce-bookings" "163","cadvisor" "163","drupal-blocks" "163","drop-duplicates" "163","redux-framework" "163","poi-hssf" "163","drools-fusion" "163","ets" "163","qapplication" "163","httpexception" "163","actiontext" "163","react-18" "163","reach-router" "163","geomesa" "163","sdl-image" "163","webhttpbinding" "163","bbedit" "163","torchtext" "163","cxfrs" "163","mediadevices" "163","compiled" "163","time-and-attendance" "163","usdz" "163","parameterization" "162","gridfs-stream" "162","flutter-design" "162","stack-smash" "162","react-native-image" "162","defineproperty" "162","apache-echarts" "162","music21" "162","closed-captions" "162","great-expectations" "162","slate.js" "162","phpquery" "162","unauthorizedaccessexcepti" "162","paintevent" "162","free-monad" "162","fs2" "162","servicehost" "162","verbose" "162","wavelet-transform" "162","window.opener" "162","w2ui" "162","react-test-renderer" "162","cortex-a" "162","bonecp" "162","sap-business-technology-platform" "162","jquery-draggable" "162","dynamic-rdlc-generation" "162","error-messaging" "162","jquery-traversing" "162","hpricot" "162","inversion" "162","rampart" "162","rfe" "162","tabbed" "162","reverse-dns" "162","r-haven" "162","libwebsockets" "162","asp.net-mvc-3-areas" "162","wxmaxima" "162","gcsfuse" "162","dotnetbrowser" "162","controlvalueaccessor" "162","uiscenedelegate" "162","targets" "162","export-csv" "162","android-jetpack-datastore" "162","testbed" "162","collate" "162","genetic" "162","hud" "162","resize-image" "162","ether" "162","react-native-code-push" "162","office-store" "162","exact-online" "162","ifnull" "162","webjob" "162","footnotes" "161","local-files" "161","flatpak" "161","sybase-asa" "161","catransition" "161","pagedown" "161","castor" "161","ng-upgrade" "161","make.com" "161","connection-reset" "161","run-configuration" "161","ng-dialog" "161","dita-ot" "161","oracle-golden-gate" "161","angular-module-federation" "161","oracle-aq" "161","data-lake" "161","wagtail-admin" "161","jmc" "161","fb.ui" "161","gradle-task" "161","pybluez" "161","docker-buildkit" "161","blogengine.net" "161","dynpro" "161","nspasteboard" "161","boost-function" "161","erl" "161","dendextend" "161","payment-method" "161","jupyter-irkernel" "161","do-notation" "161","word-automation" "161","syntaxhighlighter" "161","lxml.html" "161","exslt" "161","opensocial" "161","c++-amp" "161","hive-serde" "161","azure-yaml-pipelines" "161","tinytex" "161","xcrun" "161","hashable" "161","peek" "161","cfwheels" "161","hvplot" "161","elastic4s" "161","irrlicht" "161","project-server" "161","eventargs" "161","elasticsearch-jest" "161","autonumber" "161","scriptblock" "160","trpc" "160","apache-commons-vfs" "160","apache-httpclient-5.x" "160","local-network" "160","phoenix-live-view" "160","musl" "160","github-graphql" "160","ln" "160","literate-programming" "160","confluent-cloud" "160","socialshare" "160","findby" "160","jsonobjectrequest" "160","fingerprinting" "160","soda" "160","aviary" "160","ready" "160","ibm-cloud-private" "160","simplewebrtc" "160","epsilon" "160","mod-perl2" "160","type-assertion" "160","boost-phoenix" "160","bootcompleted" "160","sample-rate" "160","pdf-scraping" "160","neovim-plugin" "160","attiny" "160","build-pipeline" "160","typed-racket" "160","libssl" "160","object-destructuring" "160","audacity" "160","caffeine-cache" "160","mlcp" "160","tally" "160","mkmapviewdelegate" "160","http-status-code-502" "160","iplimage" "160","personalization" "160","stride" "160","custom-functions-excel" "160","hessian" "160","multi-agent" "160","ember-qunit" "160","conditional-breakpoint" "160","pgi" "160","hbox" "160","arcgis-runtime" "160","multicastsocket" "160","touchstart" "160","sony-camera-api" "159","proc-open" "159","stability" "159","flurry-analytics" "159","gridstack" "159","x-www-form-urlencoded" "159","grid-system" "159","triangular" "159","xuggle" "159","feof" "159","xquery-3.0" "159","python-attrs" "159","python-babel" "159","select-into" "159","ngen" "159","frustum" "159","find-in-set" "159","python-chess" "159","ryu" "159","recordrtc" "159","angular-signals" "159","database-tuning" "159","robust" "159","sequencefile" "159","css-counter" "159","microsoft-fabric" "159","wcf-endpoint" "159","ibmhttpserver" "159","data-collection" "159","role-based-access-control" "159","wpf-animation" "159","dvc" "159","anglesharp" "159","passport-jwt" "159","entitydatasource" "159","infobox" "159","apple-id" "159","nssplitview" "159","mod-mono" "159","spring-native" "159","e2e" "159","java.nio.file" "159","mailing" "159","rdf4j" "159","mailboxer" "159","javascript-namespaces" "159","extended-sql" "159","kotlin-null-safety" "159","expss" "159","reflections" "159","hashbang" "159","tailwind-3" "159","tmx" "159","generic-handler" "159","nhibernate-mapping-by-code" "159","node-canvas" "159","responsetext" "159","chain-of-responsibility" "159","esp8266wifi" "159","promela" "159","flvplayback" "159","autocompletebox" "159","zend-translate" "159","quarkus-reactive" "159","google-plugin-eclipse" "159","soil" "159","amazon-mq" "159","soundex" "159","touchpad" "159","custom-type" "158","phpfox" "158","ecore" "158","vsync" "158","fiddlercore" "158","cmp" "158","intellij-lombok-plugin" "158","smartclient" "158","sles" "158","filenet-content-engine" "158","munit" "158","primefaces-datatable" "158","grouped-bar-chart" "158","adobe-animate" "158","python-3.12" "158","jsf-2.3" "158","soapserver" "158","swiftui-charts" "158","appfabric-cache" "158","self-modifying" "158","datetime2" "158","adam" "158","aws-media-convert" "158","pulse" "158","angular-material-5" "158","server-side-scripting" "158","microformats" "158","w3-total-cache" "158","capslock" "158","django-piston" "158","r-maptools" "158","gpsd" "158","data-kinds" "158","infusionsoft" "158","one-liner" "158","boxapiv2" "158","interpreted-language" "158","mod-security2" "158","entity-component-system" "158","setenv" "158","for-of-loop" "158","bsod" "158","browser-support" "158","branching-strategy" "158","vlfeat" "158","orchard-modules" "158","or-operator" "158","refs" "158","tdbgrid" "158","ntdll" "158","x12" "158","device-policy-manager" "158","mergetool" "158","angularjs-1.6" "158","lto" "158","loop-invariant" "158","rescale" "158","mpld3" "158","qqmlcomponent" "158","before-save" "157","greenlets" "157","mvcjqgrid" "157","skip-lists" "157","yii2-validation" "157","packery" "157","kylin" "157","mainwindow" "157","j-security-check" "157","firebase-job-dispatcher" "157","snmp-trap" "157","market-basket-analysis" "157","jsonlines" "157","angular-lifecycle-hooks" "157","vba6" "157","keycloak-connect" "157","facebook-permissions" "157","oracle-apex-19.1" "157","kendo-template" "157","django-messages" "157","aws-iot-greengrass" "157","jquery-bootgrid" "157","gtk2hs" "157","htmlcollection" "157","posting" "157","dynamic-languages" "157","fable-f#" "157","visual-paradigm" "157","amazon-timestream" "157","caddyfile" "157","hana-sql-script" "157","reference-class" "157","uimodalpresentationstyle" "157","gaussian-process" "157","device-owner" "157","tlistview" "157","npm-request" "157","onconfigurationchanged" "157","http-status-code-415" "157","spin" "157","prolog-toplevel" "157","chalice" "157","heroku-api" "157","always-on-top" "157","sorbet" "157","prettytable" "157","flutter-method-channel" "157","userinfo" "156","backlog" "156","tsung" "156","grob" "156","mat-tab" "156","giraph" "156","multi-step" "156","renv" "156","xtk" "156","skemitternode" "156","content-encoding" "156","jsr352" "156","vsftpd" "156","package-management" "156","flask-appbuilder" "156","xively" "156","r-s3" "156","joomla-module" "156","vavr" "156","credential-manager" "156","django-grappelli" "156","in-operator" "156","enoent" "156","azure-blob-trigger" "156","eoferror" "156","ingres" "156","pdf-extraction" "156","postgrest" "156","postgres-fdw" "156","kohana-3.3" "156","mina" "156","formal-methods" "156","sysdate" "156","minute" "156","versionone" "156","azure-private-link" "156","hierarchyid" "156","mockwebserver" "156","aspell" "156","xamlparseexception" "156","nsworkspace" "156","asp.net-profiles" "156","uiscreen" "156","numberformatter" "156","movesense" "156","column-alias" "156","react-draft-wysiwyg" "156","ewsjavaapi" "156","activeperl" "156","http-patch" "156","stunnel" "156","array-key" "156","biblatex" "156","step" "156","cvpixelbuffer" "156","structural-search" "155","wicket-1.6" "155","vue-multiselect" "155","filenet" "155","skybox" "155","github-actions-self-hosted-runners" "155","websharper" "155","process-management" "155","fee" "155","tei" "155","voltdb" "155","mamba" "155","app-code" "155","bitvector" "155","pac" "155","pac4j" "155","french" "155","checkedtextview" "155","fiona" "155","socialauth" "155","rjags" "155","laravel-breeze" "155","serde-json" "155","csharpcodeprovider" "155","oracle-maf" "155","wandb" "155","inlining" "155","correctness" "155","nsmutabledata" "155","html5-fullscreen" "155","payum" "155","pearson" "155","ampps" "155","acceleo" "155","kotlin-multiplatform-mobile" "155","codebase" "155","newtype" "155","woff" "155","videocall" "155","node-soap" "155","drop-table" "155","modalpopup" "155","b2b" "155","gdprconsentform" "155","hardcode" "155","zxing.net" "155","elixir-iex" "155","getboundingclientrect" "155","odoo-17" "155","google-cloud-billing" "155","memory-access" "155","script-fu" "155","fold-expression" "155","custom-tags" "155","tf.data.dataset" "155","max-pooling" "155","hex-editors" "155","foreign-data-wrapper" "155","auto-vectorization" "155","flux.jl" "155","web3-java" "155","embedded-tomcat-7" "155","gmail-contextual-gadgets" "154","edsdk" "154","echarts4r" "154","webrtc-android" "154","phaserjs" "154","mat-dialog" "154","live-sdk" "154","x-sendfile" "154","chrome-options" "154","volt" "154","xlink" "154","bitwise-or" "154","addressing" "154","planning" "154","reality-composer" "154","oracle-apps" "154","recursive-cte" "154","nscache" "154","nsinvocation" "154","onpress" "154","htc-vive" "154","ane" "154","mojibake" "154","wpbakery" "154","nested-generics" "154","android-searchmanager" "154","twine" "154","error-checking" "154","synthesizer" "154","atan2" "154","signal-strength" "154","fable-r" "154","org-babel" "154","systrace" "154",".doc" "154","go-cobra" "154","nx-monorepo" "154","word-contentcontrol" "154","360-panorama" "154","branding" "154","j2mepolish" "154","digraphs" "154","tiny-tds" "154","dotless" "154","uisearchbardelegate" "154","dhtmlx-scheduler" "154","high-load" "154","cakedc" "154","redisearch" "154","openid-provider" "154","itemlistener" "154","dpapi" "154","qaction" "154","latin" "154","logstash-forwarder" "154","qprogressbar" "154","react-dates" "154","cgrectmake" "154","source-control-explorer" "154","helidon" "154","suffix-array" "154","solarium" "154","structured-bindings" "154","query-cache" "154","liferay-6.2" "154","cypress-component-test-runner" "154","steroids" "154","precompiled" "154","quad" "153","stagefright" "153","load-time" "153","term-document-matrix" "153","clamp" "153","antixsslibrary" "153","cloudify" "153","six" "153","remoteobject" "153","feather" "153","xstate" "153","teiid" "153","masked-array" "153","clutter" "153","socketcan" "153","piranha-cms" "153","fusionauth" "153","unreal-development-kit" "153","optimizely" "153","farseer" "153","angularjs-rootscope" "153","methodinfo" "153","joomla3.1" "153","oracle-ords" "153","rmdir" "153","joomla3.2" "153","dword" "153","posixlt" "153","junit3" "153","twilio-flex" "153","spring-cloud-consul" "153","spring-batch-tasklet" "153","cosmicmind" "153","cosmos" "153","build-settings" "153","newrelic-platform" "153","aapt2" "153","revitpythonshell" "153","milvus" "153","ord" "153","ramdisk" "153","32feet" "153","ucwa" "153","buildfire" "153","nyc" "153","go-echo" "153","typegoose" "153","wix3.10" "153","pnp-js" "153","non-type" "153","exporter" "153","isomorphism" "153","azure-storage-emulator" "153","italic" "153","tcxgrid" "153","nofollow" "153","quit" "153","iscsi" "153","android-module" "153","getmethod" "153","octree" "153","activecollab" "153","speex" "153","streambuf" "153","custom-binding" "153","google-groups-api" "153","zone.js" "153","quic" "153","bcnf" "153","hedera-hashgraph" "153","qslider" "153","max-heap" "153","gnu-toolchain" "152","filehandler" "152","bada" "152","ansi-colors" "152","flappy-bird-clone" "152","symfony-2.5" "152","impresspages" "152","apns-php" "152","indexed" "152","xposed" "152","imu" "152","directwrite" "152","django-tinymce" "152","valueinjecter" "152","animatewithduration" "152","aws-codeartifact" "152","iccube-reporting" "152","ruby-debug" "152","enterprise-library-5" "152","turbogears2" "152","tvirtualstringtree" "152","scada" "152","blocked" "152","invoke-restmethod" "152","spring-async" "152","out-of-browser" "152","reuseidentifier" "152","osclass" "152","nettopologysuite" "152","extjs6-modern" "152","copy-assignment" "152","gear-vr" "152","ganglia" "152","jack" "152","contiguous" "152","executescalar" "152","hl7-v2" "152","radwindow" "152","cufft" "152","persistent-connection" "152","community-toolkit-mvvm" "152","split-apply-combine" "152","layoutsubviews" "152","emberfire" "152","linkedhashset" "152","weaviate" "152","pander" "152","lightweight-charts" "152","flutter-integration-test" "152","structured-array" "152","ytdl" "152","gnutls" "151","cmmotionmanager" "151","mason" "151","treetableview" "151","fluid-dynamics" "151","translucency" "151","fscheck" "151","disk-partitioning" "151","checklistbox" "151","jsr" "151","python-mode" "151","swizzling" "151","jstack" "151","python-twitter" "151","checkmark" "151","flask-cors" "151","fiware-wirecloud" "151","oversampling" "151","ng-tags-input" "151","underflow" "151","aws-billing" "151","react-usememo" "151","database-concurrency" "151","mysql-error-1005" "151","animationdrawable" "151","sessionstorage" "151","w3.css" "151","canactivate" "151","akeneo" "151","rtcpeerconnection" "151","pwd" "151","dlna" "151","dash-shell" "151","internal-tables" "151","tun" "151","workflowservice" "151","nsbezierpath" "151","bndtools" "151","bochs" "151","android-titlebar" "151","patindex" "151",".net-native" "151","kryonet" "151","cocoaasyncsocket" "151","settings.settings" "151","codefluent" "151","word-break" "151","leptonica" "151","kohana-3.2" "151","jasig" "151","rawstring" "151","less-mixins" "151","orthogonal" "151","xcode10.2" "151","xamarin.forms.shell" "151","tolower" "151","nsurlsessionuploadtask" "151","isin" "151","android-framework" "151","x3dom" "151","memoryview" "151","node-ffi" "151","texturepacker" "151","office365connectors" "151","nodeclipse" "151","spagobi" "151","qt-installer" "151","webdrivermanager-java" "151","stdcall" "151","automotive" "150","backgrid" "150","multiple-projects" "150","websphere-commerce" "150","phantom-dsl" "150","listselectionlistener" "150","mutagen" "150","git-amend" "150","eclipse-3.6" "150","tridion-content-delivery" "150","getstring" "150","picamera" "150","dataproc" "150","data-transfer-objects" "150","map-directions" "150","p12" "150","jtextcomponent" "150","cellrenderer" "150","celeryd" "150","fzf" "150","universal-binary" "150","icriteria" "150","fastparquet" "150","gracenote" "150","ibm-bpm" "150","rman" "150","kbuild" "150","jquery-ajaxq" "150","swagger-php" "150","azure-communication-services" "150","wso2-streaming-integrator" "150","supersized" "150","android-thread" "150","coroutinescope" "150","postgresql-copy" "150","nsinputstream" "150","pcl" "150","broken-links" "150","mintty" "150","rapidapi" "150","lxd" "150","lync-2010" "150","java.util.calendar" "150","ostringstream" "150","qwebkit" "150","ntlm-authentication" "150","xcode8.2" "150","dotnetrdf" "150","play-reactivemongo" "150","garmin" "150","activesupport-concern" "150","mpnowplayinginfocenter" "150","stochastic-process" "150","account-kit" "150","pencilkit" "150","office-2016" "150","excel-2011" "150","generator-expression" "150","cgimageref" "150","launchimage" "150","cts" "150","ode45" "150","healpy" "150","zend-gdata" "150","maxdate" "150","google-swiffy" "150","flutter-showmodalbottomsheet" "150","google-maps-react" "150","flux-influxdb" "149","griffon" "149","dcmtk" "149","dcm4che" "149","instantclient" "149","flip-flop" "149","listfield" "149","jenkins-shared-libraries" "149","insertafter" "149","safearray" "149","ngx-leaflet" "149","aero-glass" "149","smp" "149","smart-device" "149","findwindow" "149","picking" "149","kundera" "149","rootview" "149","angular-pwa" "149","cappuccino" "149","dnn9" "149","kinect-v2" "149","alchemy" "149","bootstrap-cards" "149","dynamo-local" "149","apple-mail" "149","open-basedir" "149","pch" "149","kaltura" "149","popstate" "149","jvm-languages" "149","facebook-events" "149","eye-tracking" "149","should.js" "149","fragment-lifecycle" "149","visual-web-developer-2010" "149","occi" "149","opentext" "149","hlist" "149","mjml" "149","hijri" "149","home-automation" "149","azure-purview" "149","column-chart" "149","memo" "149","lorawan" "149","elasticsearch-analyzers" "149","spring4d" "149","react-icons" "149","event-binding" "149","userlocation" "149","amazon-sagemaker-studio" "149","conda-forge" "149","qtserialport" "149","flutter-riverpod" "149","git-worktree" "148","ecma262" "148","localforage" "148","defensive-programming" "148","template-strings" "148","prism-6" "148","remote-branch" "148","mat-autocomplete" "148","remote-connection" "148","apache-commons-config" "148","advanced-search" "148","vpc-endpoint" "148","import-maps" "148","swiftui-environment" "148","xnu" "148","umask" "148","bind-variables" "148","jjwt" "148","microsoft-chart-controls" "148","agora-web-sdk-ng" "148","sequencing" "148","i3" "148","django-select-related" "148","faces-config" "148","jqlite" "148","database-cleaner" "148","validationsummary" "148","keyguard" "148","intermediate-language" "148","initialization-list" "148","springmockito" "148","susy-sass" "148","azure-configuration" "148","nested-form-for" "148","opencms" "148","wsse" "148","mongohq" "148","jquery-widgets" "148","info" "148","sample-data" "148","microsoft-web-deploy" "148","wiringpi" "148","cognos-8" "148","cocoalibspotify-2.0" "148","networkcredentials" "148","sqldelight" "148","pluralize" "148","drools-planner" "148","sqlite-net-extensions" "148","sql-parser" "148","android-navigation-bar" "148","mongoose-web-server" "148","google-cloud-memorystore" "148","protein-database" "148","noaa" "148","cfloop" "148","laravel-storage" "148","resource-management" "148","mouse-listeners" "148","http-token-authentication" "148","ios-permissions" "148","qitemdelegate" "148","laravel-notification" "148","color-profile" "148","memmove" "148","qstyleditemdelegate" "148","user-tracking" "148","qspinbox" "148","linqkit" "148","linux-namespaces" "148","zipline" "148","pandas-to-sql" "148","zend-framework-mvc" "148","google-now" "148","qualcomm" "148","availability" "148","idictionary" "147","badimageformatexception" "147","eclipse-scout" "147","transitive-closure" "147","geturl" "147","eel" "147","dbms-output" "147","standby" "147","ecdh" "147","filemtime" "147","skype4com" "147","firebasesimplelogin" "147","catch-block" "147","smooch" "147","adminer" "147","rust-proc-macros" "147","flask-jwt-extended" "147","checked-exceptions" "147","rx-java3" "147","image-registration" "147","picklist" "147","indexed-view" "147","documentlistener" "147","cross-product" "147","microsoft-custom-vision" "147","docopt" "147","twitterizer" "147","ionicons" "147","twirl" "147","hosts-file" "147","bluecove" "147","popviewcontroller" "147","satellizer" "147","nsscanner" "147","mongodb-aggregation" "147","letter-spacing" "147","system-variable" "147","2d-vector" "147",".net-cf-3.5" "147","m3u" "147","magic-square" "147","openrasta" "147","android-compatibility" "147","exploratory-data-analysis" "147","toarray" "147","quorum" "147","scalamock" "147","hierarchical-query" "147","dotconnect" "147","coordinator-layout" "147","table-per-type" "147","bulletedlist" "147","numerical-computing" "147","uilongpressgesturerecogni" "147","redis-cache" "147","cookiecutter" "147","restrict-qualifier" "147","storagefile" "147","petsc" "147","custom-painting" "147","argument-unpacking" "147","msbuildcommunitytasks" "147","glog" "147","a-records" "147","autoresetevent" "147","flutter-routes" "147","ppp" "147","bigquery-udf" "147","illegal-characters" "147","uwp-maps" "147","sealed-class" "147","il2cpp" "146","multisampling" "146","webresource.axd" "146","lob" "146","appicon" "146","firebase-in-app-messaging" "146","marching-cubes" "146","undefined-function" "146","xmlrpclib" "146","maproute" "146","bitrix" "146","phyloseq" "146","gpflow" "146","r-recipes" "146","database-versioning" "146","rtsp-client" "146","icefaces-3" "146","kernel-mode" "146","ical4j" "146","nanotime" "146","angular-oauth2-oidc" "146","valuetuple" "146","keyof" "146","rootviewcontroller" "146","equatable" "146","worldwind" "146","sap-bw" "146","passphrase" "146","sim800" "146","spring-dsl" "146","bootswatch" "146","mirc" "146","network-flow" "146","out-parameters" "146","code128" "146","extjs-grid" "146","android-app-indexing" "146","right-align" "146",".a" "146","kofax" "146","objcopy" "146","revmob" "146","3d-secure" "146","videogular" "146","object-persistence" "146","gcp-ai-platform-training" "146","hive-partitions" "146","conversion-operator" "146","quoted-identifier" "146","railway" "146","bus-error" "146","quickfixn" "146","quickblox-android" "146","explicit-instantiation" "146","iso-prolog" "146","dotnethighcharts" "146","radeditor" "146","target-platform" "146","core.autocrlf" "146","cordova-plugin-file" "146","memory-dump" "146","tess-two" "146","perlbrew" "146","charsequence" "146","str-to-date" "146","textpad" "146","morelikethis" "146","prestashop-modules" "146","qtranslate" "146","embeddable" "146","msal" "146","comtypes" "146","helios" "146","query-planner" "146","condor" "146","linq-to-excel" "146","cyclic-reference" "145","clarity" "145","pgrouting" "145","sktexture" "145","citus" "145","matlab-struct" "145","relaymodern" "145","background-audio" "145","tsvector" "145","bacpac" "145","edismax" "145","telerik-open-access" "145","language-detection" "145","mariasql" "145","picocli" "145","front-controller" "145","json-extract" "145","ngx-admin" "145","datagridviewcheckboxcell" "145","servlet-listeners" "145","createuser" "145","failovercluster" "145","angularjs-validation" "145","google-url-shortener" "145","hyperledger-fabric-sdk-js" "145","public-html" "145","cakephp-3.2" "145","molecule" "145","jquery-ui-selectmenu" "145","hosted" "145","pdcurses" "145","jqxwidgets" "145","tween.js" "145","nssm" "145","nreco" "145","android-splashscreen" "145","block-cipher" "145","block-device" "145","dynamic-data-display" "145","scaladoc" "145","4d" "145","javafx-css" "145","libreoffice-writer" "145","3ds" "145","bslib" "145","pyspark-pandas" "145","wiql" "145","virtualmin" "145","framerjs" "145","raw-types" "145","machinekey" "145","draw2d" "145","convex" "145","control-flow-graph" "145","screen-brightness" "145","nios" "145","cffi" "145","elasticsearch-dsl-py" "145","property-based-testing" "145","human-readable" "145","proto3" "145","angularjs-compile" "145","layout-gravity" "145","text-styling" "145","longtext" "145","log-rotation" "145","computercraft" "145","daml" "145","struts-validation" "145","sorcery" "145","spamassassin" "145","theano-cuda" "145","web-notifications" "145","flutter-text" "144","fig" "144","localbroadcastmanager" "144","wdm" "144","ed25519" "144","multiple-versions" "144","web-traffic" "144","balanced-payments" "144","clipboard.js" "144","react-native-native-module" "144","triangle" "144","match-against" "144","cloudfoundry-uaa" "144","mattermost" "144","listview-adapter" "144","deferred-rendering" "144","tensorflowjs-converter" "144","weighted-graph" "144","reportserver" "144","imperative-programming" "144","contentplaceholder" "144","app-bundle" "144","kubernetes-jobs" "144","xml2js" "144","uncrustify" "144","vscodevim" "144","service-worker-events" "144","fact-table" "144","vcs-checkout" "144","django-imagekit" "144","doctrine-migrations" "144","dnf" "144","simple-salesforce" "144","mgwt" "144","unknown-host" "144","unity3d-gui" "144","jquery-knob" "144","jri" "144","hp-alm" "144","sikuli-script" "144","ionic-v1" "144","type-bounds" "144","fpic" "144","rc4-cipher" "144","bugsnag" "144","fortran2003" "144","overlapped-io" "144","codespaces" "144","showmodaldialog" "144","tablename" "144","tde" "144","gun" "144","tabula-py" "144","busyindicator" "144","tippyjs" "144","azure-marketplace" "144","diazo" "144","azure-functions-isolated" "144","mobilefirst-cli" "144","nvl" "144","hash-of-hashes" "144","opensea" "144","angular1.6" "144","splunk-dashboard" "144","etsy" "144","spawning" "144","angularjs-injector" "144","colorama" "144","mpvolumeview" "144","requestjs" "144","event-stream" "144","exceldatareader" "144","ppl" "144","medium-trust" "144","zend-acl" "144","msvc12" "144","google-oauth-java-client" "144","linux-from-scratch" "144","headphones" "144","parsley" "144","helmet.js" "144","mdx-query" "144","qt5.6" "144","stdmove" "144","prettify" "144","mtm" "143","civicrm" "143","processmaker" "143","loaded" "143","interface-implementation" "143","webview-flutter" "143","translate3d" "143","listboxitems" "143","treeviewer" "143","ssh2" "143","clarifai" "143","jaybird" "143","gforth" "143","jaydebeapi" "143","xtermjs" "143","django-contenttypes" "143","admob-rewardedvideoad" "143","pkgbuild" "143","datatemplateselector" "143","packet-loss" "143","dirname" "143","jose" "143","readelf" "143","docusign-sdk" "143","angular-storybook" "143","varbinarymax" "143","kibana-6" "143","workbox-webpack-plugin" "143","gulp-browser-sync" "143","spring-integration-http" "143","azure-ai" "143","blueprintjs" "143","wow.js" "143","axiom" "143","bootstrap-daterangepicker" "143","gtable" "143","jquery-ui-multiselect" "143","mogrify" "143","shopware6-app" "143","wiremock-standalone" "143","authenticator" "143","mailing-list" "143","missingmethodexception" "143","android-beam" "143","formhelper" "143","attachedbehaviors" "143","sf-symbols" "143","rfc5545" "143","pysqlite" "143","facebook-friends" "143","amazon-transcribe" "143","setsockopt" "143","double-checked-locking" "143","hibernate-6.x" "143","opensso" "143","norm" "143","drupal-hooks" "143","expected-condition" "143","nstextattachment" "143","tinker" "143","collection-select" "143","android-safe-args" "143","eucalyptus" "143","propensity-score-matching" "143","prototyping" "143","http-status-code-413" "143","laravel-horizon" "143","rdtsc" "143","tomee-7" "143","mediatemple" "143","webpack-loader" "143","end-of-line" "143","mclapply" "143","static-constructor" "143","automatic-updates" "143","traffic-simulation" "143","transfer-encoding" "143","presenter" "142","standardized" "142","xmi" "142","adobecreativesdk" "142","causality" "142","cdap" "142","index-match" "142","pkix" "142","xinput" "142","python-daemon" "142","language-implementation" "142","choregraphe" "142","angular-resolver" "142","recurring-events" "142","rooted-device" "142","updateprogress" "142","akka-typed" "142","django-guardian" "142","url.action" "142","faiss" "142","record-linkage" "142","android-websettings" "142","azure-data-sync" "142","hprof" "142","onfling" "142","neoscms" "142","modularization" "142","bolt" "142","pc-lint" "142","htmlelements" "142","scalable" "142","jwplayer7" "142","typeinfo" "142","orientdb-2.1" "142","miui" "142","android-applicationinfo" "142","oauth2-playground" "142","extra" "142","setbackground" "142","java.time.instant" "142","nette" "142","signalr-backplane" "142","libjingle" "142","amplitude" "142","coin-flipping" "142","system-testing" "142","uipicker" "142","nsurlprotocol" "142","xcode7.2" "142","android-inputtype" "142","nokia-s40" "142","take" "142","schema-design" "142","re-frame" "142","dragonfly-gem" "142","ondemand" "142","monkey" "142","nlopt" "142","google-eclipse-plugin" "142","mptt" "142","activescaffold" "142","cereal" "142","http-options-method" "142","powermail" "142","vaadin10" "142","cypress-intercept" "142","gitops" "142","tfs-2010" "142","glad" "142","preserve" "142","hci" "142","google-reporting-api" "142","papyrus" "141","tempdb" "141","react-native-flexbox" "141","eclipse-marketplace" "141","repast-simphony" "141","sku" "141","file-move" "141","jcalendar" "141","gettime" "141","yargs" "141","backand" "141","multipartfile" "141","biztalk-orchestrations" "141","add-filter" "141","import-module" "141","swtbot" "141","app-actions" "141","rvo" "141","rvm-capistrano" "141","make-shared" "141","camera2" "141","kerning" "141","fastboot" "141","oracle-manageddataaccess" "141","docker-secrets" "141","verbosity" "141","windows-8.1-universal" "141","ruby-1.8" "141","value-of" "141","akka-testkit" "141","deriving" "141","dynamics-gp" "141","spring-kafka-test" "141","mongodb-atlas-search" "141","shopware6-api" "141","rethinkdb-python" "141","google-cdn" "141","winmerge" "141","kobold2d" "141","less-unix" "141","facebook-analytics" "141","nsurlsessionconfiguration" "141","sqlfiddle" "141","cordova-cli" "141","ivar" "141","nom" "141","uitableviewautomaticdimension" "141","response.write" "141","laravel-jobs" "141","node-pdfkit" "141","eksctl" "141","currentculture" "141","certificate-revocation" "141","geokit" "141","react-day-picker" "141","dual-sim" "141","timage" "141","archunit" "141","hdpi" "141","qtcpserver" "141","spark-notebook" "141","struts2-interceptors" "141","conference" "141","powerpoint-2010" "140","livebindings" "140","photogrammetry" "140","eclipse-memory-analyzer" "140","github-codespaces" "140","floating-point-exceptions" "140","gitlab-pages" "140","fixed-header-tables" "140","bitlocker" "140","adjustment" "140","flashvars" "140","firewalld" "140","redash" "140","jison" "140","google-web-designer" "140","jquery-easing" "140","eager-execution" "140","azure-devops-server" "140","borderless" "140","nsfilehandle" "140","jquery-data" "140","rayon" "140","coderush" "140","obs" "140","fossil" "140","google-chrome-console" "140","ubuntu-15.04" "140","formvalidation-plugin" "140","video-compression" "140","coldbox" "140","scim2" "140","control-structure" "140","directinput" "140","plotrix" "140","asplinkbutton" "140","driving-directions" "140","culling" "140","petrel" "140","oledbexception" "140","merge-module" "140","law-of-demeter" "140","octopus" "140","python-vlc" "140","node-mysql2" "140","prettier-eslint" "140","structural-typing" "140","scrypt" "140","zerobrane" "140","papervision3d" "140","linqdatasource" "140","qtestlib" "140","pprof" "140","arrow-kt" "139","deduplication" "139","ecb" "139","webshop" "139","inspect-element" "139","private-subnet" "139","maven-cargo" "139","feature-branch" "139","multiple-forms" "139","pgx" "139","templatebinding" "139","grequests" "139","laravel-fortify" "139","discretization" "139","catextlayer" "139","vp8" "139","adoptopenjdk" "139","final-form" "139","data-quality" "139","pacman-package-manager" "139","bitstring" "139","python-sip" "139","soapfault" "139","bitconverter" "139","method-invocation" "139","gradienttape" "139","vb.net-to-c#" "139","ibm-rational" "139","fatjar" "139","jquery-datatables-editor" "139","appserver" "139","passwordbox" "139","nautilus" "139","kdiff3" "139","pcap.net" "139","cratedb" "139","openbravo" "139","postorder" "139","into-outfile" "139","designated-initializer" "139","pastebin" "139","nxt" "139","buffer-geometry" "139","raiserror" "139","shrine" "139","orca" "139","code-golf" "139","vlsi" "139","amortized-analysis" "139","sgml" "139","amr" "139","modal-window" "139","tizen-emulator" "139","tizen-studio" "139","hiredis" "139","j2objc" "139","spy++" "139","tdb" "139","janrain" "139","xbuild" "139","hadoop-plugins" "139","redcarpet" "139","assembly-references" "139","harmonyos" "139","activity-stack" "139","gethostbyname" "139","om" "139","textmate2" "139","odroid" "139","tessellation" "139","android-remoteview" "139","elasticsearch-x-pack" "139","zul" "139","elmah.mvc" "139","zend-pdf" "139","this-pointer" "139","maximize-window" "139","custom-widgets" "139","zend-session" "139","linearmodels" "139","haskell-pipes" "139","qtextbrowser" "139","pprint" "138","jdl" "138","skview" "138","clickjacking" "138","mautic" "138","fedora-25" "138","triples" "138","flutter-container" "138","smartsheet-api-2.0" "138","disk-io" "138","kube-proxy" "138","segments" "138","bitmapsource" "138","contentoffset" "138","crossbar" "138","rome" "138","kif" "138","jlayer" "138","rowdatabound" "138","angularjs-ng-form" "138","ag-grid-vue" "138","gpt-4" "138","server-administration" "138","intrusion-detection" "138","tt-news" "138","wwdc" "138","pdfrenderer" "138","dvd" "138","enunciate" "138","kaniko" "138","brace-expansion" "138","scala-compiler" "138","module.exports" "138","aqueduct" "138","blazorise" "138","paypal-buttons" "138","apple-appclips" "138","breakout" "138","s-expression" "138","systemtap" "138",".net-4.5.2" "138","xamarin.auth" "138","hogan.js" "138","android-filterable" "138","mnemonics" "138","cadisplaylink" "138","azure-http-trigger" "138","executemany" "138","spss-modeler" "138","generic-constraints" "138","react-native-calendars" "138","screeps" "138","google-iap" "138","tfs-process-template" "138","touchmove" "138","spark-csv" "138","linq-group" "138","powershell-1.0" "138","pox" "138","search-form" "138","url-launcher" "138","lighttable" "137","flexible-array-member" "137","principalcontext" "137","cmake-modules" "137","discovery" "137","adsense-api" "137","image-masking" "137","vscode-python" "137","vnc-viewer" "137","sendbird" "137","xmlworker" "137","adobe-xd" "137","gorouter" "137","aws-acm" "137","singular" "137","rjson" "137","upperbound" "137","micrometer-tracing" "137","rubiks-cube" "137","bonita" "137","cortana-intelligence" "137","pchart" "137","swfloader" "137","wse" "137","samsung-galaxy-gear" "137","dynamicresource" "137","html-templates" "137","ncover" "137","tumblr-themes" "137","formwizard" "137","rets" "137","networkmanager" "137","javacompiler" "137","otool" "137","sicstus-prolog" "137","java-client" "137","sha2" "137","uiactivity" "137","scom" "137","assembla" "137","android-bottomappbar" "137","mobile-ad-mediation" "137","screen-lock" "137","drf-spectacular" "137","xamarin.forms.listview" "137","openkinect" "137","comm" "137","accessoryview" "137","terser" "137","android-native-library" "137","event-receiver" "137","log4cplus" "137","elastalert" "137","pellet" "137","promotions" "137","required-field" "137","bean-io" "137","flysystem" "137","startmenu" "137","urp" "137","statechart" "137","globalize" "137","webchromeclient" "136","relative-url" "136","flops" "136","matlab-table" "136","deepzoom" "136","remote-notifications" "136","imagemapster" "136","apiary" "136","cell-formatting" "136","vscode-keybinding" "136","daydream" "136","immediate-window" "136","python-django-storages" "136","python-db-api" "136","mysqlbinlog" "136","robotframework-ide" "136","sharepoint-jsom" "136","cakephp-2.6" "136","gosu" "136","angular-ssr" "136","rubyzip" "136","canopen" "136","cakephp-3.4" "136","dependency-inversion" "136","nrpe" "136","android-strictmode" "136","post-commit-hook" "136","wpa" "136","opendata" "136","paxos" "136","k2" "136","counting-sort" "136","epub3" "136","superview" "136","svn2git" "136","gstat" "136","samsung-mobile-sdk" "136","spring-graphql" "136","set-returning-functions" "136","facebook-instant-articles" "136","outlook-2003" "136","koa-router" "136","observablehq" "136","osgeo" "136","tasker" "136","azure-log-analytics-workspace" "136","rack-pow" "136","excel-match" "136","devops-services" "136","asp.net-charts" "136","hibernate3" "136","radial" "136","gcc4.7" "136","android-build-flavors" "136","spdlog" "136","ios-pdfkit" "136","qplaintextedit" "136","actionmethod" "136","getelementsbyname" "136","combinelatest" "136","etherpad" "136","react-loadable" "136","getresponse" "136","sdkman" "136","quartz-composer" "136","hdfstore" "136","structured-text" "136","lightswitch-2012" "136","msxml6" "135","apache-cayenne" "135","mat-datepicker" "135","report-designer" "135","jdesktoppane" "135","cloudbuild.yaml" "135","intel-syntax" "135","yew" "135","graphql-ruby" "135","multi-table" "135","fdf" "135","yaml-front-matter" "135","webresponse" "135","symfony-messenger" "135","js-xlsx" "135","maintenance-mode" "135","chefspec" "135","data-url" "135","content-management" "135","nextgen-gallery" "135","uncertainty" "135","incoming-call" "135","fts3" "135","selenoid" "135","s4sdk" "135","data-layers" "135","s60" "135","jgraph" "135","facebook-sdk-3.1" "135","react-window" "135","fastmm" "135","cross-language" "135","hyperopt" "135","grails-2.2" "135","nand2tetris" "135","django-viewflow" "135","roxygen" "135","sharepoint-search" "135","fast-enumeration" "135","angular-schema-form" "135","opos" "135","inmobi" "135","android-studio-4.0" "135","mongoosastic" "135","pax-exam" "135","passwd" "135","coreldraw" "135","dyno" "135","sanitizer" "135","wix-extension" "135","raven" "135","java-12" "135","libtiff.net" "135","vispy" "135","buildr" "135","audio-service" "135","windows-xp-sp3" "135","itemsource" "135","gwt-celltable" "135","expo-notifications" "135","xcode9.3" "135","scorm1.2" "135","uideviceorientation" "135","screen-density" "135","uiedgeinsets" "135","sqlite3-python" "135","opennetcf" "135","property-wrapper" "135","cube.js" "135","iphone-softkeyboard" "135","activity-manager" "135","long-long" "135","lastinsertid" "135","laravel-vapor" "135","google-cloud-dlp" "135","commit-message" "135","spp" "135","webgpu" "135","timeago" "135","mbr" "135","ends-with" "135","iframe-resizer" "135","state-restoration" "135","spark-shell" "135","ember-model" "134","stack-unwinding" "134","vue-class-components" "134","terminator" "134","deeplab" "134","treelist" "134","graph-coloring" "134","yepnope" "134","imultivalueconverter" "134","symfony-validator" "134","fishpig" "134","first-class-functions" "134","self-organizing-maps" "134","const-reference" "134","manualresetevent" "134","snmpd" "134","metric" "134","angularjs-select2" "134","native-activity" "134","jpcap" "134","sequence-alignment" "134","valuechangelistener" "134","icollectionview" "134","angularjs-ng-init" "134","sitecore-dms" "134","rocket-chip" "134","mod-expires" "134","tweetinvi" "134","environmentobject" "134","crate" "134","ingress-nginx" "134","postmark" "134","lync-client-sdk" "134","type-narrowing" "134","rajawali" "134","browser-addons" "134","go-http" "134","short-url" "134","accelerated-mobile-page" "134","siamese-network" "134","overfitting-underfitting" "134","rgraph" "134","xades4j" "134","isbn" "134","gammu" "134","table-per-hierarchy" "134","halcon" "134","spring-vault" "134","performancepoint" "134","sparse-checkout" "134","member-initialization" "134","element-plus" "134","motordriver" "134","elastic-cloud" "134","angular-guards" "134","nidaqmx" "134","strava" "134","cxf-client" "134","amazon-advertising-api" "134","ember-testing" "134","preemption" "134","urwid" "134","liferay-velocity" "134","git-p4" "134","compound-literals" "134","computation-expression" "134","parallel-port" "133","webproxy" "133","phpexcelreader" "133","bandwidth-throttling" "133","django-1.3" "133","unetstack" "133","js-cookie" "133","castle-monorail" "133","uniform-initialization" "133","semantic-analysis" "133","platform-independent" "133","python-jsonschema" "133","self-referencing-table" "133","wikimedia" "133","airflow-taskflow" "133","django-syncdb" "133","angular-slickgrid" "133","valence" "133","robustness" "133","go-testing" "133","w3c-geolocation" "133","post-build" "133","countries" "133","htdocs" "133","keen-io" "133","keda" "133","information-hiding" "133","hotfix" "133","navigateurl" "133","oclazyload" "133","winpe" "133","domain-events" "133","foxx" "133","audio-fingerprinting" "133","tableheader" "133","rewardedvideoad" "133","machine-learning-model" "133","android-app-links" "133","victoriametrics" "133","executequery" "133","time-limiting" "133","tin-can-api" "133","asm.js" "133","game-maker-language" "133","openstack-horizon" "133","taglib-sharp" "133","drf-queryset" "133","hangouts-api" "133","highest" "133","hmmlearn" "133","tailwind-in-js" "133","asp.net-web-api-odata" "133","logback-classic" "133","oim" "133","message-digest" "133","geronimo" "133","stringtemplate-4" "133","character-arrays" "133","angularjs-forms" "133","logical-or" "133","custom-membershipprovider" "133","sublimetext4" "133","batterymanager" "133","gitweb" "133","dalli" "133","computed-observable" "133","google-news" "132","insets" "132","ghdl" "132","insert-select" "132","wfp" "132","vue-tables-2" "132","tsibble" "132","file-recovery" "132","xenforo" "132","impex" "132","symfony-console" "132","adomd.net" "132","ng2-dragula" "132","jtoolbar" "132","biztalk2006r2" "132","kubernetes-custom-resources" "132","manual-testing" "132","sybase-ase15" "132","apache-kudu" "132","nextui" "132","mapster" "132","vaticle-typedb" "132","docfx" "132","django-modeladmin" "132","createuserwizard" "132","database-locking" "132","aws-java-sdk-2.x" "132","canvg" "132","worldpay" "132","jquery-terminal" "132","boo" "132","enterprise-integration" "132","port80" "132","bokehjs" "132","descendant" "132","botan" "132","appsflyer" "132","type-coercion" "132","visual-studio-2017-build-tools" "132","attoparsec" "132","fql.multiquery" "132","komodoedit" "132","kotest" "132","winusb" "132","aabb" "132","codahale-metrics" "132","output-parameter" "132","minishift" "132","outlet" "132","opera-mini" "132","opensips" "132","xacml3" "132","nstreecontroller" "132","column-count" "132","cerberus" "132","stripe.net" "132","nms" "132","google-cloud-api-gateway" "132","string-pool" "132","getparameter" "132","angular2-modules" "132","splitview" "132","motorola-emdk" "132","flutter-notification" "132","sonarqube-5.0" "132","component-scan" "132","parse-android-sdk" "132","webpack-plugin" "132","sumologic" "132","email-parsing" "132","bcc-bpf" "131","cmake-language" "131","eclemma" "131","maven-bundle-plugin" "131","greenfoot" "131","x-ua-compatible" "131","ebextensions" "131","process-substitution" "131","trpc.io" "131","file-encodings" "131","xs" "131","react-native-hermes" "131","ffimageloading" "131","pickadate" "131","snappydata" "131","imdbpy" "131","symfony2-easyadmin" "131","jsctypes" "131","sensor-fusion" "131","selectable" "131","fixture" "131","fadeto" "131","akka-actor" "131","jqmodal" "131","kendo-react-ui" "131","server.mappath" "131","database-mirroring" "131","gqlquery" "131","microsoft-account" "131","wan" "131","roblox-studio" "131","share-button" "131","microfocus" "131","twilio-conversations" "131","intersystems" "131","couchdb-nano" "131","eager" "131","intraweb" "131","modx-evolution" "131","inotifycollectionchanged" "131","opencypher" "131","booleanquery" "131","atof" "131","retrieval-augmented-generation" "131","typekit" "131","anchor-scroll" "131","android-biometric" "131","microsoft-identity-web" "131","shinobi" "131","aasm" "131","winmain" "131","vision-api" "131","abpeoplepickerview" "131","shacl" "131","sql-server-2022" "131","android-color" "131","sprint" "131","uint16" "131","diagramming" "131","npm-audit" "131","acrobat-sdk" "131","proxy-pattern" "131","angular2-meteor" "131","excel-automation" "131","nightwatch" "131","ioslides" "131","oncheckedchanged" "131","lti" "131","splash-js-render" "131","search-path" "131","soundplayer" "131","suite" "131","linker-flags" "131","compiler-directives" "131","yt-dlp" "131","zonejs" "131","scrolltrigger" "131","glide-golang" "131","user-presence" "131","tortoise-orm" "131","ember-components" "131","lift-json" "131","sonarqube-msbuild-runner" "130","weak" "130","renderaction" "130","ghidra" "130","whitenoise" "130","react-native-fetch-blob" "130","ansible-galaxy" "130","anypoint-platform" "130","ggforce" "130","seleniumbase" "130","consistent-hashing" "130","python-collections" "130","fileobserver" "130","datarepeater" "130","phusion" "130","binary-image" "130","aws-sdk-cpp" "130","jnetpcap" "130","datagridcolumn" "130","django-related-manager" "130","ibinspectable" "130","cropper" "130","servicemesh" "130","spring-cloud-vault-config" "130","intl-tel-input" "130","nscolor" "130","porter-stemmer" "130","pdfplumber" "130","supercollider" "130","corespotlight" "130","neo4j-spatial" "130","depth-testing" "130","twitter-digits" "130","s-function" "130","magick.net" "130","brms" "130","libsass" "130","dojox.mobile" "130","object-object-mapping" "130","virtocommerce" "130","javascript-import" "130","r-colnames" "130","excel-online" "130","tchromium" "130","generalization" "130","gwt-super-dev-mode" "130","haddock" "130","xaudio2" "130","jackcess" "130","collectionfs" "130","getenv" "130","elasticsearch-opendistro" "130","accesscontrolexception" "130","android-profiler" "130","texture-atlas" "130","tfs-migration" "130","mayavi.mlab" "130","stm32f0" "130","staruml" "130","spaceship-operator" "130","md-autocomplete" "130","automaton" "130","heap-size" "130","soot" "129","templating-engine" "129","teamcity-7.0" "129","clearcase-remote-client" "129","terminfo" "129","declarative-authorization" "129","matlab-uitable" "129","basehttpserver" "129","relativesource" "129","cllocationcoordinate2d" "129","cl.exe" "129","apache-commons-cli" "129","r-xlsx" "129","jsbin" "129","blame" "129","blazegraph" "129","datamatrix" "129","image-optimization" "129","selenium-java" "129","ngx-quill" "129","pixelformat" "129","datastax-astra" "129","sensenet" "129","kubernetes-go-client" "129","runloop" "129","pad" "129","mysql-backup" "129","angularjs-watch" "129","oracle-autonomous-db" "129","fb-graph" "129","recvfrom" "129","internal-load-balancer" "129","appxmanifest" "129","pdfium" "129","counter-cache" "129","boringssl" "129","postcss-loader" "129","grunt-contrib-copy" "129","designmode" "129","springboard" "129","nsrangeexception" "129","gtts" "129","formatdatetime" "129","legacy-database" "129","a2dp" "129","uft14" "129","overlays" "129","pytest-cov" "129","virtualscroll" "129","typo3-8.7.x" "129","pythagorean" "129","devise-token-auth" "129","android-bottomnavigationview" "129","c#-ziparchive" "129","hibernate-session" "129","histogram2d" "129","experimental-design" "129","c3" "129","noindex" "129","istream-iterator" "129","q#" "129","node-opcua" "129","perfect" "129","prototype-chain" "129","logical-replication" "129","proj4js" "129","loginview" "129","mercurial-subrepos" "129","commandparameter" "129","hyperion" "129","node-addon-api" "129","log-analysis" "129","autocloseable" "129","auth-token" "129","quick.db" "129","altitude" "129","threadgroup" "129","zip4j" "129","amazon-kinesis-analytics" "129","static-pages" "129","ms-jet-ace" "129","trackpad" "129","dart-ffi" "129","shell32" "128","installshield-2012" "128","sslsocketfactory" "128","smallrye-reactive-messaging" "128","proftpd" "128","edgar" "128","squeel" "128","in-subquery" "128","stackedbarseries" "128","intellitrace" "128","grasshopper" "128","editbox" "128","choco" "128","pythoninterpreter" "128","pivot-chart" "128","snow" "128","ngui" "128","g++4.8" "128","file-ownership" "128","fulltext-index" "128","date-math" "128","unidata" "128","ftrace" "128","ngonchanges" "128","pacemaker" "128","swiftui-foreach" "128","filetable" "128","jfrog-xray" "128","mysql-error-1062" "128","realpath" "128","wcs" "128","albumart" "128","keyboard-navigation" "128","readonly-attribute" "128","calendarextender" "128","aws-config" "128","datagridcell" "128","core-nfc" "128","simple.data" "128","createinstance" "128","injectable" "128","interruption" "128","appsdk2" "128","cp1252" "128","asyncore" "128","system-clock" "128","shading" "128","kqueue" "128",".lib" "128","browsermob" "128","audit.net" "128","domcontentloaded" "128","mikroc" "128","ubuntu-12.10" "128","nsstringencoding" "128","tab-ordering" "128","redis-server" "128","caffeine" "128","expo-camera" "128","nomenclature" "128","model-driven" "128","play-slick" "128","ej2-syncfusion" "128","proof-of-correctness" "128","acr122" "128","iprincipal" "128","gerrit-trigger" "128","angular-decorator" "128","perfect-numbers" "128","iphone-sdk-3.2" "128","mpu6050" "128","android-jetpack-compose-lazy-column" "128","colormatrix" "128","automapper-3" "128","static-functions" "128","custom-tag" "128","usermanager" "128","starteam" "128","topdown" "128","webapi2" "128","maven-scm" "128","pressed" "128","parallel-coordinates" "127","multiple-languages" "127","reorderlist" "127","fernet" "127","installutil" "127","debug-mode" "127","clipboardmanager" "127","feature-file" "127","ssh2-sftp" "127","jedit" "127","pixmap" "127","child-nodes" "127","language-specifications" "127","cartography" "127","vscode-remote-ssh" "127","kik" "127","readystate" "127","simplex" "127","pure-function" "127","read-data" "127","wake-on-lan" "127","serverxmlhttp" "127","unity3d-mirror" "127","nd4j" "127","satchmo" "127","epic" "127","mongo-c-driver" "127","spring-reactive" "127","saxparseexception" "127","dynamic-compilation" "127","bootstrap-tour" "127","navigationservice" "127","twitter-card" "127","deltaspike" "127","bonobo" "127","pathgeometry" "127","spring-aspects" "127","boost-date-time" "127","fputs" "127","coldfusion-2018" "127","rive" "127","pylucene" "127","kotlin-reflect" "127","rdcomclient" "127","kolmogorov-smirnov" "127","knppaginator" "127","java-record" "127","oracle-text" "127","tamil" "127","holtwinters" "127","dronekit-python" "127","azure-tablequery" "127","ui-sref" "127","executereader" "127","react-jsonschema-forms" "127","textile" "127","omnithreadlibrary" "127","angularjs-1.5" "127","pega" "127","android-layoutparams" "127","offline-browsing" "127","meta-inf" "127","accessory" "127","webcenter" "127","power-law" "127","sparkling-water" "127","sticky-session" "127","therubyracer" "127","heightforrowatindexpath" "127","sharppcap" "127","query-expressions" "127","linphone-sdk" "127","bgp" "127","altova" "126","white-labelling" "126","lite-server" "126","react-native-modal" "126","lnk" "126","rendertargetbitmap" "126","websub" "126","selectsinglenode" "126","django-3.2" "126","rust-analyzer" "126","django-3.1" "126","pinecone" "126","datashader" "126","bind9" "126","appgallery" "126","kendo-upload" "126","pumping-lemma" "126","data-consistency" "126","cakephp-bake" "126","graphaware" "126","jolokia" "126","failure-slice" "126","mysqlnd" "126","aws-documentdb-mongoapi" "126","fatfs" "126","callgrind" "126","wazuh" "126","silhouette" "126","delayedvariableexpansion" "126","aws-vpc" "126","devcontainer" "126","htc-android" "126","pddl" "126","nsalert" "126","inotifywait" "126","onitemselectedlistener" "126","signed-applet" "126","virtual-serial-port" "126","google-ads-script" "126","cocoalumberjack" "126","syntaxnet" "126","shake-build-system" "126","krl" "126","java-16" "126","video-tracking" "126","riot-games-api" "126","osx-gatekeeper" "126","outlook.com" "126","pyodide" "126","synthesize" "126","rfc822" "126","qwik" "126","spry" "126","expectation-maximization" "126","mobilefirst-studio" "126","assistant" "126","azure-nsg" "126","drupal-rules" "126","tcc" "126","curves" "126","react-bootstrap-typeahead" "126","geofirestore" "126","custom-headers" "126","qchart" "126","qnx-neutrino" "126","changelist" "126","strdup" "126","splitcontainer" "126","collectstatic" "126","curb" "126","pegjs" "126","lastindexof" "126","tilemill" "126","mdriven" "126","line-intersection" "126","yubico" "126","flutter-theme" "126","secondary-indexes" "126","automated-deploy" "126","hawq" "126","autorest" "126","powerbi-paginated-reports" "125","livequery" "125","ssjs" "125","lis" "125","ffserver" "125","gimpfu" "125","reportportal" "125","fso" "125","xmltextreader" "125","pisa" "125","xdebug-3" "125","jsonencoder" "125","volusion" "125","snowflake-task" "125","page-layout" "125","jsonnet" "125","runtime-compilation" "125","faultexception" "125","captiveportal" "125","windows-error-reporting" "125","wamp-protocol" "125","mezzio" "125","capability" "125","windows-embedded" "125","djcelery" "125","readinessprobe" "125","htop" "125","jquery-mobile-collapsible" "125","boolean-algebra" "125","natural-join" "125","covariance-matrix" "125","spring-integration-aws" "125","samtools" "125","epl" "125","nawk" "125","wpa-supplicant" "125","nelmioapidocbundle" "125","postgraphile" "125","otel" "125","object-fit" "125","microsoft-graph-toolkit" "125","viper-architecture" "125","pyenchant" "125","javap" "125","kiwi" "125","ambiguous-grammar" "125","sqlmap" "125","copyright-display" "125","xcode-6.2" "125","dotliquid" "125","hiddenfield" "125","tabstop" "125","harbor" "125","drools-flow" "125","dijit.layout" "125","device-manager" "125","honeypot" "125","nstablecellview" "125","stringwithformat" "125","test-plan" "125","accessibility-api" "125","petalinux" "125","evdev" "125","android-media3" "125","ligature" "125","google-scholar" "125","zend-decorators" "125","scroll-snap" "125","google-one-tap" "125","usb-flash-drive" "125","statelesswidget" "125","array-initialization" "124","jetpack-compose-accompanist" "124","prismjs" "124","git-alias" "124","sliverappbar" "124","ycsb" "124","multitargeting" "124","vue-select" "124","swiftui-form" "124","apache-ranger" "124","rust-wasm" "124","content-pages" "124","owlready" "124","sense" "124","symbolicate" "124","serialversionuid" "124","document-management" "124","recreate" "124","wap" "124","mysql-insert-id" "124","django-paypal" "124","captivenetwork" "124","workfront-api" "124","jquery-selectbox" "124","cpanm" "124","android-task" "124","grpc-c#" "124","spring-jmx" "124","couchdb-2.0" "124","wordprocessingml" "124","dynamic-queries" "124","horizontal-pod-autoscaling" "124","entity-framework-core-2.1" "124","mod-fcgid" "124","rexml" "124","facebook-instant-games" "124","ucs2" "124","sfguard" "124","java-melody" "124","machine.config" "124","javalite" "124","konvajs-reactjs" "124","setneedsdisplay" "124","codeigniter-hmvc" "124","fosoauthserverbundle" "124","vivado-hls" "124","azure-monitor-workbooks" "124","polish" "124","cordova-android" "124","driverkit" "124","gdb-python" "124","redux-devtools" "124","android-flavors" "124","gwt-mvp" "124","hackage" "124","nurbs" "124","h3" "124","tinyos" "124","researchkit" "124","elasticsearch-jdbc-river" "124","projector" "124","acrofields" "124","cfmail" "124","perforce-client-spec" "124","pywikibot" "124","nl2br" "124","character-set" "124","prometheus-blackbox-exporter" "124","angular-dom-sanitizer" "124","protege4" "124","angular2-cli" "124","email-confirmation" "124","qtextdocument" "124","security-roles" "124","pari" "124","autodesk-inventor" "124","parameterized-unit-test" "124","solr-boost" "124","zkteco" "124","google-meet" "124","parallel-extensions" "123","multiple-records" "123","jenkins-2" "123","php-8.2" "123","git-blame" "123","slimerjs" "123","replay" "123","cjson" "123","react-native-ui-kitten" "123","telescope" "123","graphql-mutation" "123","cni" "123","jsonconverter" "123","jtogglebutton" "123","apparmor" "123","makecert" "123","rworldmap" "123","ngx-formly" "123","apache-wink" "123","configurationsection" "123","snap" "123","language-comparisons" "123","wcsession" "123","roracle" "123","singularitygs" "123","method-missing" "123","canvas-lms" "123","docker-daemon" "123","variable-initialization" "123","metastore" "123","unsupported-class-version" "123","rospy" "123","gpib" "123","rtd" "123","pdu" "123","paypal-webhooks" "123","coveralls" "123","initialization-vector" "123","describe" "123","createml" "123","azure-billing-api" "123","writable" "123","nslayoutmanager" "123","swagger-3.0" "123","video-toolbox" "123","netlify-function" "123","javacpp" "123","migrating" "123","google-beacon-platform" "123","kube-apiserver" "123","object-type" "123","shunting-yard" "123","atomicinteger" "123","reflect" "123","spyon" "123","tms-web-core" "123","azure-mysql-database" "123","drift" "123","conversion-specifier" "123","permanent" "123","qregularexpression" "123","commandbar" "123","angular-dependency-injection" "123","mercator" "123","tone.js" "123","spatial-interpolation" "123","morgan" "123","merge-request" "123","exacttarget" "123","qabstractlistmodel" "123","zeos" "123","google-tasks" "123","beam" "123","fminsearch" "122","mat-form-field" "122","clonenode" "122","dbref" "122","ggts" "122","list-manipulation" "122","instrumented-test" "122","jersey-test-framework" "122","inspec" "122","xmltodict" "122","jsonslurper" "122","xmltextwriter" "122","data-race" "122","maplibre-gl" "122","firebird2.1" "122","pins" "122","bitflags" "122","label-encoding" "122","xdomainrequest" "122","kinematics" "122","robobrowser" "122","ajax-request" "122","database-management" "122","variable-types" "122","rollbar" "122","gpg-signature" "122","jmdns" "122","google-workflows" "122","waffle" "122","vundle" "122","kendo-tabstrip" "122","vdsp" "122","jpa-criteria" "122","kerberos-delegation" "122","angular-material-stepper" "122","routeparams" "122","nsprogressindicator" "122","mongodb-kafka-connector" "122","junit-runner" "122","paypal-nvp" "122","nspersistentstore" "122","junction" "122","spring-boot-2" "122","bootstrap-switch" "122","u2" "122","tyrus" "122","system32" "122","visualize" "122","ext3" "122","god" "122","extract-text-plugin" "122","rgeo" "122","magento2.1" "122","exchange-server-2013" "122","notarize" "122","dropbox-php" "122","node-worker-threads" "122","opengl-es-1.1" "122","controlpanel" "122","haptic-feedback" "122","azure-triggers" "122","redo" "122","android-darkmode" "122","gzipinputstream" "122","nuxeo" "122","radtreeview" "122","numpad" "122","azure-iot-hub-device-management" "122","scope-identity" "122","charset" "122","spartan" "122","cuba-platform" "122","mesh-network" "122","reactive-swift" "122","google-feed-api" "122","bearing" "122","arcade" "122","flutter-sharedpreference" "122","ems" "122","idle-timer" "122","query-tuning" "121","template-function" "121","anyobject" "121","cloudflare-pages" "121","weekend" "121","interact.js" "121","listcellrenderer" "121","primeng-calendar" "121","reporters" "121","cncontactstore" "121","instantsearch.js" "121","jetty-8" "121","js-test-driver" "121","runbook" "121","kue" "121","inbound" "121","selectnodes" "121","adaptive-design" "121","xmlsec" "121","chronicle-map" "121","xojo" "121","python-oracledb" "121","swingutilities" "121","fulfillment" "121","pycassa" "121","idatareader" "121","unreal" "121","unityads" "121","data-export" "121","akka-remote-actor" "121","ag" "121","hypermedia" "121","react-toastify" "121","description-logic" "121","wp-list-categories" "121","polymerfire" "121","turbo-pascal" "121","onselect" "121","ndjson" "121","jump-list" "121","entity-framework-core-3.1" "121","spring-shell" "121","san" "121","ios10.3" "121","powerapps-collection" "121","maf" "121","build-runner" "121","knpmenubundle" "121","vignette" "121","2captcha" "121","typeloadexception" "121","accelerator" "121","riscv32" "121","goodness-of-fit" "121","networkimageview" "121","origen-sdk" "121","gcovr" "121","jackrabbit-oak" "121","ref-cursor" "121","express-gateway" "121","tivoli" "121","nowjs-sockets" "121","gcc4.8" "121","nstableviewcell" "121","no-op" "121","expectations" "121","uievent" "121","notsupportedexception" "121","azure-resource-graph" "121","peoplepicker" "121","access-keys" "121","omnicomplete" "121","android-recents" "121","react-native-animatable" "121","reactive-extensions-js" "121","react-native-ble-plx" "121","react-flow" "121","testdriven.net" "121","lsa" "121","qevent" "121","layered-navigation" "121","activestate" "121","sphinxql" "121","messageui" "121","ihttpmodule" "121","scriptable-object" "121","cxf-codegen-plugin" "121","partialfunction" "121","cyclic-dependency" "121","cydia-substrate" "121","idispatch" "121","hessian-matrix" "121","usertype" "121","subject-observer" "121","stm32cubemx" "121","ie11-developer-tools" "121","parallax.js" "121","spark-koalas" "121","avahi" "120","material-components-web" "120","flutter-doctor" "120","liquibase-sql" "120","yourkit" "120","yandex-maps" "120","trident" "120","ansys" "120","web-platform-installer" "120","template-method-pattern" "120","xsp" "120","ffmpeg-python" "120","jssc" "120","dataservice" "120","django-admin-tools" "120","childbrowser" "120","jt400" "120","discord-buttons" "120","bioperl" "120","contentsize" "120","xpathnavigator" "120","psr-0" "120","roboflow" "120","airwatch" "120","univocity" "120","session-hijacking" "120","dataflowtask" "120","ionic-cli" "120","money-format" "120","azure-dns" "120","sap-data-dictionary" "120","inputview" "120","nscombobox" "120","frameworkelement" "120","object-properties" "120","abstract-base-class" "120","java-canvas" "120","net-use" "120","netrw" "120","winrt-xaml-toolkit" "120","bug-reporting" "120","lzo" "120","kraken.js" "120","outlook-api" "120","wmd" "120","google-app-engine-php" "120","setw" "120","modelandview" "120","devkit" "120","schema-compare" "120","hardcoded" "120","notserializableexception" "120","numeric-limits" "120","tkcalendar" "120","xcode7.1" "120","horizon" "120","certificate-store" "120","android-jetpack-compose-text" "120","c-standard-library" "120","proximitysensor" "120","http-content-length" "120","qprinter" "120","combn" "120","cybersource" "120","bcel" "120","multi-database" "120","yui-datatable" "120","weave" "120","pari-gp" "120","arcanist" "120","stdint" "120","tournament" "120","uvc" "120","solana-cli" "120","stl-format" "120","sparkpost" "120","praat" "120","mediaextractor" "119","jest-puppeteer" "119","renovate" "119","clojure-core.logic" "119","printscreen" "119","edittextpreference" "119","wearables" "119","sites" "119","sshj" "119","tegra" "119","webpack-splitchunks" "119","edifact" "119","master-data-services" "119","ssdp" "119","mariadb-10.5" "119","blackberry-storm" "119","xmlnodelist" "119","select-menu" "119","filter-var" "119","graceful-degradation" "119","rml" "119","canon-sdk" "119","varray" "119","ruby-2.2" "119","vapor-fluent" "119","grails-4" "119","ibm-odm" "119","gui-builder" "119","invokelater" "119","boost-any" "119","e" "119","density-independent-pixel" "119","intermittent" "119","bootstrap-slider" "119","nebula-graph" "119","gulp-less" "119","inverse-kinematics" "119","abbyy" "119","code-standards" "119","kpi" "119","pymol" "119","oauth-provider" "119","visual-c++-2012" "119","codepoint" "119","observability" "119","sfspeechrecognizer" "119","output-formatting" "119","object-tag" "119","rexster" "119","buildship" "119","typescript1.4" "119","java1.4" "119","scramble" "119","radzen" "119","tadoquery" "119","gemspecs" "119","redisjson" "119","assume-role" "119","byebug" "119","chameleon" "119","spongycastle" "119","dtw" "119","react-360" "119","qcompleter" "119","react-data-table-component" "119","off-screen" "119","angular-activatedroute" "119","angular-cookies" "119","angular2-router" "119","liferay-service-builder" "119","sdl-mixer" "119","stateful-session-bean" "119","image-generation" "119","better-sqlite3" "119","sortedmap" "119","heterogeneous" "119","mstsc" "119","google-index" "118","backtrader" "118","stack-size" "118","flow-typed" "118","flutter-freezed" "118","lld" "118","lambda-authorizer" "118","firebase-admob" "118","cdialog" "118","firebase-invites" "118","makemigrations" "118","date-pipe" "118","next-intl" "118","swift-package" "118","fileset" "118","select2-rails" "118","window-soft-input-mode" "118","jint" "118","job-queue" "118","aws-lex" "118","r-rownames" "118","walmart-api" "118","unrar" "118","django-sites" "118","facter" "118","session-replication" "118","modulation" "118","mod-ssl" "118","grpc-c++" "118","samsung" "118","satisfiability" "118","erc721" "118","core-js" "118","applovin" "118","aws-sqs-fifo" "118","spring-security-kerberos" "118","crash-log" "118","porter-duff" "118","nssavepanel" "118","spring-autoconfiguration" "118","shader-graph" "118","branch-and-bound" "118","knative-serving" "118","domexception" "118","pytest-asyncio" "118","kotlin-interop" "118","lexicaljs" "118","sysml" "118","objective-c-swift-bridge" "118","ex-unit" "118","browser-tab" "118","shortest" "118","visualworks" "118","visited" "118","rda" "118","non-recursive" "118","cookieless" "118","cacti" "118","controller-advice" "118","xcode6.4" "118","haar-wavelet" "118","nowrap" "118","polyglot" "118","gcc4.9" "118","deviceiocontrol" "118","hiveddl" "118","execl" "118","gembox-spreadsheet" "118","g-code" "118","converse.js" "118","openmaptiles" "118","account-management" "118","monospace" "118","motif" "118","mosaic" "118","messagedialog" "118","log4js-node" "118","ldapjs" "118","elementhost" "118","qnetworkreply" "118","onclientclick" "118","geotagging" "118","elasticsearch-rails" "118","office-js-helpers" "118","ctype" "118","stripe.js" "118","iqkeyboardmanager" "118","tf-cli" "118","themeroller" "118","batchsize" "118","structuremap3" "118","amazon-keyspaces" "118","illuminate-container" "118","forall" "118","userspace" "118","automapper-6" "118","compound-index" "118","gm" "118","artifactory-query-lang" "118","custom-scrolling" "118","git-rm" "118","cyclic" "118","amazon-pay" "117","site-prism" "117","git-filter-repo" "117","st" "117","graphcool" "117","slimscroll" "117","lnk2005" "117","xsd2code" "117","remedy" "117","slidify" "117","ssis-2017" "117","github-app" "117","reportviewer2008" "117","youtube-analytics" "117","ccnet-config" "117","containable" "117","jsapi" "117","jsonreader" "117","sendinblue" "117","main-method" "117","cedar" "117","operator-sdk" "117","oracle8i" "117","readxml" "117","unsafemutablepointer" "117","airdrop" "117","windows-server-2022" "117","rebar3" "117","server-side-validation" "117","push-api" "117","angular-ngrx-data" "117","mongodb-shell" "117","onstart" "117","superpowered" "117","dynamicmethod" "117","nsexpression" "117","nebula" "117","ordereddict" "117","virtualpathprovider" "117","system.timers.timer" "117","sidenav" "117","wkhtmltoimage" "117","ezdxf" "117","golang-migrate" "117","browserify-shim" "117","mips64" "117","sfdc" "117","lynx" "117",".net-maui.shell" "117","typemock" "117","typo3-flow" "117","rewriting" "117","gogs" "117","amazon-workspaces" "117","fabricjs2" "117","asp.net-mvc-ajax" "117","reformat" "117","openlaszlo" "117","hadoop3" "117","android-gradle-3.0" "117","tlf" "117","openpose" "117","scite" "117","openshift-cartridge" "117","expires-header" "117","differentialequations.jl" "117","laravel-localization" "117","chai-as-promised" "117","iptc" "117","textinputlayout" "117","proxyquire" "117","logstash-logback-encoder" "117","qnap" "117","texreg" "117","strict-mode" "117","angular-cdk-virtual-scroll" "117","custom-properties" "117","property-list" "117","goal-tracking" "117","mean-square-error" "117","cyclejs" "117","zebra-puzzle" "117","tilt" "116","gitblit" "116","apache-commons-csv" "116","clicklistener" "116","fiji" "116","cmake-custom-command" "116","cloudcontrol" "116","probe" "116","editorjs" "116","wdf" "116","livenessprobe" "116","phpthumb" "116","console.readline" "116","xlc" "116","ngrx-store-4.0" "116","select-object" "116","flask-restless" "116","image-quality" "116","ccl" "116","adfs4.0" "116","kubernetes-security" "116","xgbclassifier" "116","kubernetes-networking" "116","ruby-mocha" "116","grails-2.4" "116","dnspython" "116","urlconf" "116","facial-identification" "116","namevaluecollection" "116","vcredist" "116","windows-dev-center" "116","ibm-cloud-storage" "116","sharepoint-2019" "116","share-open-graph" "116","wildfly-11" "116","callout" "116","data-acquisition" "116","waithandle" "116","watch-face-api" "116","kafka-rest" "116","border-image" "116","onsen-ui2" "116","create-function" "116","crafter-cms" "116","worker-process" "116","htmlbars" "116","gulp-protractor" "116","angstrom-linux" "116","natvis" "116","hssf" "116","wp-nav-walker" "116","winmm" "116","libev" "116","codelens" "116","kmm" "116","reversing" "116","libmysql" "116","kong-ingress" "116","libgosu" "116","model.matrix" "116","opennms" "116","opera-extension" "116","hololens-emulator" "116","playwright-java" "116","timer-jobs" "116","reference-wrapper" "116","tablerowsorter" "116","caffe2" "116","nvenc" "116","regfreecom" "116","characteristics" "116","essbase" "116","text-indent" "116","spir-v" "116","chart.js3" "116","log-shipping" "116","iggrid" "116","seam3" "116","hasownproperty" "116","stb-image" "116","ember-old-router" "116","idn" "116","toolstripmenu" "116","texturing" "116","zend-db-select" "116","subsampling" "116","auto-value" "116","force-download" "116","tf-slim" "116","avaudioplayernode" "116","quartile" "115","primality-test" "115","jenkins-docker" "115","github-api-v3" "115","trojan" "115","treesitter" "115","instruction-encoding" "115","reactor-kafka" "115","react-on-rails" "115","graphql-tools" "115","sstream" "115","phonetics" "115","co" "115","carryflag" "115","appfuse" "115","voicexml" "115","laravel-events" "115","cinder" "115","cclayer" "115","saleor" "115","smartfoxserver" "115","catalan" "115","angular-ui-router-extras" "115","pscp" "115","id3v2" "115","vdproj" "115","ajax-upload" "115","cs4" "115","windows-mobile-5.0" "115","aws-cdk-typescript" "115","createprocessasuser" "115","nscell" "115","errai" "115","payara-micro" "115","turing-complete" "115","initializing" "115","native-module" "115","android-usb" "115","azimuth" "115","borderpane" "115","infix-operator" "115","modular-design" "115","deployd" "115","ar.drone" "115","nssearchfield" "115","appintents" "115","entrust" "115","8085" "115","ampscript" "115","pyjwt" "115","viewexpiredexception" "115","setupapi" "115","neventstore" "115","oracle-ucm" "115","4d-database" "115","asyncdisplaykit" "115","domready" "115","ixmlserializable" "115","hitcounter" "115","android-gui" "115","cooja" "115","quicksand" "115","hiphop" "115","protobuf.js" "115","layered" "115","launchpad" "115","odf" "115","pen" "115","location-provider" "115","mesibo" "115","off-canvas-menu" "115","react-native-debugger" "115","qbs" "115","google-fit-api" "115","node-fibers" "115","maxent" "115","qtscript" "115","mbaas" "115","gnu-smalltalk" "115","url-masking" "115","line-by-line" "115","elsa-workflows" "115","beaker" "115","fontmetrics" "115","std-bitset" "115","zclip" "115","google-smartlockpasswords" "115","sup" "115","zbuffer" "114","muse" "114","websocket-sharp" "114","widestring" "114","process-pool" "114","decibel" "114","multiple-views" "114","graphstream" "114","backing-beans" "114","multiple-processes" "114","sketchapp" "114","conio" "114","xinclude" "114","mapsforge" "114","runatserver" "114","connect-mongo" "114","socket.io-redis" "114","filenotfounderror" "114","software-defined-radio" "114","laravel-filesystem" "114","smooth-streaming" "114","construct-2" "114","python-playsound" "114","physx" "114","firefox3.6" "114","gpars" "114","factories" "114","jpasswordfield" "114","docker-engine" "114","captions" "114","data-connections" "114","agens-graph" "114","episerver-7" "114","dynamics-al" "114","demandware" "114","azure-devops-migration-tools" "114","gulp-4" "114","system-shutdown" "114","uiaccelerometer" "114","shinybs" "114","typeform" "114","visual-format-language" "114","azure-notebooks" "114","hm-10" "114","taco" "114","dimensional" "114","azure-spatial-anchors" "114","android-instant-run" "114","vetur" "114","hamiltonian-cycle" "114","asp.net-1.1" "114","opensearch-dashboards" "114","low-memory" "114","google-cloud-identity" "114","angularjs-animation" "114","specification-pattern" "114","acm-java-libraries" "114","offloading" "114","generic-lambda" "114","reactive-banana" "114","pyvis" "114","collabnet" "114","pardot" "114","libxslt" "114","sdf" "114","flutter-objectbox" "114","zapier-cli" "114","complement" "114","struts2-json-plugin" "114","autocmd" "114","zend-controller" "114","qt5.3" "114","shellsort" "114","zero-padding" "113","eclipse-virgo" "113","jenkins-email-ext" "113","inspection" "113","feedburner" "113","squirrel.windows" "113","react-router-component" "113","tempus-dominus-datetimepicker" "113","clasp" "113","primeng-table" "113","xslcompiledtransform" "113","tree-structure" "113","nexus-4" "113","flask-restx" "113","jsr310" "113","freshdesk" "113","xpsdocument" "113","construction" "113","jsonapi-resources" "113","futex" "113","serverless-offline" "113","oracle-apex-18.2" "113","meta-search" "113","django-simple-history" "113","icinga" "113","avaya" "113","avurlasset" "113","django-flatpages" "113","facescontext" "113","rllib" "113","kingswaysoft" "113","document-based" "113","angularjs-select" "113","alfresco-enterprise" "113","unnotificationrequest" "113","khan-academy" "113","keytab" "113","angular-openlayers" "113","aws-sdk-ios" "113","jquery-1.9" "113","svn-merge" "113","wp-graphql" "113","corner-detection" "113","survminer" "113","ttkwidgets" "113","bottom-navigation-bar" "113","delphi-12-athens" "113","html5lib" "113","native-methods" "113","appletviewer" "113","error-detection" "113","rightbarbuttonitem" "113","rational-number" "113","virtual-pc" "113","system.componentmodel" "113","janus-gateway" "113","buck" "113","code.org" "113","rasa-x" "113","extras" "113","ravendb-studio" "113","object-graph" "113","virtual-attribute" "113","wmode" "113","organizer" "113","pydantic-v2" "113","vertical-text" "113","schannel" "113","expression-templates" "113","bunyan" "113","xcdatamodel" "113","gwt-ext" "113","happy" "113","timed" "113","android-intent-chooser" "113","acr" "113","splidejs" "113","chai-http" "113","ceylon" "113","oncreateoptionsmenu" "113","qlistwidgetitem" "113","google-cloud-armor" "113","memcmp" "113","mps" "113","respond-to" "113","customtaskpane" "113","amazonsellercentral" "113","zend-paginator" "113","embedded-sql" "113","automapper-2" "113","mechanicalsoup" "113","qtoolbar" "113","maven-enforcer-plugin" "113","web-developer-toolbar" "112","listctrl" "112","srgb" "112","ef-core-8.0" "112","xrandr" "112","dbx" "112","clearance" "112","flipclock" "112","ec2-api-tools" "112","skype-bots" "112","ebay-sdk" "112","site-packages" "112","class-constructors" "112","mvcmailer" "112","vue-cli-4" "112","mura" "112","intel-galileo" "112","xz" "112","file-uri" "112","image-morphology" "112","freetext" "112","django-admin-actions" "112","fitdistrplus" "112","self-contained" "112","uiview-hierarchy" "112","flash-cs5.5" "112","pact-jvm" "112","pushbullet" "112","agents" "112","react-testing" "112","mysql-5.1" "112","jmodelica" "112","rot13" "112","datagridtextcolumn" "112","method-swizzling" "112","rowlocking" "112","django-model-field" "112","avro-tools" "112","micronaut-client" "112","django-static" "112","pspdfkit" "112","blazor-jsinterop" "112","jquery-lazyload" "112","mongodb-realm" "112","opencv-stitching" "112","arangojs" "112","mod-headers" "112","surrogate-key" "112","surrogate-pairs" "112","post-meta" "112","easyocr" "112","typecast-operator" "112","wurfl" "112","mongo-collection" "112","winrt-component" "112","java.library.path" "112","rhadoop" "112","ocaml-dune" "112","formflow" "112",".net-3.0" "112","gob" "112","sql-returning" "112","reed-solomon" "112","droplet" "112","dgraph" "112","directorysearcher" "112","happens-before" "112","business-objects-sdk" "112","dialyzer" "112","excel-web-query" "112","dotnetnuke-9" "112","mockups" "112","c++builder-2010" "112","spring-tools-4" "112","storage-class-specifier" "112","angularjs-controlleras" "112","cfspreadsheet" "112","geomap" "112","test-environments" "112","moovweb" "112","nodejitsu" "112","react-animations" "112","android-parser" "112","mbox" "112","suave" "112","web-animations" "112","solana-program-library" "112","multi-layer" "112","google-prediction" "112","thorntail" "112","glcm" "112","focusout" "111","balloon" "111","federated" "111","ggsave" "111","deferred-loading" "111","sitemap.xml" "111","apache-cloudstack" "111","remoteapp" "111","bacnet" "111","db-browser-sqlite" "111","apache-spark-1.6" "111","landsat" "111","black-box-testing" "111","apache-stringutils" "111","python-newspaper" "111","checkpointing" "111","apache-poi-4" "111","connection-pool" "111","chron" "111","ccache" "111","grails-3.3" "111","oracle21c" "111","roguelike" "111","datagridviewrow" "111","django-pipeline" "111","fast-forward" "111","watson-dialog" "111","valarray" "111","jodit" "111","share-intent" "111","jongo" "111","hyperledger-indy" "111","database-link" "111","keynote" "111","iasyncresult" "111","rootfs" "111","wcf-configuration" "111","nest-device-access" "111","pcfdev" "111","infopath-2007" "111","paster" "111","turbine" "111","turbogears" "111","appium-java" "111","nsnetservice" "111","path-parameter" "111","boost-signals2" "111","enterprise-distribution" "111","dwt" "111","epsg" "111","pdfjs-dist" "111","sidecar" "111","uglifyjs2" "111","syntax-checking" "111","microtime" "111",".net-4.7" "111","wixsharp" "111","libmemcached" "111","osi" "111","uclibc" "111","gdt" "111","mmx" "111","scalapb" "111","digital-ocean-spaces" "111","happstack" "111","expr" "111","expression-blend-4" "111","efxclipse" "111","restheart" "111","testify" "111","spectron" "111","memory-consumption" "111","hxt" "111","react-error-boundary" "111","qdap" "111","laravel-scheduler" "111","log4perl" "111","mcu" "111","three-tier" "111","bass" "111","lime" "111","dajaxice" "111","array-column" "111","web-component-tester" "111","yui-pure-css" "111","thai" "111","subgit" "111","heic" "111","googlesigninaccount" "111","urlhelper" "110","defaults" "110","phalcon-routing" "110","dbghelp" "110","vue-native" "110","stackmob" "110","github-issues" "110","getserversideprops" "110","instafeedjs" "110","munin" "110","flutter-cubit" "110","web-publishing" "110","sslv3" "110","backstage" "110","remarkjs" "110","multiplicity" "110","xxd" "110","team-explorer-everywhere" "110","remote-execution" "110","flipper" "110","seleniumwire" "110","freshmvvm" "110","xquartz" "110","xml-simple" "110","laravel-form" "110","frontpage" "110","voila" "110","data-mapping" "110","xlsb" "110","ng-admin" "110","kubeconfig" "110","run-script" "110","micro-architecture" "110","jobservice" "110","documentfilter" "110","aws-ebs" "110","aws-ecr" "110","fal" "110","ibm-jazz" "110","recaptcha-enterprise" "110","database-sequence" "110","rolling-average" "110","boost-multi-array" "110","ncdf4" "110","salesforce-chatter" "110","nested-json" "110","ionic7" "110","spring-cloud-kubernetes" "110","katalon-recorder" "110","cortex-a8" "110","n-dimensional" "110","nspersistentcloudkitcontainer" "110","worklight-runtime" "110","azure-backup-vault" "110","android-tabbed-activity" "110","neo4jphp" "110","cpu-time" "110","konsole" "110","visual-c++-2005" "110","extended-events" "110","type-definition" "110","golem" "110","netbeans-11" "110","java-15" "110","knuth-morris-pratt" "110","javapos" "110","google-breakpad" "110","pocketsphinx-android" "110","differential-evolution" "110","to-json" "110","didset" "110","draft-js-plugins" "110","bullmq" "110","cac" "110","difftool" "110","asp-net-core-spa-services" "110","plural" "110","openoffice-basic" "110","vertex-array" "110","dottrace" "110","sql-data-warehouse" "110","dronekit" "110","executors" "110","android-immersive" "110","schemacrawler" "110","messagekit" "110","responsive-slides" "110","testfx" "110","splunk-formula" "110","ceres-solver" "110","ios-background-mode" "110","odp.net-managed" "110","odata4j" "110","cold-start" "110","text2vec" "110","everyauth" "110","google-pixel" "110","urql" "110","webkitgtk" "110","lint-staged" "110","imagecreatefrompng" "110","shift-jis" "110","mds" "110","font-lock" "110","mta" "110","thread-sanitizer" "110","arity" "110","endpoints-proto-datastore" "110","prettier-vscode" "110","powerpoint-2013" "110","engineyard" "110","git-patch" "109","multiversx" "109","efk" "109","react-portal" "109","ckrecord" "109","flutter-custompainter" "109","tekton-pipelines" "109","telepot" "109","vstest.console.exe" "109","livewire-3" "109","teardown" "109","ggridges" "109","pkcs#8" "109","json-serializable" "109","dbcc" "109","pkcs11interop" "109","appgallery-connect" "109","chrome-debugging" "109","snowsql" "109","pandas-melt" "109","flashbuilder4" "109","fullcalendar-6" "109","self-invoking-function" "109","dithering" "109","oz" "109","salat" "109","meteor-publications" "109","fairplay" "109","icinga2" "109","cakephp-3.1" "109","recursion-schemes" "109","mysql-variables" "109","methodhandle" "109","hyperterminal" "109","html.textboxfor" "109","popcornjs" "109","android-xmlpullparser" "109","spring-context" "109","gtmetrix" "109","openfeint" "109","scala-2.13" "109","info-plist" "109","android-vpn-service" "109","opencv-solvepnp" "109","twitterkit" "109","rinside" "109","formsauthentication" "109","wing-ide" "109","brython" "109","eyeshot" "109","py-datatable" "109","pyrevit" "109","rasterize" "109","async-pipe" "109","forgerock" "109","type-signature" "109","vertx-eventbus" "109","xcode9.4" "109","openpop" "109","xcode11.3" "109","xcode11.4" "109","time-wait" "109","cadence" "109","openrewrite" "109","drools-kie-server" "109","bz2" "109","dstream" "109","mixitup" "109","hibernate-native-query" "109","qvtkwidget" "109","asp.net-web-api-helppages" "109","stripslashes" "109","cfdocument" "109","mercurial-extension" "109","lark-parser" "109","laravel-medialibrary" "109","meta-key" "109","prolog-dif" "109","challenge-response" "109","lsmeans" "109","mp4box" "109","getcwd" "109","esi" "109","nodegit" "109","longest-path" "109","angular-calendar" "109","react-markdown" "109","currency-exchange-rates" "109","specs" "109","generic-foreign-key" "109","global-scope" "109","yubikey" "109","qt5.7" "109","secure-gateway" "109","powermanager" "109","array-multisort" "109","quantile-regression" "109","maven-module" "109","bcrypt-ruby" "109","cvx" "109","artillery" "109","touchxml" "109","tidygraph" "108","cmsamplebuffer" "108","multiple-dispatch" "108","wdio" "108","flutter-form-builder" "108","treemodel" "108","git-bisect" "108","econnrefused" "108","apacheignite" "108","wicked-gem" "108","clojure-contrib" "108","musicbrainz" "108","trimesh" "108","fido-u2f" "108","eda" "108","yasnippet" "108","closest-points" "108","frege" "108","carrot2" "108","bisect" "108","flask-mysql" "108","uncaughtexceptionhandler" "108","oxygene" "108","firefox-marionette" "108","fl-chart" "108","congestion-control" "108","pythoncom" "108","adaptive-layout" "108","kentor-authservices" "108","vue-transitions" "108","windows-search" "108","aggregator" "108","johnsnowlabs-spark-nlp" "108","crossover" "108","candy-machine" "108","options-menu" "108","gradle-experimental" "108","uppy" "108","mysqldatareader" "108","hyperledger-explorer" "108","bpmn.io" "108","easyhook" "108","ndimage" "108","html5-template" "108","kademlia" "108","errorprovider" "108","julia-plots" "108","gulp-inject" "108","viewstub" "108","microsoft-planner" "108","java-service-wrapper" "108","rich-internet-application" "108","go-interface" "108","sigaction" "108","wma" "108","viewparams" "108","microsoft-information-protection" "108","vis.js-timeline" "108","ext2" "108","pytest-html" "108","downtime" "108","gd2" "108","notion" "108","isis" "108","mlmodel" "108","assembly-loading" "108","npm-live-server" "108","numerical-stability" "108","hierarchical-bayesian" "108","device-detection" "108","tango" "108","mlt" "108","http-status-code-422" "108","acronym" "108","mozilla-deepspeech" "108","ltree" "108","laravel-resource" "108","angular7-router" "108","elasticsearch-hadoop" "108","messageformat" "108","android-lru-cache" "108","propertychangelistener" "108","getprocaddress" "108","sphero-api" "108","pffile" "108","hc-05" "108","amazon-kcl" "108","arduino-yun" "108","encodable" "108","autovacuum" "108","bessel-functions" "108","predicates" "108","successor-arithmetics" "108","zoho-deluge" "108","studio3t" "108","linq.js" "108","argo" "107","telerik-appbuilder" "107","program-counter" "107","jdi" "107","mutual-recursion" "107","feature-descriptor" "107","sql-workbench-j" "107","matlab-gui" "107","ggbiplot" "107","ape" "107","vs-community-edition" "107","pageable" "107","rx-kotlin2" "107","software-packaging" "107","xml-dsig" "107","advanced-filter" "107","vmware-tools" "107","next-images" "107","safe-mode" "107","python-black" "107","page-size" "107","sakai" "107","uninitialized-constant" "107","readonly-collection" "107","windows-live" "107","keyboard-input" "107","meta-query" "107","validating" "107","camanjs" "107","surrealdb" "107","delete-directory" "107","enqueue" "107","boundfield" "107","pdfptable" "107","juniper" "107","sarama" "107","kaldi" "107","ion-slides" "107","jasny-bootstrap" "107","codecov" "107","r-future" "107","orange-pi" "107","magickwand" "107","visualstates" "107","tabbing" "107","ambiguous-call" "107","forums" "107","shadowjar" "107","android-authenticator" "107","go-html-template" "107","visual-tree" "107","shaka" "107","external-project" "107","rfc3339" "107","javapoet" "107","bucket-sort" "107","system.management" "107","libjpeg-turbo" "107","virus-scanning" "107","openvz" "107","sqlproj" "107","cookiecontainer" "107","wxtextctrl" "107","xcode-command-line-tools" "107","uicollectionviewdelegate" "107","novacode-docx" "107","azure-hybrid-connections" "107","openproject" "107","dotty" "107","tinyxml2" "107","r2dbc-postgresql" "107","xamlreader" "107","drawing2d" "107","android-implicit-intent" "107","jamstack" "107","c++-templates" "107","react-google-maps-api" "107","office-app" "107","lokijs" "107","cfstring" "107","pgcrypto" "107","on-demand-resources" "107","cf-bosh" "107","qlik-expression" "107","lockfile" "107","spinnaker-halyard" "107","multer-gridfs-storage" "107","parallelism-amdahl" "107","transfer-function" "107","daemons" "107","ford-fulkerson" "107","v4l2loopback" "107","glossary" "107","seccomp" "107","linklabel" "107","amazon-echo" "107","embedded-video" "107","usergrid" "107","linkageerror" "107","google-play-integrity-api" "107","gnu-prolog" "106","web-user-controls" "106","github-webhook" "106","coc.nvim" "106","trustzone" "106","installshield-2010" "106","cloudfiles" "106","slidingpanelayout" "106","filefilter" "106","class-table-inheritance" "106","x-ray" "106","jde" "106","jcarousellite" "106","mumin" "106","xdocreport" "106","mappedsuperclass" "106","fsync" "106","python-fu" "106","console-output" "106","unison" "106","apollostack" "106","smarty2" "106","connect-flash" "106","freopen" "106","python-object" "106","sef" "106","doevents" "106","jimp" "106","rn-fetch-blob" "106","unobtrusive-ajax" "106","singleton-type" "106","ib-api" "106","server.transfer" "106","realbasic" "106","docblocks" "106","server-action" "106","warehouse" "106","azure-digital-twins" "106","nsresponder" "106","cornerstone" "106","android-sms" "106","twitter-search" "106","patsy" "106","bootstrap-material-design" "106","openaiembeddings" "106","nestjs-passport" "106","grunt-contrib-connect" "106","infovis" "106","application-error" "106","apple-wallet" "106","gst-launch" "106","spring-boot-devtools" "106","spring-security-saml2" "106","android-account" "106","codeigniter-form-helper" "106","typescript1.6" "106","shinyproxy" "106","systray" "106","doobie" "106","wordpress-admin" "106","javax.validation" "106","kruskal-wallis" "106","shrinkwrap" "106","pyhive" "106","android-build-type" "106","tlv" "106","hipaa" "106","bull" "106","springsource" "106","explicit-conversion" "106","handwriting" "106","quoted-printable" "106","express-4" "106","hivecontext" "106","expdp" "106","rabin-karp" "106","nvim-lspconfig" "106","redmine-api" "106","xcode-project" "106","gameboy" "106","xauth" "106","scipy-spatial" "106","nicescroll" "106","large-file-upload" "106","qdatastream" "106","stretching" "106","angular-highcharts" "106","qheaderview" "106","android-jetpack-compose-list" "106","eip" "106","speed-test" "106","memory-fences" "106","getgauge" "106","locomotive-scroll" "106","compound-assignment" "106","utilization" "106","sparkle" "106","automapper-5" "106","spark-kafka-integration" "106","sdcc" "106","transcode" "106","automatic-license-plate-recognition" "106","dartium" "106","tracelistener" "106","imagekit" "106","text-widget" "106","linear-discriminant" "105","vt100" "105","tsd" "105","matlab-class" "105","git-difftool" "105","feed-forward" "105","cls-compliant" "105","graph-drawing" "105","graphicimage" "105","apache-chemistry" "105","graphql-dotnet" "105","python-install" "105","aether" "105","ultraedit" "105","fixest" "105","cinema-4d" "105","xodus" "105","fileopendialog" "105","mail-sender" "105","packagereference" "105","fts4" "105","snowpack" "105","cdr" "105","soci" "105","switchcompat" "105","aweber" "105","windows64" "105","callouts" "105","vuex4" "105","i18n-gem" "105","aws-iam-policy" "105","serverspec" "105","sitecore9" "105","windev" "105","faust" "105","icloud-api" "105","django-redis" "105","boost-process" "105","pdfstamper" "105","boost-range" "105","enterprisedb" "105","http3" "105","deleted-functions" "105","sas-studio" "105","android-wrap-content" "105","craftyjs" "105","createcriteria" "105","sap-pi" "105","mongoose-im" "105","hpple" "105","objectdb" "105","rich" "105","new-project" "105","object-construction" "105","atg-dynamo" "105","pytesser" "105","facebooker" "105","sigar" "105","bsp" "105","dongle" "105","ats" "105","rclone" "105","xapian" "105","tkinter-label" "105","scotty" "105","sqlfilestream" "105","hgrc" "105","number-systems" "105","bytearrayinputstream" "105","ml-agent" "105","podscms" "105","cookie-authentication" "105","numpy-memmap" "105","coqide" "105","stompjs" "105","espeak" "105","ldapconnection" "105","event-dispatching" "105","office-ui-fabric-react" "105","iris-dataset" "105","metafile" "105","cgpdfdocument" "105","exc-bad-instruction" "105","ole-automation" "105","resharper-8.0" "105","textmeshpro" "105","mosek" "105","terraform-cloud" "105","react-android" "105","stty" "105","dam" "105","url-validation" "105","auto-renewable" "105","tidb" "105","architectural-patterns" "105","bcmath" "105","fody-costura" "104","gridviewcolumn" "104","matrix-decomposition" "104","background-attachment" "104","repa" "104","eflags" "104","git-credential-manager" "104","ssl-client-authentication" "104","phinx" "104","php-amqplib" "104","phong" "104","relu" "104","procrun" "104","datetime-comparison" "104","symfony-process" "104","volume-rendering" "104","rweka" "104","cbor" "104","safetynet" "104","xgettext" "104","sw-precache" "104","nginfinitescroll" "104","pivotviewer" "104","flask-peewee" "104","pikaday" "104","adlds" "104","casl" "104","ng2-file-upload" "104","microblaze" "104","roo" "104","jira-zephyr" "104","airbrake" "104","ora-01722" "104","angular-kendo" "104","metaspace" "104","akka-supervision" "104","wcftestclient" "104","psycopg3" "104","jqassistant" "104","capnproto" "104","sinatra-activerecord" "104","psake" "104","servicecontroller" "104","simperium" "104","dyndns" "104","justmock" "104","sas-token" "104","mongoid4" "104","android-wear-notification" "104","post-install" "104","htmltext" "104","aws-sdk-ruby" "104","guice-3" "104","passport-azure-ad" "104","horizontal-line" "104","wordpress-thesis-theme" "104","wordsearch" "104","bpl" "104","onreadystatechange" "104","bq" "104","coin-or-cbc" "104","orphan" "104","wns" "104","java-13" "104","pysvn" "104","return-code" "104","cocos2d-x-2.x" "104","net-sftp" "104","krakend" "104","donations" "104","attr-accessible" "104","ou" "104","wix3.9" "104","facebook-credits" "104","sql-convert" "104","home-button" "104","tcserver" "104","azure-servicebusrelay" "104","sql-mode" "104","hkhealthstore" "104","model-comparison" "104","aspnetdb" "104","uicontrolevents" "104","gwt-maven-plugin" "104","hiccup" "104","nsusernotification" "104","open-with" "104","redhat-containers" "104","requesthandler" "104","hungarian-algorithm" "104","angularfire5" "104","tomtom" "104","chaos" "104","geoxml3" "104","android-number-picker" "104","flwor" "104","ms-yarp" "104","prefab" "104","stem" "104","sharpssh" "104","git-tower" "104","benchmarkdotnet" "104","powerview" "104","amazon-qldb" "104","sonarlint-eclipse" "104","spanning-tree" "104","max-msp-jitter" "104","webmatrix-2" "103","editmode" "103","base64url" "103","pgzero" "103","efficientnet" "103","php-di" "103","ghostscript.net" "103","widget-test-flutter" "103","greasemonkey-4" "103","lms" "103","mutablelist" "103","webresource" "103","ggtern" "103","php-deployer" "103","yandex-api" "103","flutter-dropdownbutton" "103","photoimage" "103","ecs-taskdefinition" "103","flask-marshmallow" "103","soc" "103","ng-init" "103","plack" "103","file-properties" "103","fitness" "103","display-templates" "103","immediate-operand" "103","datetime64" "103","admin-rights" "103","cdecl" "103","circlize" "103","googleway" "103","database-agnostic" "103","django-modeltranslation" "103","routines" "103","serviceconnection" "103","dmn" "103","sharepointframework" "103","key-generator" "103","meter" "103","ibm-cloud-tools" "103","gopath" "103","roots-sage" "103","hyperjaxb" "103","dm" "103","azure-devops-server-2020" "103","spring-boot-configuration" "103","enumset" "103","position-independent-code" "103","jquery-countdown" "103","mongolite" "103","nscopying" "103","nats-streaming-server" "103","jquerydatetimepicker" "103","jquery-dynatree" "103","deinit" "103","extension-function" "103","wolfram-language" "103","google-chrome-frame" "103","luaj" "103","java.lang.class" "103","osmf" "103","object-relational-model" "103","microsoft-reporting" "103","synthetic" "103","word-2013" "103","external-links" "103","uber-cadence" "103","google-anthos" "103","retrolambda" "103","luminus" "103","tds" "103","tipsy" "103","azure-pipelines-release-task" "103","uiautomatorviewer" "103","busy-waiting" "103","expressionbuilder" "103","tclsh" "103","export-to-word" "103","tapku" "103","diameter-protocol" "103","higher-rank-types" "103","request-uri" "103","colorfilter" "103","android-jetpack-compose-canvas" "103","csvtojson" "103","esri-maps" "103","httpie" "103","angular18" "103","angular-hybrid" "103","logoff" "103","huggingface-trainer" "103","promise.all" "103","pyuic" "103","google-code-prettify" "103","combiners" "103","ejabberd-api" "103","laravel-session" "103","ids" "103","identity-insert" "103","array-agg" "103","security-context" "103","zend-cache" "103","embeddedwebserver" "103","asdf-vm" "103","idfa" "103","amazon-personalize" "103","zero-copy" "103","web-extension" "103","biginsights" "103","lightopenid" "103","flutter-platform-channel" "103","gloss" "103","qtconsole" "103","gkturnbasedmatch" "103","lifetime-scoping" "103","git-repo" "103","submitchanges" "103","foldleft" "103","google-shopping-api" "102","multi-master-replication" "102","jcr-sql2" "102","ggtree" "102","eclim" "102","xval" "102","phoenix-channels" "102","trigram" "102","sslcontext" "102","multiple-resultsets" "102","grinder" "102","installed-applications" "102","clrstoredprocedure" "102","truthiness" "102","class-extensions" "102","filesort" "102","sails-postgresql" "102","adx" "102","rivets.js" "102","sendasynchronousrequest" "102","p4python" "102","ui-virtualization" "102","aeron" "102","python-datamodel" "102","s4hana" "102","consteval" "102","xpo" "102","circleci-workflows" "102","datamaps" "102","cinnamon" "102","data-security" "102","crosstalk" "102","go-reflect" "102","rebol2" "102","johnny-five" "102","rotateanimation" "102","microsoft-bits" "102","kendo-listview" "102","rowcommand" "102","simple-peer" "102","password-less" "102","sar" "102","android-twitter" "102","epicorerp" "102","openexr" "102","dymo" "102","nscharacterset" "102","boost-optional" "102","approximate" "102","inherited" "102","scala-2.9" "102","neomodel" "102","silktest" "102","jquery-calculation" "102","netbsd" "102","codewarrior" "102","retrypolicy" "102","video-embedding" "102","raty" "102","visual-studio-6" "102","r-bigmemory" "102","system-information" "102","code-sharing" "102","abstract-type" "102","razorgenerator" "102","scalaz7" "102","plug" "102","sqlalchemy-migrate" "102","talend-mdm" "102","sqlcipher-android" "102","tinyint" "102","gcdwebserver" "102","gdbus" "102","redefine" "102","openpdf" "102","android-dialer" "102","table-locking" "102","common-controls" "102","reactivesearch" "102","stream-socket-client" "102","testcontainers-junit5" "102","node-amqp" "102","cubic" "102","string-function" "102","mpv" "102","customizing" "102","texteditingcontroller" "102","activedirectorymembership" "102","maven-ear-plugin" "102","webkit-transform" "102","alternating" "102","quickbase" "102","linkerd" "102","shdocvw" "102","fly" "102","traceur" "102","git-stage" "102","qt-jambi" "102","ms-project-server-2013" "102","cypress-custom-commands" "102","autolink" "102","pass-by-pointer" "102","glassfish-embedded" "102","powerline" "102","alpacajs" "101","massive" "101","staggeredgridlayout" "101","markov-models" "101","grommet" "101","annotation-processor" "101","ghcjs" "101","defaultmodelbinder" "101","cloudpebble" "101","gettimeofday" "101","file-listing" "101","distinct-on" "101","select-options" "101","appframework" "101","vorbis" "101","rx-binding" "101","pythonista" "101","swoole" "101","nexus-s" "101","marie" "101","django-extensions" "101","cryptographic-hash-function" "101","kie-server" "101","agenda" "101","kendo-editor" "101","tuleap" "101","dependencyobject" "101","surfaceflinger" "101","wpd" "101","typed" "101","delegatecommand" "101","inout" "101","jython-2.5" "101","android-shapedrawable" "101","google-amp" "101","java-package" "101","ubuntu-15.10" "101","form-api" "101","google-app-invites" "101","coff" "101","ab-initio" "101","ucp" "101","type-variables" "101","extended-properties" "101","double-free" "101","contenttype" "101","titleview" "101","execjs" "101","xcconfig" "101","android-graphics" "101","convex-polygon" "101","aspnet-regiis.exe" "101","dstu2-fhir" "101","dtexec" "101","gae-eclipse-plugin" "101","null-character" "101","tombstone" "101","dotcms" "101","azure-scheduler" "101","jama" "101","character-class" "101","tombstoning" "101","google-cloud-source-repos" "101","membase" "101","meilisearch" "101","android-renderscript" "101","hy" "101","hydra" "101","huawei-push-notification" "101","qscintilla" "101","compareobject" "101","strongly-typed-view" "101","getcomputedstyle" "101","node-commander" "101","omxplayer" "101","angular-compiler" "101","celluloid" "101","activity-transition" "101","zstd" "101","mpxj" "101","amazon-dynamodb-dax" "101","glasspane" "101","tornado-motor" "101","quantreg" "101","customscrollview" "101","subrepos" "101","com-port" "101","multidatatrigger" "101","gn" "100","sketchflow" "100","intel-pmu" "100","edge-list" "100","renpy" "100","apache-atlas" "100","local-datastore" "100","class-visibility" "100","mvn-repo" "100","x-xsrf-token" "100","skyfield" "100","editcontrol" "100","webui" "100","flare" "100","immutables-library" "100","jsobject" "100","adobe-captivate" "100","volume-shadow-service" "100","cedit" "100","sage-erp" "100","chord" "100","xdt-transform" "100","language-theory" "100","container-view" "100","flask-bootstrap" "100","blackberry-android" "100","maintenance-plan" "100","nameof" "100","documentfragment" "100","ora-00933" "100","jmx-exporter" "100","kendo-autocomplete" "100","django-logging" "100","gopro" "100","ajax-polling" "100","dmz" "100","recarray" "100","iboutletcollection" "100","carddav" "100","simplecart" "100","dep" "100","bpopup" "100","cpputest" "100","postgres-9.6" "100","jrules" "100","jrockit" "100","corona-storyboard" "100","onlyoffice" "100","postgresql-9.0" "100","guice-servlet" "100","border-box" "100","ws-addressing" "100","nsoutputstream" "100","inherited-resources" "100","wsp" "100","http.client" "100","apple-developer-account" "100","viper-go" "100","system.xml" "100","3gp" "100","missing-features" "100","mahalanobis" "100","netapp" "100","otree" "100","shadows" "100","typesetting" "100","kogito" "100","formvalidation.io" "100","returnurl" "100","netflow" "100","time-tracking" "100","target-framework" "100","scopus" "100","sqlite.net" "100","deviation" "100","tcmalloc" "100","gacutil" "100","gadfly" "100","assembly-signing" "100","mkpointannotation" "100","xceed-datagrid" "100","tablet-pc" "100","uisplitview" "100","galleryview" "100","non-printing-characters" "100","mercure" "100","specrun" "100","android-resolution" "100","mpd" "100","duplicate-symbol" "100","memory-leak-detector" "100","elasticsearch-curator" "100","quest" "100","use-strict" "100","start-stop-daemon" "100","gluonfx" "100","webflux" "100","stardog" "100","concurrent-collections" "100","forced-unwrapping" "100","parametric-equations" "100","webpack-dev-middleware" "100","webpack-html-loader" "100","powerpoint-addins" "100","zarr" "100","questasim" "99","background-mode" "99","ggproto" "99","react-relay" "99","git-detached-head" "99","maven-bom" "99","photography" "99","php-ews" "99","yarn-lock.json" "99","cmtime" "99","mybatis-generator" "99","mathjs" "99","client-side-templating" "99","listgrid" "99","ecm" "99","eclipse-gmf" "99","grid-computing" "99","multi-tier" "99","reloading" "99","paintcode" "99","affdex-sdk" "99","ng-content" "99","xfs" "99","mapdb" "99","advertisement-server" "99","sentinel2" "99","django-auth-ldap" "99","rstatix" "99","crittercism" "99","fastlane-match" "99","vagrant-plugin" "99","false-sharing" "99","aws-codestar" "99","unitywebrequest" "99","rmongodb" "99","aif" "99","oracle-sql-data-modeler" "99","microsoft-dynamics-nav" "99","nscollectionviewitem" "99","kcachegrind" "99","cpp-core-guidelines" "99","android-textureview" "99","nested-repeater" "99","postgresql-json" "99","sigpipe" "99","pax" "99","pdftools" "99","application-state" "99","satellite-assembly" "99","bluesnap" "99","app-update" "99","entitygraph" "99","entity-sql" "99","android-binding-adapter" "99","pysolr" "99","winzip" "99","extending-classes" "99","word-interop" "99","obsidian" "99","output-redirect" "99","orchardcms-1.9" "99","atmega32" "99","ublas" "99","systemd-journald" "99","object-composition" "99","return-by-reference" "99","devil" "99","nvme" "99","nvelocity" "99","c4" "99","nodeunit" "99","caemitterlayer" "99","novell" "99","excel-udf" "99","mod-auth-openidc" "99","tmlanguage" "99","tmpfs" "99","quine" "99","modeless" "99","assemblyscript" "99","exim4" "99","handheld" "99","r2jags" "99","scalaquery" "99","gdcm" "99","expandablerecyclerview" "99","leanft" "99","css-mask" "99","ios6-maps" "99","hunchentoot" "99","angularjs-bootstrap" "99","monkeytalk" "99","nixpkgs" "99","ios9.2" "99","eshell" "99","qdebug" "99","strchr" "99","menu-items" "99","protovis" "99","iptv" "99","qeventloop" "99","suitecommerce" "99","bidirectional-relation" "99","imagej-macro" "99","ms-solver-foundation" "99","google-translator-toolkit" "99","hello.js" "99","zipper" "99","qstackedwidget" "99","autodiff" "99","parametrized-testing" "99","sector" "99","sectionheader" "99","iedriverserver" "99","asiformdatarequest" "99","elytron" "99","tika-server" "99","spacy-transformers" "99","query-by-example" "99","qtabbar" "99","best-fit-curve" "99","ildasm" "99","zeus" "99","topicmodels" "99","ieaddon" "98","jboss-mdb" "98","cnc" "98","ssis-2016" "98","temporary-directory" "98","class-constants" "98","jcanvas" "98","phobos" "98","jest-fetch-mock" "98","sliders" "98","fiber" "98","jettison" "98","self-type" "98","xenapp" "98","distributed-testing" "98","inappsettingskit" "98","python-trio" "98","xmlspy" "98","language-concepts" "98","jtidy" "98","rust-warp" "98","rust-actix" "98","dmv" "98","watchpoint" "98","call-by-value" "98","database-connectivity" "98","server-response" "98","jobintentservice" "98","uproot" "98","aws-nlb" "98","airplane-mode" "98","urdu" "98","ajax.net" "98","django-request" "98","windows-live-id" "98","rsvp.js" "98","readwritelock" "98","sbrk" "98","svmlight" "98","awstats" "98","svnsync" "98","gtk-rs" "98","application-bar" "98","erase-remove-idiom" "98","denodo" "98","workmanagers" "98","gui-designer" "98","dynamoose" "98","http-accept-language" "98","jwindow" "98","android-studio-3.2" "98","sas-iml" "98","dwscript" "98","nested-sortable" "98","rawsql" "98","accelerate" "98","at-job" "98","javax.sound.sampled" "98","shapedrawable" "98","domain-object" "98","android-application-class" "98","typedoc" "98","shopify-storefront-api" "98","formpanel" "98","gomobile" "98","network-security-groups" "98","google-api-console" "98","diffabledatasource" "98","android-drawer" "98","playwright-dotnet" "98","nstoolbaritem" "98","taipy" "98","non-type-template-parameter" "98","non-member-functions" "98","dot-matrix" "98","aspx-user-control" "98","null-safety" "98","radlistview" "98","azure-web-app-for-containers" "98","vesta" "98","polaris" "98","title-case" "98","plot3d" "98","redux-actions" "98","double-dispatch" "98","holoviz" "98","janitor" "98","css-reset" "98","proportions" "98","login-page" "98","string-decoding" "98","certutil" "98","spring5" "98","no-cache" "98","cffile" "98","activitynotfoundexception" "98","react-lazy-load" "98","projective-geometry" "98","elasticsearch-indices" "98","google-natural-language" "98","amazon-dynamodb-local" "98","argoproj" "98","third-party-cookies" "98","ignore-case" "98","authorize.net-cim" "98","flutter-gridview" "98","ember-app-kit" "98","glulookat" "98","dapper-extensions" "97","reql" "97","edit-in-place" "97","clregion" "97","printk" "97","web-scripting" "97","teamviewer" "97","sld" "97","debugdiag" "97","edmx-designer" "97","anycpu" "97","sizetofit" "97","ydn-db" "97","clsid" "97","mvcc" "97","econnreset" "97","clique" "97","slim-4" "97","install-referrer" "97","gridview-sorting" "97","php-cs-fixer" "97","graphicspath" "97","locality-sensitive-hash" "97","getstaticprops" "97","trilateration" "97","php-socket" "97","flow-project" "97","jemalloc" "97","fire-and-forget" "97","jsonnode" "97","unit-conversion" "97","advanced-queuing" "97","snyk" "97","laravel-formrequest" "97","package-control" "97","church-encoding" "97","bindy" "97","x-forwarded-for" "97","rx-py" "97","datamart" "97","page-caching" "97","data-objects" "97","rundll32" "97","js-beautify" "97","xmldatasource" "97","fann" "97","call-recording" "97","oraclelinux" "97","sitecore8.2" "97","keychainitemwrapper" "97","nanoc" "97","google-vr-sdk" "97","jodconverter" "97","servermanager" "97","unmount" "97","oracle-bi" "97","named-entity-extraction" "97","candidate-key" "97","vaticle-typeql" "97","grpc-dotnet" "97","apprtc" "97","kapacitor" "97","pdfclown" "97","applicationpoolidentity" "97","svgpanzoom" "97","crashlytics-beta" "97","http.sys" "97","wso2-business-process" "97","openair" "97","audiobuffer" "97","pyexcel" "97","pydroid" "97","visual-editor" "97","wireguard" "97","format-conversion" "97","klocwork" "97","formsets" "97","network-scan" "97","wmf" "97","uclinux" "97","buildconfig" "97","pyquery" "97","fabric.io" "97","gobject-introspection" "97","codeigniter-restserver" "97","gocql" "97","virsh" "97","plex" "97","non-interactive" "97","azure-timeseries-insights" "97","toggleswitch" "97","mne-python" "97","notification-channel" "97","npoco" "97","cookiestore" "97","targetsdkversion" "97","uidocumentpickervc" "97","tinydb" "97","mochawesome" "97","titanium-android" "97","xattr" "97","control-theory" "97","vertx-httpclient" "97","iosdeployment" "97","angular2-jwt" "97","long-click" "97","peripherals" "97","nice" "97","ogr2ogr" "97","loggly" "97","text-justify" "97","qnetworkrequest" "97","perltk" "97","memcheck" "97","color-detection" "97","pgagent" "97","message-hub" "97","certificate-pinning" "97","android-query" "97","moralis" "97","tesseract.js" "97","mercurial-queue" "97","beeware" "97","threetenbp" "97","static-polymorphism" "97","custom-training" "97","thucydides" "97","thinktecture-ident-model" "97","flutter-image-picker" "97","mediametadataretriever" "97","passkey" "97","amazon-bedrock" "97","flutter-moor" "97","google-guava-cache" "97","autopep8" "97","google-maps-embed" "97","cve" "97","zend-debugger" "97","arm-none-eabi-gcc" "97","mri" "97","tiles-3" "96","stackexchange" "96","xsockets.net" "96","locals" "96","apache-hive" "96","murmurhash" "96","matcaffe" "96","ssdt-bi" "96","baidu" "96","git-history" "96","phpoffice-phpspreadsheet" "96","flutter-audioplayers" "96","listcollectionview" "96","request.form" "96","bindable" "96","djangoappengine" "96","addressof" "96","smslib" "96","playframework-evolutions" "96","pkg-resources" "96","function-expression" "96","snipmate" "96","sentestingkit" "96","ng-storage" "96","self-extracting" "96","filetime" "96","ultisnips" "96","selenium-server" "96","jscript.net" "96","cd-rom" "96","jscolor" "96","jsonpickle" "96","segger-jlink" "96","window-object" "96","dash.js" "96","kendonumerictextbox" "96","simplecov" "96","oracle-nosql" "96","aide-ide" "96","shared-project" "96","angularjs-templates" "96","dj-rest-auth" "96","cross-database" "96","airflow-api" "96","keystrokes" "96","hyperloglog" "96","angular-renderer2" "96","aleagpu" "96","winapp" "96","realm-java" "96","database-mail" "96","rpyc" "96","joomla3.3" "96","pdf417" "96","spring-boot-jpa" "96","bpy" "96","corretto" "96","bll" "96","jqvmap" "96","earlgrey" "96","ws-trust" "96","jquery-ui-button" "96","jquery-address" "96","fouc" "96","shlex" "96","code-templates" "96","atmega16" "96","visitor-statistic" "96","codeigniter-query-builder" "96","pyfpdf" "96","mail-form" "96","kprobe" "96","winscard" "96","buffered" "96","javaw" "96","asset-management" "96","scalikejdbc" "96","hidapi" "96","android-enterprise" "96","dining-philosopher" "96","azurite" "96","gwtquery" "96","uipresentationcontroller" "96","expat-parser" "96","gcloud-node" "96","azure-file-share" "96","hamming-code" "96","iseries-navigator" "96","dialogresult" "96","device-emulation" "96","ipconfig" "96","request-timed-out" "96","propertynotfoundexception" "96","esx" "96","active-record-query" "96","peer-dependencies" "96","custom-titlebar" "96","iif-function" "96","usagestatsmanager" "96","scroll-position" "96","struts-action" "96","beyondcompare4" "96","hbitmap" "96","prefix-operator" "96","parse-url" "96","tph" "96","avassetreader" "96","pgf" "96","light-inject" "96","eloqua" "96","idoc" "96","utop" "96","concurrent-queue" "96","emacs-faces" "95","phpcassa" "95","ebcli" "95","mashup" "95","dbm" "95","smartbanner" "95","apache-commons-compress" "95","little-man-computer" "95","clickatell" "95","multirow" "95","react-native-fcm" "95","eclipse-classpath" "95","cls" "95","sizer" "95","php-pgsql" "95","xpi" "95","unassigned-variable" "95","consumption" "95","firebase-ab-testing" "95","piano" "95","blackboard" "95","configurationproperties" "95","sensitive-data" "95","dirichlet" "95","firebird-embedded" "95","rustup" "95","xms" "95","vptr" "95","imageswitcher" "95","addtarget" "95","datapicker" "95","valuestack" "95","method-hiding" "95","alertify" "95","dns-sd" "95","session-bean" "95","fba" "95","docker-cloud" "95","waze" "95","jfxtras" "95","psr-7" "95","dynamic-text" "95","nessus" "95","kate" "95","android-signing" "95","invokerequired" "95","informatica-powerexchange" "95","povray" "95","jupyter-console" "95","passthru" "95","dos2unix" "95","nxlog" "95",".profile" "95","system.io.directory" "95","overflow-menu" "95","extjs6.2" "95","view-source" "95","side-scroller" "95","and-operator" "95","pylintrc" "95","luainterface" "95","typhoeus" "95","google-auth-library" "95","retrieve-and-rank" "95","facebook-ads" "95","version-numbering" "95","openthread" "95","xamarin-binding" "95","redis-streams" "95","redisgraph" "95","plotly.graph-objects" "95","openlitespeed" "95","registerhotkey" "95","openhab" "95","happybase" "95","exponential-distribution" "95","android-customtabs" "95","xcode-cloud" "95","redoc" "95","timer-trigger" "95","itoa" "95","numexpr" "95","nstabview" "95","poloniex" "95","mencoder" "95","mendix" "95","odoo-website" "95","getopenfilename" "95","lockbits" "95","propertysheet" "95","hybris-data-hub" "95","memory-pool" "95","genexus-sd" "95","angular2-ngcontent" "95","mpmediaplayercontroller" "95","officedev" "95","genie" "95","monix" "95","duktape" "95","cgcolor" "95","pedometer" "95","angular-cli-v7" "95","euro" "95","movabletype" "95","liferay-dxp" "95","embedded-documents" "95","torchscript" "95","flutter-ios-build" "95","paragraphs" "95","emacsclient" "95","composite-controls" "95","line-segment" "95","asic" "95","subitem" "95","qsplitter" "95","dart-sass" "95","scroll-paging" "95","gitorious" "94","dcgan" "94","multimethod" "94","clearquest" "94","php-parse-error" "94","file-location" "94","xrange" "94","y-combinator" "94","sketch-3" "94","mustache.php" "94","repository-design" "94","ef-code-first-mapping" "94","rendertransform" "94","sslexception" "94","selectedtext" "94","xlpagertabstrip" "94","bitstream" "94","uiviewpropertyanimator" "94","discrete" "94","blank-nodes" "94","vnext" "94","addhandler" "94","checkboxpreference" "94","cellid" "94","picketlink" "94","connected-react-router" "94","documentfile" "94","css-gradients" "94","django-oauth" "94","calendly" "94","warp" "94","rocketmq" "94","jgoodies" "94","single-spa-angular" "94","oracle-commerce" "94","nanopb" "94","validates-uniqueness-of" "94","dnd-kit" "94","sitecore7.5" "94","keycloak-gatekeeper" "94","sequence-to-sequence" "94","ibm-data-studio" "94","unmanaged-memory" "94","joomla-sef-urls" "94","angular-route-guards" "94","databricks-community-edition" "94","tthread" "94","dynamic-image-generation" "94","htl" "94","near" "94","opencl-c" "94","wordpress-login" "94","couchdb-mango" "94","android-viewbinder" "94","nsstatusbar" "94","password-generator" "94","applepayjs" "94","environment-modules" "94","twitter-rest-api" "94","derbyjs" "94","html-imports" "94","turnjs" "94","wwwroot" "94","entitylisteners" "94","nrf51" "94","blobs" "94","htmlcleaner" "94","table-functions" "94","mailcore" "94","visualtreehelper" "94","minim" "94","ocamllex" "94","razor-components" "94","synth" "94","obout" "94","virtual-threads" "94","signalr-2" "94","sevenzipsharp" "94","12factor" "94","ambassador" "94","built-in-types" "94","libffi" "94","buckets" "94","netoffice" "94","range-query" "94","uhd" "94","lwuit-form" "94","nstextfieldcell" "94","gdkpixbuf" "94","c64" "94","mmo" "94","wxformbuilder" "94","radio-transmission" "94","dfm" "94","npm-workspaces" "94","xamarin-test-cloud" "94","metaio" "94","laravel-models" "94","perforce-integrate" "94","iron.io" "94","textrange" "94","react-app-rewired" "94","react-16" "94","mpc" "94","ejb-3.2" "94","splunk-calculation" "94","reserved" "94","lttng" "94","css-paged-media" "94","get-aduser" "94","linaro" "94","qtopengl" "94","statnet" "94","amazon-rds-proxy" "94","gitpod" "94","statefulset" "94","aloha-editor" "94","prebid.js" "94","usleep" "94","tez" "94","ifilter" "94","sparse-array" "94","quadprog" "94","ppi" "94","compose-db" "94","heremaps-android-sdk" "93","editortemplates" "93","decidable" "93","sln-file" "93","jboss-cli" "93","apache-httpasyncclient" "93","git-husky" "93","maven-checkstyle-plugin" "93","great-circle" "93","temporal-database" "93","telegraf-inputs-plugin" "93","ddd-service" "93","phpass" "93","ddd-debugger" "93","material-react-table" "93","ggiraph" "93","mainclass" "93","ngsanitize" "93","ng-submit" "93","datasheet" "93","bitmap-fonts" "93","catch-unit-test" "93","full-trust" "93","vrml" "93","imagesloaded" "93","pafy" "93","findandmodify" "93","symfony-4.4" "93","containment" "93","kubernetes-python-client" "93","immutable-collections" "93","datefilter" "93","choroplethr" "93","icacls" "93","angularjs-ng-disabled" "93","dojo.gridx" "93","optionparser" "93","valet" "93","data-dumper" "93","gqlgen" "93","go-swagger" "93","databricks-autoloader" "93","meteor-velocity" "93","service-fabric-actor" "93","sikuli-ide" "93","aws-toolkit" "93","eai" "93","azure-elasticpool" "93","azure-compute-emulator" "93","jvcl" "93","ionos" "93","wunderground" "93","design-decisions" "93","android-scrollbar" "93","sapjco3" "93","passport-google-oauth2" "93","karatsuba" "93","durandal-navigation" "93","dependency-parsing" "93","razor-class-library" "93","vim-fugitive" "93","audio-analysis" "93","koala-gem" "93","ati" "93","android-2.1-eclair" "93","sgen" "93","pymqi" "93","eyed3" "93","raw-ethernet" "93","formatted" "93","plesk-onyx" "93","gzipoutputstream" "93","gwt-2.2-celltable" "93","gae-search" "93","xcode9.1" "93","nstextstorage" "93","sqlitestudio" "93","c9.io" "93","redirect-loop" "93","exception-safety" "93","sqlmetal" "93","dfsort" "93","scnscene" "93","uihostingcontroller" "93","dotnet-sdk" "93","tmemo" "93","hints" "93","cumulative-frequency" "93","custom-protocol" "93","google-finance-api" "93","qmouseevent" "93","launchctl" "93","ipb" "93","mouse-hook" "93","android-min-sdk" "93","splistitem" "93","metallb" "93","action-mapping" "93","laravel-vue" "93","es6-map" "93","prose-mirror" "93","event-simulation" "93","nightly-build" "93","android-night-mode" "93","ikimagebrowserview" "93","amazon-s3-select" "93","mcc" "93","computer-science-theory" "93","webkitspeechrecognition" "93","sound-synthesis" "93","tidyselect" "93","quarkus-native" "93","ember-addon" "93","tidyquant" "93","git-reflog" "93","zipalign" "93","spark-thriftserver" "93","heapq" "93","amazon-cognito-triggers" "93","quickaction" "93","powershell-workflow" "93","google-publisher-tag" "93","amazon-kinesis-video-streams" "93","mdb2" "93","cytoscape-web" "93","google-latitude" "93","google-play-billing" "93","google-play-core" "92","mvccontrib-grid" "92","file-mapping" "92","php-7.0" "92","graph-neural-network" "92","intelephense" "92","background-agents" "92","instr" "92","yii-booster" "92","wiimote" "92","edit-and-continue" "92","xml-binding" "92","django-celery-beat" "92","bitboard" "92","bing-ads-api" "92","dismax" "92","dbflow" "92","malformedurlexception" "92","pivotal-web-services" "92","smtpappender" "92","sails.io.js" "92","chez-scheme" "92","paket" "92","adempiere" "92","unicode-literals" "92","rowdeleting" "92","rubber" "92","ora-00907" "92","angularjs-ng-if" "92","calibre" "92","aws-regions" "92","django-mysql" "92","unsupportedoperation" "92","servicestack-bsd" "92","angular-lazyloading" "92","server-explorer" "92","csl" "92","aws-amplify-sdk-js" "92","serilog-sinks-file" "92","aws-alb" "92","ibm-appid" "92","satis" "92","opalrb" "92","ionic-storage" "92","dynamic-list" "92","opendocument" "92","bnlearn" "92","android-studio-3.5" "92","surround" "92","cpu-cycles" "92","appimage" "92","box2dweb" "92","bodymovin" "92","ones-complement" "92","postmortem-debugging" "92","objectinstantiation" "92","browser-testing" "92","pytest-bdd" "92","ammap" "92","lumen-5.2" "92","pytest-xdist" "92","kogrid" "92","cocoscreator" "92","nppexec" "92","ml-gradle" "92","dpc++" "92","tinymce-6" "92","haproxy-ingress" "92","cairngorm" "92","xcode-template" "92","xcode-organizer" "92","direct3d12" "92","uibackgroundcolor" "92","tlbimp" "92","isar" "92","controlled-component" "92","h2db" "92","polarion" "92","nunit-2.5" "92","downloadstring" "92","uipickerviewcontroller" "92","hydrogen" "92","cgsize" "92","custom-action-filter" "92","getc" "92","streaminsight" "92","google-cloud-nl" "92","log4php" "92","odk" "92","ctad" "92","locomotivecms" "92","geolocator" "92","comaddin" "92","offsetof" "92","protocol-handler" "92","character-properties" "92","ie-compatibility-mode" "92","zillow" "92","glove" "92","utf-32" "92","trailing-return-type" "92","header-only" "92","imagebrush" "92","archer" "92","fontconfig" "92","struts2-jquery-plugin" "92","zend-autoloader" "92","armcc" "92","ytplayerview" "92","threejs-editor" "92","arm7" "92","mcustomscrollbar" "92","custom-theme" "92","fo-dicom" "92","static-memory-allocation" "91","figures" "91","cloudsim" "91","groq" "91","ggpmisc" "91","fest" "91","transitive-closure-table" "91","instapy" "91","yolov7" "91","listjs" "91","github-mantle" "91","graphql-spqr" "91","jeromq" "91","carla" "91","carrier" "91","celltemplate" "91","cbir" "91","date-manipulation" "91","configserver" "91","jsprit" "91","l2cap" "91","symantec" "91","contentpane" "91","adcolony" "91","fixpoint-combinators" "91","fitbounds" "91","symfony-flex" "91","froogaloop" "91","xom" "91","django-uploads" "91","pyd" "91","jfugue" "91","dataframes.jl" "91","windows-networking" "91","crossword" "91","server-name" "91","ruby-3" "91","ibm-content-navigator" "91","datagridviewtextboxcell" "91","key-management" "91","kentico-12" "91","micronaut-rest" "91","scala-dispatch" "91","jquery-3" "91","html-head" "91","supercomputers" "91","boost-multiprecision" "91","jquery-form-validator" "91","nspanel" "91","htk" "91","jquery-scrollify" "91","password-storage" "91","rappid" "91","viewport3d" "91","pygooglechart" "91","knuth" "91","visual-studio-community" "91","nvprof" "91","video-subtitles" "91","virtualizingstackpanel" "91","wordle-game" "91","netbeans-8.1" "91","set-union" "91","py-shiny" "91","fraud-prevention" "91","wmplib" "91","google-advertising-id" "91","iso-15693" "91","hocon" "91","c++builder-xe2" "91","cookie-session" "91","uiimagejpegrepresentation" "91","sql-server-2016-express" "91","mks" "91","gutter" "91","scala-quasiquotes" "91","conversation-scope" "91","mobility" "91","hgsubversion" "91","requestcontext" "91","progress-indicator" "91","prolog-cut" "91","test-reporting" "91","geom-tile" "91","ohlc" "91","large-object-heap" "91","qicon" "91","http-tunneling" "91","android-maps-utils" "91","common-data-service" "91","protocol-extension" "91","splitpane" "91","ios-sharesheet" "91","learning-rate" "91","custom-pages" "91","ejbca" "91","activemq-cpp" "91","color-management" "91","alluxio" "91","autokey" "91","soundeffect" "91","zalenium" "91","mcafee" "91","google-provisioning-api" "91","medoo" "91","seekg" "91","multiautocompletetextview" "91","ihtmldocument2" "91","flutter-localizations" "91","compile-time-weaving" "91","autofac-configuration" "91","arraydeque" "91","google-python-api" "91","helix" "91","webex" "91","glassfish-5" "91","bilinear-interpolation" "91","ihostedservice" "91","aruba" "91","web-content" "90","photoeditorsdk" "90","filegroup" "90","file-monitoring" "90","gray-code" "90","sql-types" "90","integrated-pipeline-mode" "90","jekyll-bootstrap" "90","skeletal-animation" "90","jexl" "90","loadview" "90","barbajs" "90","teraterm" "90","xtensor" "90","phpickerviewcontroller" "90","print-spooler-api" "90","multiprocessing-manager" "90","firefox-3" "90","soft-references" "90","swingbuilder" "90","python-bindings" "90","firefox-profile" "90","sendmailr" "90","pint" "90","rx-scala" "90","sabredav" "90","angularjs-model" "90","reason-react" "90","rowversion" "90","campaign-monitor" "90","oracle-apex-19.2" "90","wacom" "90","watchface" "90","dataexplorer" "90","windows-phone-7.1.1" "90","id3-tag" "90","croppie" "90","watchify" "90","aws-ecs" "90","rtmfp" "90","workload-scheduler" "90","boggle" "90","bltoolkit" "90","twitter-gem" "90","wpmu" "90","pos-for-.net" "90","boost-mutex" "90","jung2" "90","posix-ere" "90","bolts-framework" "90","ini-set" "90","world-map" "90","easy68k" "90","gruntfile" "90","design-guidelines" "90","ncrunch" "90","nsdatepicker" "90","invoices" "90","hostapd" "90","natural-logarithm" "90","minimized" "90","octave-gui" "90","ocamlyacc" "90","libharu" "90","viola-jones" "90","levenberg-marquardt" "90","freeipa" "90","video-card" "90","shadow-copy" "90","shadow-cljs" "90","netnamedpipebinding" "90","javax.crypto" "90","kodein" "90","external-dependencies" "90","winsxs" "90","cookieconsent" "90","mod-cluster" "90","registerstartupscript" "90","nusmv" "90","azure-vm-role" "90","nvidia-digits" "90","nolock" "90","bunny" "90","directdraw" "90","hanami" "90","redux-middleware" "90","cacerts" "90","hit" "90","mmdrawercontroller" "90","qdatetime" "90","metadata-extractor" "90","exasol" "90","stringreader" "90","irr" "90","evopdf" "90","memory-bandwidth" "90","cuda-gdb" "90","login-required" "90","late-static-binding" "90","curlpp" "90","google-experiments" "90","lbph-algorithm" "90","dumpbin" "90","text-coloring" "90","angular2-router3" "90","http-status-code-410" "90","colorize" "90","actualwidth" "90","coldfusionbuilder" "90","cubism.js" "90","string-hashing" "90","android-print-framework" "90","cgcontextref" "90","megaparsec" "90","arrayofarrays" "90","sharpgl" "90","steamvr" "90","mavlink" "90","stencil-component" "90","qtextstream" "90","iexpress" "90","sdi" "90","solidus" "90","parsexml" "90","aries" "90","gnat-gps" "90","google-map-react" "90","arduino-due" "90","user-feedback" "90","argonaut" "90","static-class" "90","threadabortexception" "89","renjin" "89","base32" "89","load-csv" "89","template-tal" "89","matillion" "89","yii-events" "89","figwheel" "89","clientscript" "89","file.readalllines" "89","matchmedia" "89","transport-stream" "89","flexmojos" "89","multivariate-time-series" "89","mumps" "89","flink-statefun" "89","flutter2.0" "89","productivity-power-tools" "89","paketo" "89","image-rendering" "89","ng2-translate" "89","symbolic-integration" "89","uitextinput" "89","imagemin" "89","jsr286" "89","cscore" "89","ibm-infosphere" "89","operationalerror" "89","agrep" "89","aginity" "89","joincolumn" "89","pug-loader" "89","createwindow" "89","mysql-function" "89","serving" "89","akavache" "89","crud-repository" "89","payfort" "89","spring-remoting" "89","twinx" "89","pathogen" "89","apply-templates" "89","sas-ods" "89","application-start" "89","sap-cloud-foundry" "89","polynomial-approximations" "89","android-threading" "89","error-suppression" "89","enlive" "89","entityreference" "89","bsearch" "89","kubebuilder" "89","system-error" "89","audiosession" "89","wistia" "89","netscaler" "89","libvpx" "89","btrfs" "89","netbeans-12" "89","rhino3d" "89","set-operations" "89","macbookpro-touch-bar" "89","raw-pointer" "89","system.configuration" "89","code-hinting" "89","objectdataprovider" "89","javalin" "89","explicit-interface" "89","expected-exception" "89","podofo" "89","spring-test-dbunit" "89","azure-node-sdk" "89","drupal-nodes" "89","polkadot-js" "89","scd2" "89","dotnetnuke-6" "89","sqlkata" "89","scikit-learn-pipeline" "89","polyhedra" "89","half-precision-float" "89","tls1.0" "89","hla" "89","c++builder-10.2-tokyo" "89","npm-update" "89","nsuseractivity" "89","bunit" "89","dotvvm" "89","command-objects" "89","chaco" "89","logistics" "89","ltpa" "89","perfect-scrollbar" "89","resharper-6.0" "89","google-generativeai" "89","get-headers" "89","split-screen" "89","google-sso" "89","linkedin-j" "89","zend-framework-modules" "89","alloca" "89","web2py-modules" "89","folder-permissions" "89","pgloader" "89","quartz.net-2.0" "89","iframe-app" "89","stateflow" "89","flyweight-pattern" "89","stubs" "89","subversion-edge" "89","static-initializer" "89","paperclip-validation" "89","transcrypt" "89","arduino-ultra-sonic" "89","flutter-textinputfield" "89","msn" "88","stacklayout" "88","tensorflow-model-garden" "88","lmer" "88","react-native-windows" "88","jcs" "88","git-index" "88","ggtext" "88","anti-cheat" "88","gflags" "88","phpdotenv" "88","default-scope" "88","flutterdriver" "88","clientcredential" "88","jboss-logging" "88","debian-packaging" "88","xmgrace" "88","rust-chrono" "88","cassandra-driver" "88","xlutils" "88","dism" "88","function-qualifier" "88","diskimage" "88","rust-futures" "88","distributed-training" "88","checker-framework" "88","contention" "88","chromakey" "88","voicemail" "88","nhibernate.search" "88","manipulators" "88","inclusion" "88","swiftui-navigationsplitview" "88","vora" "88","overscroll" "88","swiftui-picker" "88","kitura" "88","django-tagging" "88","uppaal" "88","callcc" "88","react-starter-kit" "88","rt" "88","rtcdatachannel" "88","angularjs-nvd3-directives" "88","mysql-error-1111" "88","server-variables" "88","angular-seed" "88","react-toolbox" "88","pwntools" "88","rncryptor" "88","opencensus" "88","twilio-taskrouter" "88","modelmetadata" "88","dynamictype" "88","onrestoreinstancestate" "88","jquery-backstretch" "88","passport-saml" "88","workload-identity" "88","bottombar" "88","eregi" "88","inotifydataerrorinfo" "88","htmleditorkit" "88","nrvo" "88","sarimax" "88","jquery-ui-map" "88","htmltextwriter" "88","wordml" "88","pyspark-schema" "88","codeql" "88","sfx" "88","pyelasticsearch" "88","128-bit" "88","pyfits" "88","kotlin-dokka" "88","netmsmqbinding" "88","cognos-tm1" "88","type-promotion" "88","osticket" "88","nevpnmanager" "88","aurelia-templating" "88","wkinterfacetable" "88","drake-r-package" "88","refer" "88","gupshup" "88","tla+" "88","ithit-webdav-server" "88","openvr" "88","azure-gov" "88","c#-7.3" "88","tkmessagebox" "88","game-ai" "88","execfile" "88","ispconfig" "88","gelf" "88","rails-3-upgrade" "88","galois-field" "88","asp.net-session" "88","tkinter-menu" "88","radix-ui" "88","react-apollo-hooks" "88","css-purge" "88","terraform-cdk" "88","progressive-download" "88","dunit" "88","android-phone-call" "88","mprotect" "88","periodicity" "88","actionviewhelper" "88","strncmp" "88","nitrogen" "88","elastix" "88","reactjs-testutils" "88","auto-import" "88","autodiscovery" "88","lineageos" "88","glance-appwidget" "88","gksession" "88","lifting" "88","bim" "88","beta-distribution" "88","ms-access-2000" "88","zeitwerk" "88","webdynpro" "88","torquebox" "88","tframe" "88","webdatarocks" "88","stylish" "88","if-modified-since" "88","struts2-jquery-grid" "88","steambot" "87","react-native-vision-camera" "87","groovy-grape" "87","mashape" "87","instantiation-error" "87","slackware" "87","trusted-timestamp" "87","jenkins-scriptler" "87","tensorflow-slim" "87","gevent-socketio" "87","apache-commons-exec" "87","webrole" "87","wfastcgi" "87","jetpack-compose-animation" "87","phplist" "87","rendertarget" "87","primavera" "87","wercker" "87","flexjson" "87","music-notation" "87","edge.js" "87","multiprecision" "87","rename-item-cmdlet" "87","jdk1.7" "87","bindvalue" "87","xmlrpcclient" "87","api-authorization" "87","datestamp" "87","nghttp2" "87","cardslib" "87","dbatools" "87","filesplitting" "87","django-4.0" "87","python-s3fs" "87","python-pdfkit" "87","js-ipfs" "87","pii" "87","safari-app-extension" "87","python-can" "87","pivotitem" "87","jsonkit" "87","catplot" "87","smbus" "87","directory-traversal" "87","finalbuilder" "87","uitraitcollection" "87","fla" "87","symbol-server" "87","lando" "87","pkcs#1" "87","jline" "87","jose4j" "87","verdaccio" "87","wavesplatform" "87","aws-chime-sdk" "87","unnotificationserviceextension" "87","mysql++" "87","oql" "87","jqbootstrapvalidation" "87","r-mapview" "87","publish-profiles" "87","google-wave" "87","hypertable" "87","avcam" "87","fastscroll" "87","callbyname" "87","boomi" "87","core-media" "87","wro4j" "87","nrepl" "87","tweetstream" "87","dvb" "87","open62541" "87","eos" "87","sikuli-x" "87","opaque-pointers" "87","dynatable" "87","attribution" "87","knox-amazon-s3-client" "87","java-ws" "87","amp-email" "87","augeas" "87","viewswitcher" "87","r-car" "87","google-benchmark" "87","level-of-detail" "87","jasmine-marbles" "87","vision" "87","object-tracking" "87","mini-batch" "87","ui5-tooling" "87","javah" "87","netbeans6.7" "87","netbeans6.5" "87","lib-nfc" "87","libv8" "87","ratpack" "87","mks-integrity" "87","sqljdbc" "87","dpkt" "87","azuremlsdk" "87","scoverage" "87","diagrams" "87","d-pad" "87","openmax" "87","mkdirs" "87","openstack-heat" "87","isolate-scope" "87","drupal-templates" "87","modelchoicefield" "87","xaml-designer" "87","openxava" "87","express-generator" "87","null-conditional-operator" "87","bulk-collect" "87","octokit-js" "87","react-hooks-testing-library" "87","memory-fragmentation" "87","resque-scheduler" "87","getorgchart" "87","cglayer" "87","angular-builder" "87","perfect-square" "87","android-picture-in-picture" "87","tesla" "87","hugo-shortcode" "87","ctrlp" "87","pentaho-design-studio" "87","terraform-provider-databricks" "87","getlasterror" "87","papi" "87","dagre-d3" "87","weblogic9.x" "87","conditional-aggregation" "87","flutter-workmanager" "87","tool-uml" "87","ihp" "87","papaja" "87","security-constraint" "87","spanned" "86","eclipse-clp" "86","proc-r-package" "86","primary-key-design" "86","xxe" "86","vue-events" "86","localauthentication" "86","react-native-tab-view" "86","ef4-code-only" "86","vsvim" "86","ssim" "86","multipleoutputs" "86","json-view" "86","jssip" "86","apollo-angular" "86","function-module" "86","binary-decision-diagram" "86","selenium3" "86","unhandled-promise-rejection" "86","umdf" "86","json-c" "86","pidgin" "86","apache-ode" "86","ng-container" "86","bitcoinj" "86","wcm" "86","camera-overlay" "86","grails-2.5" "86","jfrog-container-registry" "86","server-side-swift" "86","sitecore-media-library" "86","falcon" "86","factoextra" "86","ora-00942" "86","awss3transfermanager" "86","alertview" "86","django-pyodbc" "86","servicecontract" "86","purchase-order" "86","database-testing" "86","waitforsingleobject" "86","simplex-noise" "86","android-studio-import" "86","cortana-skills-kit" "86","spring-dm" "86","html5shiv" "86","sanctum" "86","signpost" "86","nav-pills" "86","katalon" "86","gtksourceview" "86","onlinebanking" "86","android-sinch-api" "86","bottom-up" "86","azul-zulu" "86","dynamic-scope" "86","az" "86","cpp-netlib" "86","inquirer" "86","neo4j-driver" "86","oscilloscope" "86","codesmith" "86","ubuntu-9.10" "86","out-of-process" "86","ui.bootstrap" "86","wiredep" "86","shtml" "86","forfiles" "86","woodstox" "86","obex" "86","visual-sourcesafe-2005" "86","objectarx" "86","synchronized-block" "86","visual-studio-designer" "86","foundry-workshop" "86","android-attributes" "86","return-type-deduction" "86","visual-studio-project" "86","burndowncharts" "86","mklink" "86","hibernate-cascade" "86","gae-module" "86","hmail-server" "86","high-order-component" "86","drc" "86","screens" "86","quickselect" "86","hamlet" "86","iwork" "86","metacharacters" "86","google-gears" "86","custom-formatting" "86","ip-restrictions" "86","electron-vue" "86","lseek" "86","esmodules" "86","logical-and" "86","strong-references" "86","metal-performance-shaders" "86","omap" "86","stream-analytics" "86","cuda-streams" "86","okio" "86","meego" "86","common.logging" "86","examine" "86","elm327" "86","pq" "86","pptp" "86","usb-mass-storage" "86","argument-error" "86","helpermethods" "86","custom-transition" "86","transducer" "86","web-midi" "86","preemptive" "86","secure-random" "86","user-inactivity" "86","top-command" "86","sonarqube5.6" "86","tie" "86","youtubeplayer" "86","prebuild" "86","fma" "86","linq-query-syntax" "86","linux-disk-free" "86","maven-install-plugin" "86","searchlogic" "86","multi-dimensional-scaling" "85","treetop" "85","liquidsoap" "85","xregexp" "85","trending" "85","mat-stepper" "85","react-native-navigation-v2" "85","multi-query" "85","anyevent" "85","template-instantiation" "85","location-client" "85","apache-commons-dbutils" "85","graphite-carbon" "85","clear-cache" "85","apache-commons-lang3" "85","cleartype" "85","jenkins-job-builder" "85","tensorflow-xla" "85","apache-spark-xml" "85","nhibernate-3" "85","page-editor" "85","sencha-charts" "85","findersync" "85","smart-wizard" "85","flask-babel" "85","app-distribution" "85","data-link-layer" "85","manova" "85","addrange" "85","checkboxfor" "85","ape-phylo" "85","mapview" "85","realm-object-server" "85","credits" "85","oracle-service-bus" "85","unrealscript" "85","django-mongodb-engine" "85","oracle-soa" "85","vectormath" "85","ibpy" "85","rotator" "85","kernlab" "85","cross-fade" "85","boyer-moore" "85","denormalized" "85","nservicebus4" "85","dev-appserver" "85","craigslist" "85","working-copy" "85","pathinfo" "85","writeablebitmapex" "85","html5-animation" "85","nsslider" "85","html5-draggable" "85","ridgeline-plot" "85","knockout-sortable" "85","reverse-iterator" "85","analytical" "85","javax.sound.midi" "85","rational-numbers" "85","visualbrush" "85","pystan" "85","lumia-imaging-sdk" "85","viterbi" "85","minimalmodbus" "85","netbeans-8.2" "85","nvp" "85","browser-refresh" "85","shallow-clone" "85","visual-assist" "85","nstouchbar" "85","uipath-orchestrator" "85","uipath-activity" "85","tinder" "85","noir" "85","isolatedstoragefile" "85","timsort" "85","cache-invalidation" "85","iterparse" "85","xcache" "85","openwebrtc" "85","executionpolicy" "85","non-exhaustive-patterns" "85","dotnetbar" "85","tbxml" "85","nonlinear-equation" "85","null-object-pattern" "85","hibernate.cfg.xml" "85","mkstorekit" "85","reflect-metadata" "85","c#-7.2" "85","pex-and-moles" "85","angular-component-router" "85","ctl" "85","qdir" "85","qjson" "85","no-data" "85","commercetools" "85","node-schedule" "85","spn" "85","mousemotionlistener" "85","qpython3" "85","leaflet-routing-machine" "85","textangular" "85","launch-daemon" "85","qmenubar" "85","glidejs" "85","bimap" "85","sonarqube5.3" "85","libzip" "85","web-optimization" "85","identitymodel" "85","sourceforge-appscript" "85","enctype" "85","amazon-policy" "85","googlesheets4" "85","composite-index" "85","big-ip" "85","webpack-cli" "85","emacs-helm" "85","computed-field" "84","instamojo" "84","cmsmadesimple" "84","weighting" "84","y86" "84","skproduct" "84","github-organizations" "84","jboss-developer-studio" "84","graph-layout" "84","installshield-2011" "84","materialdrawer" "84","apache-commons-email" "84","apache-cocoon" "84","grass" "84","flink-table-api" "84","field-names" "84","teamspeak" "84","jdoql" "84","anti-join" "84","gretty" "84","vue-sfc" "84","cloudmade" "84","ggalluvial" "84","gridworld" "84","afhttprequestoperation" "84","xml-formatting" "84","platypus" "84","cartalyst-sentinel" "84","impress.js" "84","voximplant" "84","django-contrib" "84","friend-class" "84","adobe-premiere" "84","lambdaj" "84","check-mk" "84","xidel" "84","frozenset" "84","xperf" "84","fireworks" "84","uitypeeditor" "84","firewatir" "84","symmetric-key" "84","python-pika" "84","page-jump" "84","chicagoboss" "84","xming" "84","g1ant" "84","conky" "84","catalina.out" "84","wincrypt" "84","databags" "84","grails-validation" "84","watchos-6" "84","oracle-enterprise-manager" "84","database-abstraction" "84","caliper" "84","react-swiper" "84","read-csv" "84","joomla3.4" "84","wcf-hosting" "84","keras-rl" "84","uribuilder" "84","simscape" "84","mysql-error-1093" "84","sequence-generators" "84","jooq-codegen-maven" "84","pts" "84","django-filebrowser" "84","vdi" "84","canary-deployment" "84","public-activity" "84","routeconfig" "84","nano-server" "84","verifone" "84","punycode" "84","doclet" "84","negate" "84","dwolla" "84","easyadmin3" "84","wso2-message-broker" "84","power-automate-custom-connector" "84","swc-compiler" "84","k8s-serviceaccount" "84","erasure" "84","savefig" "84","ttkbootstrap" "84","money-rails" "84","spring-security-acl" "84","android-wireless" "84","twitter-follow" "84","aws-sso" "84","simba" "84","extern-c" "84","nyromodal" "84","externals" "84","pygit2" "84","netflix-dgs" "84","godoc" "84","code-assist" "84","shoutem" "84","google-caja" "84","facebook-invite" "84","viewmodellocator" "84","revolution-r" "84","ubuntu-17.10" "84","video-intelligence-api" "84","pyflakes" "84","freecad" "84","timecodes" "84","nstablecolumn" "84","sql-server-2012-datatools" "84","taskfactory" "84","convertapi" "84","registerforactivityresult" "84","qwebpage" "84","nstokenfield" "84","hindley-milner" "84","plyr.js" "84","xamarin-community-toolkit" "84","devexpress-gridcontrol" "84","time-frequency" "84","export-to-text" "84","android-filter" "84","gemfile.lock" "84","playready" "84","access-levels" "84","elastic-beats" "84","ctor-initializer" "84","protobuf-go" "84","resample" "84","monte-carlo-tree-search" "84","messagecontract" "84","ios-enterprise" "84","generic-function" "84","requirejs-optimizer" "84","splint" "84","rescript" "84","react-instantsearch" "84","lockless" "84","lossless" "84","mpeg-2" "84","isalpha" "84","elementref" "84","centralized" "84","actiondispatch" "84","color-depth" "84","morphological-analysis" "84","acme" "84","terraform-provider-kubernetes" "84","berkeley-db-je" "84","qubole" "84","web3-react" "84","gnu-findutils" "84","soundcard" "84","endlessscroll" "84","battery-saver" "84","preloadjs" "84","spark3" "84","tiddlywiki" "84","gmlib" "84","git-tf" "84","sudzc" "84","embedded-language" "84","foreach-object" "83","wgpu-rs" "83","edk2" "83","instantsearch" "83","jdedwards" "83","productbuild" "83","ckquery" "83","festival" "83","ssmtp" "83","clockify" "83","eclipse-jee" "83","definitions" "83","llblgen" "83","integrated-security" "83","biztalk-deployment" "83","mali" "83","adldap" "83","social-authentication" "83","lapacke" "83","languagetool" "83","import-contacts" "83","firefox-developer-edition" "83","sendasync" "83","finite-field" "83","constraint-satisfaction" "83","symphony-cms" "83","datapoint" "83","chessboard.js" "83","ngx-bootstrap-modal" "83","wcfserviceclient" "83","rnw" "83","window-management" "83","iana" "83","iconbutton" "83","awesome-notifications" "83","camel-sql" "83","alfa" "83","rpm-maven-plugin" "83","jmagick" "83","microsoft-exchange" "83","rjsonio" "83","metro-ui-css" "83","mysql.data" "83","kirby" "83","android-studio-3.3" "83","equality-operator" "83","android-studio-arctic-fox" "83","appleevents" "83","sap-business-one-di-api" "83","swapfile" "83","swank" "83","suricata" "83","openapi-generator-cli" "83","azure-ai-search" "83","pdfviewer" "83","wtelegramclient" "83","twincat-ads" "83","onresize" "83","twill" "83","coverlet" "83","pony" "83","popularity" "83","nsnull" "83","3d-rendering" "83","amq" "83","knowledge-management" "83","absinthe" "83","shaderlab" "83","r-glue" "83","oak" "83","libiconv" "83","libx265" "83","facebook-java-api" "83","go-get" "83","dom-node" "83","browser-link" "83","cohesion" "83","netmask" "83","libreadline" "83","atlassian-crowd" "83","rattle" "83","browserfield" "83","azure-webjobs-triggered" "83","c++builder-xe" "83","aspbutton" "83","itunes-sdk" "83","quickreports" "83","digital-design" "83","pls" "83","nsuinteger" "83","byobu" "83","xbase" "83","iup" "83","opensolaris" "83","hana-xs" "83","drupal-fields" "83","uipath-robot" "83","sqlcl" "83","taskcompletionsource" "83","mobicents" "83","draper" "83","assemblybinding" "83","ntfs-mft" "83","tlist" "83","deviceid" "83","scalaz-stream" "83","convertview" "83","wxhaskell" "83","mkreversegeocoder" "83","dia" "83","spherical-coordinate" "83","proxy-authentication" "83","n-layer" "83","percent-encoding" "83","nivo-react" "83","color-codes" "83","peoplecode" "83","memory-optimization" "83","mendeley" "83","stringescapeutils" "83","cfchart" "83","spotify-scio" "83","google-container-os" "83","cursive" "83","qoq" "83","office-2003" "83","nibabel" "83","stm8" "83","getproperty" "83","tidycensus" "83","msaa" "83","bcs" "83","source-sets" "83","globalize3" "83","vaadin24" "83","ms-access-reports" "83","dart-http" "83","bigrquery" "83","glmm" "83","stylus-pen" "83","solana-transaction-instruction" "83","tools.jar" "83","argon2-ffi" "83","usernametoken" "83","webexception" "83","autofac-module" "83","hbs" "83","usersession" "82","fetching-strategy" "82","telegraf.js" "82","wicket-7" "82","clockkit" "82","websphere-mq-fte" "82","smallbasic" "82","client-library" "82","mupad" "82","xubuntu" "82","eclipse-hono" "82","xml-to-json" "82","blaze" "82","kudan" "82","ngb-datepicker" "82","pixate" "82","smf" "82","flashing" "82","firefox-addon-restartless" "82","apic" "82","symfony-mailer" "82","social-media-like" "82","datanode" "82","p3p" "82","pitch-shifting" "82","addslashes" "82","biztalk-2020" "82","n2cms" "82","django-reversion" "82","ora-06550" "82","awakefromnib" "82","server-to-server" "82","puremvc" "82","react-styleguidist" "82","django-nose" "82","gpiozero" "82","csharp-source-generator" "82","cryptoswift" "82","nativeapplication" "82","puppetlabs-apache" "82","uploadcare" "82","modeshape" "82","mongoose-plugins" "82","kcfinder" "82","brain.js" "82","ensembles" "82","eaglview" "82","early-stopping" "82","interopservices" "82","htmltools" "82","posh-git" "82","input-devices" "82","poster" "82","pdfnet" "82","iobluetooth" "82","kadanes-algorithm" "82","poptoviewcontroller" "82","booksleeve" "82","nsopenglview" "82","http-accept-header" "82","code-rally" "82","knockout-components" "82","microsoft-speech-api" "82","java-batch" "82","atlassian-fisheye" "82","mime-mail" "82","kotlintest" "82","abpersonviewcontroller" "82","oboe" "82","organic-groups" "82","jasmin" "82","virtual-device-manager" "82","shockwave" "82","audioformat" "82","typesafe-stack" "82","mkcoordinateregion" "82","notification-listener" "82","xcode7-beta5" "82","hipchat" "82","redeclare" "82","quosure" "82","ntl" "82","playstation3" "82","versions-maven-plugin" "82","hikvision" "82","geddy" "82","gated-recurrent-unit" "82","gamepad-api" "82","hashref" "82","logfile-analysis" "82","android-junit" "82","mosaic-plot" "82","nhibernate-projections" "82","angular2-material" "82","spreadsheetml" "82","cup" "82","morphing" "82","menhir" "82","lazylist" "82","curly-brackets" "82","ios7-statusbar" "82","member-pointers" "82","lov" "82","storage-duration" "82","custom-rom" "82","stocktwits" "82","log-level" "82","react-leaflet-v3" "82","pyvirtualdisplay" "82","utf-16le" "82","parentviewcontroller" "82","bicubic" "82","zcat" "82","iirf" "82","heartbleed-bug" "82","ember-rails" "82","heroku-ci" "82","mqttnet" "82","computability" "82","webpack-hot-middleware" "82","struts2-convention-plugin" "82","illegalaccessexception" "82","sun-codemodel" "82","dalekjs" "82","mule-connector" "82","autogen" "82","shelljs" "82","flutter-hooks" "82","zend-layout" "82","spark-jdbc" "82","mui-x-date-picker" "82","beyondcompare3" "82","subsonic2.2" "82","zend-form2" "82","pressure" "82","authy" "82","hdiv" "81","deepl" "81","flutter-canvas" "81","ssreflect" "81","deepface" "81","deepstream.io" "81","cncontactviewcontroller" "81","multiple-insert" "81","gitlab-pipelines" "81","bash4" "81","flexunit" "81","phpmd" "81","xsd-1.0" "81","jazz" "81","insmod" "81","process-monitoring" "81","feathers-sequelize" "81","eclipse-3.4" "81","clickhouse-client" "81","listbox-control" "81","apache-commons-lang" "81","mup" "81","jbossws" "81","symbolic-computation" "81","maptiler" "81","selectoneradio" "81","containskey" "81","selectionmodel" "81","platform-builder" "81","syncdb" "81","addressbookui" "81","management-studio-express" "81","cefpython" "81","lambdify" "81","packed" "81","apache-samza" "81","pandas-bokeh" "81","fsi" "81","ibm-jdk" "81","putimagedata" "81","sharedarraybuffer" "81","django-facebook" "81","vcxproj" "81","route-me" "81","wagmi" "81","vader" "81","rsa-archer-grc" "81","windowinsets" "81","meteor-collections" "81","kif-framework" "81","myob" "81","pdf-annotations" "81","jquery-bbq" "81","suphp" "81","eabi" "81","android-soong" "81","azure-devops-wiki" "81","online-game" "81","moleculer" "81","pdf-to-html" "81","invantive-sql" "81","opencv-contrib" "81","jzmq" "81","opends" "81","nsfilewrapper" "81","openfaas" "81","model-viewer" "81","android-studio-4.1" "81","apple-touch-icon" "81","entity-framework-core-2.2" "81","sample-size" "81","typo3-12.x" "81","osmosis" "81","system.web.optimization" "81","pyinotify" "81","mindate" "81","riemann" "81","authenticity-token" "81","ubuntu-unity" "81","richeditbox" "81",".net-reflector" "81","minhash" "81","uddi" "81","codenvy" "81","sframe" "81","syndication" "81","magicsuggest" "81","nx-workspace" "81","cocoonjs" "81","sha-3" "81","homogenous-transformation" "81","iterative-deepening" "81","cactivedataprovider" "81","ragel" "81","pmdarima" "81","nsunknownkeyexception" "81","xbl" "81","gwt-designer" "81","expando" "81","geckoview" "81","sceneview" "81","tdlib" "81","azure-waf" "81","hardware-security-module" "81","gamlss" "81","bulbs" "81","nuxt-content" "81","mkbundle" "81","ploneformgen" "81","modeladmin" "81","angular2-animation" "81","stm32ldiscovery" "81","current-time" "81","propertydescriptor" "81","elapsed" "81","comctl32" "81","google-document-viewer" "81","pythonw" "81","personal-access-token" "81","oggvorbis" "81","odb" "81","office-fabric" "81","textmatching" "81","persistence-unit" "81","commandargument" "81","iphone-3gs" "81","omr" "81","leadtools-sdk" "81","parameterized-types" "81","zest" "81","partiql" "81","hdbscan" "81","bayeux" "81","google-ima" "81","flutter-isar" "81","image-augmentation" "81","qtembedded" "81","mud" "81","ilspy" "81","partial-ordering" "81","web-administration" "81","font-awesome-4" "81","gmpy" "81","pre-compilation" "81","qttest" "81","preset" "81","iiop" "80","jenkins-x" "80","print-css" "80","jena-rules" "80","babel-node" "80","dbml" "80","vue-devtools" "80","php-gettext" "80","live-preview" "80","basehttprequesthandler" "80","backbarbuttonitem" "80","weinre" "80","truecrypt" "80","removable-storage" "80","tree-balancing" "80","backport" "80","localreport" "80","xsltforms" "80","tree-conflict" "80","xrdp" "80","selectmanycheckbox" "80","jsonbuilder" "80","function-signature" "80","pivottable.js" "80","filetree" "80","frisby.js" "80","undocumented-behavior" "80","json-value" "80","python-stackless" "80","django-commands" "80","socketrocket" "80","adaptive-threshold" "80","xmldataprovider" "80","mysqladmin" "80","jparepository" "80","dask-ml" "80","fastly" "80","psgi" "80","react-vis" "80","dash-bootstrap-components" "80","databricks-workflows" "80","callbackurl" "80","crystal-reports-server" "80","rouge" "80","serializearray" "80","uritemplate" "80","optional-values" "80","wagtail-snippet" "80","win32exception" "80","cryptostream" "80","hreflang" "80","coursera-api" "80","grunt-contrib-requirejs" "80","boost-signals" "80","ionic-popup" "80","invalidargumentexception" "80","boost-mpi" "80","twitter-login" "80","onmouseup" "80","spring-boot-security" "80","azure-devtest-labs" "80","inner-query" "80","pdf2image" "80","wsgen" "80","jqueryform" "80","wps" "80","app-launcher" "80","supabase-flutter" "80","jxtreetable" "80","jxtable" "80","cost-based-optimizer" "80","aquery" "80","initrd" "80","pci-bus" "80","blazor-hybrid" "80","wrapall" "80","nestjs-jwt" "80","sat-solvers" "80","postman-newman" "80","modin" "80","ocpjp" "80","system.printing" "80","outerhtml" "80","virtual-server" "80","atmosphere.js" "80","visual-studio-emulator" "80","rewritemap" "80","rfc2445" "80","libp2p" "80","osquery" "80","typedescriptor" "80","visual-studio-monaco" "80","formatted-text" "80","libmosquitto" "80","kotlin-lateinit" "80","bsc" "80","rastervis" "80","news-ticker" "80","viewpage" "80","javax.xml" "80","system.drawing.imaging" "80","javax.comm" "80","code-climate" "80","nutiteq" "80","ti-nspire" "80","referential-transparency" "80","exitstatus" "80","sqlresultsetmapping" "80","hakyll" "80","dotnet-publish" "80","android-device-monitor" "80","jacoco-plugin" "80","directcompute" "80","dropdownchoice" "80","r2winbugs" "80","bundle-install" "80","itunes-app" "80","asp.net-mvc-2-validation" "80","hive-query" "80","node-xmpp" "80","spliterator" "80","tex-live" "80","cunit" "80","colorbrewer" "80","mozart" "80","officedown" "80","string-constant" "80","acts-as-votable" "80","dumpsys" "80","gen-tcp" "80","google-cloud-data-transfer" "80","progressive" "80","stofdoctrineextensions" "80","ios8.4" "80","angular-devkit" "80","mplcursors" "80","node-amqplib" "80","cubic-bezier" "80","qbwc" "80","tfs-code-review" "80","ietf-netconf" "80","arscnview" "80","cyberduck" "80","focuslistener" "80","git-show" "80","trafficshaping" "80","gnuwin32" "80","compoundjs" "80","id-generation" "80","linestyle" "80","ember-cli-addons" "80","step-into" "80","mediarecorder-api" "80","z3c.form" "80","endl" "80","quercus" "80","pre-authentication" "80","sharp-snmp" "80","shellexecuteex" "80","maxscale" "80","compass-lucene" "80","mc" "80","soundjs" "79","math.sqrt" "79","groupingby" "79","grouped-table" "79","installanywhere" "79","program-files" "79","flir" "79","my.settings" "79","vue-storefront" "79","private-constructor" "79","deflatestream" "79","sitemapprovider" "79","ssrs-2019" "79","multistore" "79","integrated" "79","get-winevent" "79","phash" "79","map-files" "79","chokidar" "79","imp" "79","child-theming" "79","rustdoc" "79","flask-oauthlib" "79","symmetry" "79","uniformgrid" "79","flask-pymongo" "79","contentful-management" "79","flask-testing" "79","contentful-api" "79","vp9" "79","cilk-plus" "79","flamegraph" "79","picturefill" "79","socket.io-client" "79","service-fabric-on-premises" "79","pugjs" "79","psi" "79","windows-phone-7-emulator" "79","agile-project-management" "79","pyalgotrade" "79","reader-monad" "79","crosstool-ng" "79","pycparser" "79","cardano" "79","robotlegs" "79","databricks-cli" "79","django-filer" "79","readerwriterlockslim" "79","rtcp" "79","avvideocomposition" "79","mysql-error-1241" "79","updatesourcetrigger" "79","industrial" "79","jpl" "79","dnu" "79","window-messages" "79","gpath" "79","agora" "79","wikitext" "79","jpm" "79","simplexmlrpcserver" "79","capacity-planning" "79","aws-credentials" "79","momentum" "79","navigationitem" "79","inputbinding" "79","pbo" "79","postal" "79","kendo-angular-ui" "79","interval-tree" "79","bottomsheetdialogfragment" "79","jquery-scrollable" "79","swift3.2" "79","nsformatter" "79","dynamic-pages" "79","invokedynamic" "79","postgresql-extensions" "79","syndication-feed" "79","libconfig" "79","domo" "79","objective-sharpie" "79","word-list" "79","java-opts" "79","amazon-systems-manager" "79","libbpf" "79","system-sounds" "79","luke" "79","mailman" "79","extjs-stores" "79","anchorpoint" "79","external-sorting" "79","system.io.fileinfo" "79","winsockets" "79","sfdoctrineguard" "79","virtual-earth" "79","overflowexception" "79","android-espresso-recorder" "79","aspdotnetstorefront" "79","tanstack-table" "79","gcc5" "79","xamarin.ios-binding" "79","azure-information-protection" "79","pnpm-workspace" "79","handbrake" "79","noise-generator" "79","numba-pro" "79","timelapse" "79","exponential-backoff" "79","mklocalsearch" "79","drillthrough" "79","noflo" "79","conversion-tracking" "79","doubleanimation" "79","android-handlerthread" "79","openglcontext" "79","ischecked" "79","asp.net-bundling" "79","railsapps" "79","dropbox-sdk" "79","convert-tz" "79","tcltk" "79","ojalgo" "79","custom-activity" "79","moodle-mobile" "79","qkeyevent" "79","text-to-column" "79","string-agg" "79","qgroupbox" "79","ctc" "79","lostfocus" "79","http-status" "79","eunit" "79","request-validation" "79","activepivot" "79","acquia" "79","testautomationfx" "79","promotion-code" "79","angular-custom-validators" "79","lookbackapi" "79","spotfire-analyst" "79","maven-cobertura-plugin" "79","static-html" "79","multikey" "79","vaadin4spring" "79","automoq" "79","gnus" "79","daemonset" "79","imagebackground" "79","embedded-kafka" "79","prefix-sum" "79","google-maps-mobile" "79","focusable" "79","gmsplacepicker" "79","glkview" "79","spark-ui" "79","fody-propertychanged" "79","gmaps.js" "78","multiple-input" "78","fileappender" "78","sjcl" "78","mvvm-toolkit" "78","react-scroll" "78","vuejs-slots" "78","jayway" "78","effective-c++" "78","declared-property" "78","jcuda" "78","skype4py" "78","anonymize" "78","declarative-programming" "78","chrome-extension-manifest-v2" "78","connectexception" "78","next-link" "78","python-gitlab" "78","apache-storm-topology" "78","chrome-gcm" "78","ngx-pagination" "78","smoothstate.js" "78","selectpdf" "78","syncfusion-chart" "78","unbound" "78","pipenv-install" "78","adaptor" "78","uiviewcontrollerrepresentable" "78","unidac" "78","window.onunload" "78","name-collision" "78","akka.net-cluster" "78","puppeteer-cluster" "78","windowserror" "78","nanomsg" "78","cs3" "78","django-url-reverse" "78","roboto" "78","rsk" "78","servlet-container" "78","csslint" "78","django-shell" "78","keyset" "78","oprofile" "78","icefaces-1.8" "78","csg" "78","roaming" "78","nsd" "78","onmouseclick" "78","boilerpipe" "78","dynamic-usercontrols" "78","jquery-mobile-popup" "78","desktop-app-converter" "78","savepoints" "78","dynamic-class-creation" "78","jquery-1.7" "78","dynamic-function" "78","hpcc-ecl" "78","appjs" "78","blockquote" "78","gulp-imagemin" "78","jupyter-contrib-nbextensions" "78","tttattributedlabel" "78","samsung-knox" "78","pdfrw" "78","mollie" "78","wsod" "78","azman" "78","aws-vpn" "78","couchdb-python" "78","wrl" "78","turbo-rails" "78","go-chi" "78","codex" "78","vine" "78","brakeman" "78","objective-j" "78","legacy-sql" "78","foundry-slate" "78","orangehrm" "78","winsound" "78","midp-2.0" "78","wm-paint" "78","lf" "78","browser-security" "78","acaccount" "78","ubuntu-17.04" "78","diamond-operator" "78","tokyo-cabinet" "78","c#-11.0" "78","timeline.js" "78","numpy-random" "78","gwt-editors" "78","mlxtend" "78","byte-shifting" "78","xcode-workspace" "78","mmapi" "78","gwtbootstrap3" "78","ply-file-format" "78","hammerspoon" "78","tink" "78","reentrantreadwritelock" "78","timthumb" "78","noncopyable" "78","uiinclude" "78","sqlcachedependency" "78","b2" "78","android-ndk-r5" "78","property-placeholder" "78","custom-build-step" "78","communication-protocol" "78","google-cloud-error-reporting" "78","mpremotecommandcenter" "78","esqueleto" "78","actions-builder" "78","qquickitem" "78","geographic-distance" "78","android-log" "78","cgeventtap" "78","perforce-stream" "78","ex" "78","http-conduit" "78","lpr" "78","texttrimming" "78","zenject" "78","google-sites-2016" "78","mqtt-vernemq" "78","autodesk-construction-cloud" "78","mscapi" "78","subforms" "78","subpixel" "78","qtandroidextras" "78","d3plus" "78","spannablestringbuilder" "78","subresource-integrity" "78","md-select" "78","zend-router" "78","allegrograph" "78","tooling" "78","prawnto" "78","solr8" "78","flycheck" "78","presentation-layer" "78","msbuildextensionpack" "77","mate" "77","wicketstuff" "77","instaloader" "77","skins" "77","weakhashmap" "77","tensorflow-transform" "77","react-native-iap" "77","yajl" "77","jberet" "77","mutated" "77","eclipse-3.5" "77","maui-android" "77","webshim" "77","fibonacci-heap" "77","pagecontrol" "77","xmlgregoriancalendar" "77","check-constraint" "77","jspsych" "77","celementtree" "77","jscs" "77","next-redux-wrapper" "77","python-mss" "77","sendmail.exe" "77","selenium-webdriver-python" "77","filter-driver" "77","packaged-task" "77","packrat" "77","pic24" "77","address-space" "77","appcenter" "77","data-vault" "77","constructor-chaining" "77","wasm-pack" "77","angular-template-form" "77","kendo-treelist" "77","mysql-error-1242" "77","kiln" "77","rolling-sum" "77","r-portfolioanalytics" "77","data-comparison" "77","rp2040" "77","servlet-mapping" "77","graniteds" "77","microsoft-edge-chromium" "77","type-constructor" "77","scalajs-react" "77","core-elements" "77","jqtree" "77","mojolicious-lite" "77","io-completion-ports" "77","desiredcapabilities" "77","html-tag-details" "77","spring-integration-amqp" "77","jquery-droppable" "77","nsbuttoncell" "77","junit-rule" "77","k" "77","pcregrep" "77","jupyter-kernel" "77","blogger-dynamic-views" "77","onmeasure" "77","aqgridview" "77","port-number" "77","reverse-ajax" "77","attachment-fu" "77","bufferedoutputstream" "77","magnification" "77","rational-rsa" "77","rcs" "77","netbios" "77","analytics.js" "77","seven-segment-display" "77","vim-airline" "77","jaro-winkler" "77","build-time" "77","ocamlfind" "77","lemon" "77","taglist" "77","redigo" "77","expression-encoder" "77","dpi-aware" "77","gaps-in-data" "77","butterworth" "77","notimplementedexception" "77","plone-5.x" "77","asp.net-webcontrol" "77","dsharp+" "77","halting-problem" "77","hidpi" "77","caf" "77","dspic" "77","azurekinect" "77","ragged" "77","task-runner-explorer" "77","highland.js" "77","aspects" "77","opengrok" "77","scala-macro-paradise" "77","cookiejar" "77","npm-registry" "77","coloranimation" "77","elasticsearch-bulk-api" "77","nitro" "77","commando" "77","react-native-chart-kit" "77","eventqueue" "77","one2many" "77","stringwriter" "77","tomcat-valve" "77","genshi" "77","qmodelindex" "77","google-drive-picker" "77","custom-code" "77","geometric-arc" "77","prometheus-pushgateway" "77","mouse-picking" "77","httpcontent" "77","testng-annotation-test" "77","ipad-mini" "77","angular-factory" "77","com-automation" "77","acoustics" "77","array-indexing" "77","suid" "77","urn" "77","qt-mobility" "77","threadx" "77","idiorm" "77","hg-git" "77","webpack.config.js" "77","iio" "77","dagre" "77","complex-data-types" "77","statelistdrawable" "77","ignition" "77","darkflow" "77","lineargradientbrush" "77","areas" "77","fmp4" "76","flume-twitter" "76","react-native-track-player" "76","multiple-repositories" "76","gitlab-runner" "76","traversable" "76","ballerina-swan-lake" "76","gridjs" "76","jcodec" "76","graphics32" "76","fenwick-tree" "76","whiteboard" "76","princexml" "76","grecaptcha" "76","private-pub" "76","marshalbyrefobject" "76","tendermint" "76","interactive-shell" "76","release-builds" "76","skflow" "76","transloadit" "76","tryton" "76","prime31" "76","swiftui-view" "76","adp" "76","voltrb" "76","python-elixir" "76","db-first" "76","vmware-server" "76","chromedp" "76","softhsm" "76","connection-leaks" "76","circos" "76","json-lib" "76","advapi32" "76","app-certification-kit" "76","xla" "76","picocontainer" "76","uitabview" "76","soaplite" "76","soappy" "76","sencha-touch-2.3" "76","data-oriented-design" "76","fully-qualified-naming" "76","vanity-url" "76","singleton-methods" "76","servicemanager" "76","sitecore-ecm" "76","ibrokers" "76","robolectric-gradle-plugin" "76","awkward-array" "76","waffle-chart" "76","go-redis" "76","gpgme" "76","graceful-shutdown" "76","goquery" "76","document-oriented-db" "76","pub.dev" "76","microsoft-file-explorer" "76","dnvm" "76","go-to-definition" "76","aws-http-api" "76","createquery" "76","django-inheritance" "76","simpledom" "76","mylocationoverlay" "76","r-ranger" "76","carbon-design-system" "76","hspec" "76","wufoo" "76","appmobi" "76","grunt-contrib-cssmin" "76","scala-2.12" "76","nsfont" "76","powerapps-selected-items" "76","axios-mock-adapter" "76","dynamic-properties" "76","cox" "76","eaaccessory" "76","boost-lambda" "76","jquery-append" "76","android-update-app" "76","infopath-forms-services" "76","dx" "76","wlanapi" "76","extracttextwebpackplugin" "76","pyobject" "76","ringtonemanager" "76","coerce" "76","javascript-databinding" "76","bufferstrategy" "76","javapackager" "76","javascript-api-for-office" "76","broken-image" "76","newid" "76","typescript1.7" "76","gomock" "76","vimperator" "76","raiseevent" "76","libalsa" "76","code-migration" "76","pytest-fixtures" "76","domc" "76","aura-framework" "76","400-bad-request" "76","polymer-cli" "76","nodevalue" "76","timesten" "76","cordova-plugin-proguard" "76","uikeyboardtype" "76","c1flexgrid" "76","target-sdk" "76","gamecontroller" "76","node-set" "76","radare2" "76","gcc7" "76","drawingcontext" "76","assetslibrary" "76","azure-git-deployment" "76","expired-sessions" "76","memento" "76","laravel-snappy" "76","iqr" "76","androidpdfviewer" "76","nmf" "76","electron-updater" "76","node-debugger" "76","iostat" "76","com4j" "76","ipcrenderer" "76","react-google-login" "76","actionpack" "76","node-csv-parse" "76","proxysql" "76","texmaker" "76","ironpdf" "76","elasticsearch-watcher" "76","c-str" "76","project-settings" "76","react-dom-server" "76","oltp" "76","longtable" "76","scriptresource.axd" "76","identity-aware-proxy" "76","stdafx.h" "76","global-temp-tables" "76","image-file" "76","zend-server-ce" "76","flutter-future" "76","web-application-design" "76","msr" "76","google-style-guide" "76","iis-logs" "76","igrouping" "76","arq" "76","tga" "76","arpack" "76","concurrent-processing" "76","powerbi-api" "76","touchimageview" "76","compound-key" "76","quantlib-swig" "76","thinktecture" "76","parsekit" "76","seal" "76","prefuse" "76","thesaurus" "76","helmfile" "76","subsystem" "76","ilasm" "76","autodesk-navisworks" "76","thin-client" "75","cllocationdistance" "75","clearscript" "75","grel" "75","graphical-layout-editor" "75","ggfortify" "75","featuretoggle" "75","react-native-sound" "75","ansible-module" "75","antbuilder" "75","sling-models" "75","sktextureatlas" "75","ssh-config" "75","echosign" "75","github3.py" "75","interceptorstack" "75","easyrtc" "75","xquery-update" "75","weak-linking" "75","apache-commons-collection" "75","groff" "75","sql-server-migration-assi" "75","indesign-server" "75","fileresult" "75","front-camera" "75","jstat" "75","catransaction" "75","package-development" "75","self-updating" "75","fileprovider" "75","cdma" "75","fixnum" "75","fileversioninfo" "75","rubinius" "75","doctrine-mongodb" "75","airconsole" "75","kendo-datetimepicker" "75","aws-data-pipeline" "75","dnssec" "75","rosetta" "75","windows-phone-store" "75","dockpanel-suite" "75","windows-phone-8-sdk" "75","grpc-gateway" "75","simpleaudioengine" "75","neopixel" "75","defragmentation" "75","entity-framework-plus" "75","jquery-filter" "75","gtkbuilder" "75","popup-blocker" "75","jquery-mask" "75","jquery-mobile-button" "75","boost-iterators" "75","interleave" "75","openebs" "75","bonfire" "75","internalsvisibleto" "75","spring-filter" "75","azure-database-mysql" "75","native-sql" "75","html-safe" "75","workgroup" "75","nerddinner" "75","bounded-types" "75","visual-studio-test-runner" "75","visual-styles" "75","lego-mindstorms-ev3" "75","range-based-loop" "75","mistral-7b" "75","jawbone" "75","cocossharp" "75","domain-mapping" "75","pyffmpeg" "75","code-size" "75","fragment-caching" "75","orientjs" "75","magnitude" "75",".net-standard-2.1" "75","video-watermarking" "75","coinmarketcap" "75","objective-function" "75","mirth-connect" "75","setbounds" "75","netconnection" "75","library-path" "75","openpgp.js" "75","azure-sas" "75","explicit-specialization" "75","nosuchfileexception" "75","cordova-admob" "75","openhtmltopdf" "75","pls-00103" "75","italics" "75","uiprintinteractioncntrler" "75","gcj" "75","businessworks" "75","vertex-attributes" "75","gce-instance-group" "75","gamma-function" "75","quickgraph" "75","uicollectionviewdiffabledatasource" "75","tao" "75","dictation" "75","xbind" "75","android-flexboxlayout" "75","uint32-t" "75","dotpeek" "75","hill-climbing" "75","azure-linux" "75","octokit.net" "75","exasolution" "75","http-chunked" "75","cflags" "75","android-room-relation" "75","android-powermanager" "75","resume-download" "75","elassandra" "75","message-handlers" "75","qmail" "75","ipad-3" "75","react-google-recaptcha" "75","r-dygraphs" "75","logql" "75","spooler" "75","leadfoot" "75","google-closure-templates" "75","qhull" "75","resharper-7.1" "75","qsharedpointer" "75","complexheatmap" "75","foregroundnotification" "75","cvc4" "75","toolstripdropdown" "75","tform" "75","shedlock" "75","computer-name" "75","startapp" "75","automatonymous" "75","webkitaudiocontext" "75","heif" "75","autovivification" "75","theforeman" "75","solr-schema" "75","aria2" "75","trackball" "75","arduino-nano" "75","dart-analyzer" "75","pandoc-citeproc" "75","spark-hive" "75","qtlocation" "75","web-analytics-tools" "74","apache-commons-digester" "74","jdk1.4" "74","github-packages" "74","yahoo-oauth" "74","tensorflow1.15" "74","tsconfig-paths" "74","reporting-services-2012" "74","sslengine" "74","fieldtype" "74","lirc" "74","listtile" "74","sqr" "74","file-import" "74","babel-plugin" "74","teamcity-7.1" "74","skphysicsjoint" "74","badpaddingexception" "74","giphy-api" "74","templavoila" "74","eeglab" "74","jedi-vim" "74","giphy" "74","react-native-onesignal" "74","rust-tracing" "74","nfsclient" "74","file-organization" "74","adjustpan" "74","data-paging" "74","python-iris" "74","ownership-semantics" "74","bit-depth" "74","apache-nifi-registry" "74","jsmpp" "74","fw1" "74","advanced-rest-client" "74","pairwise.wilcox.test" "74","filterrific" "74","safe-browsing" "74","dayofmonth" "74","flask-uploads" "74","select-for-update" "74","cheetah" "74","selection-api" "74","pinojs" "74","firephp" "74","container-registry" "74","pim" "74","kura" "74","josephus" "74","docker-maven-plugin" "74","rparallel" "74","aiortc" "74","dng" "74","crm-ribbon-workbench" "74","kepler.gl" "74","robocode" "74","aws-nat-gateway" "74","facebook-test-users" "74","r-stars" "74","rle" "74","value-categories" "74","gperftools" "74","avcomposition" "74","vector-search" "74","azure-disk" "74","jquery-ui-widget-factory" "74","mod-fastcgi" "74","gsuite-addons" "74","svprogresshud" "74","gulp-karma" "74","onupdate" "74","bounding" "74","nsentitydescription" "74","spring-batch-job-monitoring" "74","pebble-js" "74","cp1251" "74","dependency-walker" "74","initial-context" "74","ensime" "74","depends" "74","bosun" "74","app-offline.htm" "74","desolve" "74","poodle-attack" "74","nsmetadataquery" "74","destruction" "74","nsmutableset" "74","dynamic-ip" "74","sign-extension" "74","magnetic-cards" "74","shadow-root" "74","virtualfilesystem" "74","buffer-overrun" "74",".net-client-profile" "74","miniprofiler" "74","kotlinpoet" "74","libm" "74","mit-kerberos" "74","external-script" "74","network-shares" "74","libgcrypt" "74","objloader" "74","code-separation" "74","breeze-sharp" "74","audio-capture" "74","java-wireless-toolkit" "74","rethrow" "74","google-apps-for-education" "74","tacit-programming" "74","sqlite-net-pcl" "74","refcell" "74","openvas" "74","aspmenu" "74","azure-synapse-pipeline" "74","scaletype" "74","pocketbase" "74","aspnet-contrib" "74","azure-function-app-proxy" "74","jail" "74","tinyioc" "74","itemdatabound" "74","nsxml" "74","screencast" "74","dsl-tools" "74","drupal-exposed-filter" "74","sql-server-ce-3.5" "74","guptateamdeveloper" "74","taps" "74","tampering" "74","openmesh" "74","speechsynthesizer" "74","lockbox-3" "74","mouse-coordinates" "74","google-email-settings-api" "74","android-jetifier" "74","custom-configuration" "74","persian-calendar" "74","qframe" "74","ltac" "74","strassen" "74","memory-footprint" "74","android-listadapter" "74","meetup" "74","proteus" "74","cfbundleidentifier" "74","perl-hash" "74","android-market-filtering" "74","custom-dimensions" "74","get-display-media" "74","excel-import" "74","oidc-client" "74","common-crawl" "74","cgcontextdrawimage" "74","acts-as-list" "74","accepts-nested-attributes" "74","userfrosting" "74","flymake" "74","user-friendly" "74","qudpsocket" "74","total.js" "74","qtextcursor" "74","tput" "74","gmsh" "74","cwnd" "74","mediasoup" "74","torchaudio" "74","line-count" "74","subtlecrypto" "74","statet" "74","google-tag-manager-server-side" "74","foldable" "74","parceler" "74","image-enhancement" "74","custom-sort" "74","sdlc" "74","composite-types" "74","zinnia" "74","stellar.js" "74","webdatagrid" "74","sunstudio" "74","premature-optimization" "74","arcgis-runtime-net" "74","im4java" "73","reorganize" "73","clang-ast-matchers" "73","xtify" "73","tridion2009" "73","php-parser" "73","yield-keyword" "73","react-native-mapbox-gl" "73","php-imap" "73","sktilemapnode" "73","masm64" "73","remoteio" "73","cksubscription" "73","multiprocessor" "73","dds-format" "73","transparentproxy" "73","flutter-dialog" "73","class-names" "73","material-components-ios" "73","laravel-datatables" "73","pixel-perfect" "73","apcu" "73","ftell" "73","pact-broker" "73","paddle-paddle" "73","fixeddocument" "73","fixed-data-table" "73","snowball" "73","imagemagick.net" "73","langchain-js" "73","ngzone" "73","plagiarism-detection" "73","impromptu" "73","fill-parent" "73","xmlstreamreader" "73","nftables" "73","umbraco-contour" "73","ultralytics" "73","planar-graph" "73","package-explorer" "73","cardreader" "73","contentmode" "73","fromcharcode" "73","furrr" "73","pickerview" "73","agiletoolkit" "73","datafeed" "73","rmiregistry" "73","unity-interception" "73","rootless" "73","kendo-tooltip" "73","aws-data-wrangler" "73","mybatis-mapper" "73","warm-up" "73","django-endless-pagination" "73","public-folders" "73","facebook-requests" "73","kitematic" "73","aws-lake-formation" "73","ahoy" "73","ruby-2.4" "73","sequencematcher" "73","databinder" "73","jomsocial" "73","cake-pattern" "73","sharp-architecture" "73","pose" "73","bootstrap5-modal" "73","hssfworkbook" "73","mogenerator" "73","aptitude" "73","dynamic-feature" "73","jquery-1.4" "73","turi-create" "73","workload" "73","karnaugh-map" "73","salesforce-commerce-cloud" "73","inform7" "73","sbteclipse" "73","openalpr" "73","modifiers" "73","password-policy" "73","twitter-feed" "73","dependency-resolver" "73","openears" "73","frank" "73","lwrp" "73","wonderware" "73","sysv" "73","lejos-nxj" "73","ordinals" "73","signedxml" "73","object-property" "73","foxit" "73","magnet-uri" "73","system.threading.channels" "73","google-awareness" "73","facebook-graph-api-v2.2" "73","system.io.compression" "73","ubuntu-19.04" "73","google-api-gateway" "73","system-center" "73","ambient" "73","javapns" "73","revisions" "73","pokeapi" "73","high-contrast" "73","non-latin" "73","gcloud-cli" "73","azure-video-indexer" "73","dexclassloader" "73","mockjax" "73","gemini" "73","android-doze-and-standby" "73","td-agent" "73","openh264" "73","referrer-policy" "73","nuclide-editor" "73","scancodes" "73","n-triples" "73","mootools-events" "73","react-native-component" "73","google-forms-api" "73","python-zip" "73","custom-field-type" "73","react-calendar" "73","column-family" "73","textlabel" "73","esoteric-languages" "73","request-cancelling" "73","qr-decomposition" "73","google-cloud-filestore" "73","stopiteration" "73","peft" "73","pyviz" "73","low-level-io" "73","duplicity" "73","merkle-tree" "73","best-fit" "73","hbmxml" "73","concrete5-5.7" "73","betfair" "73","powerpoint-2007" "73","concrete" "73","powershell-7.2" "73","maven-metadata" "73","haskell-wai" "73","multichoiceitems" "73","textwriter" "73","maven-eclipse-plugin" "73","power-saving" "73","ppapi" "73","dangerouslysetinnerhtml" "73","concordion" "73","tigase" "73","heapster" "73","trampolines" "73","sorm" "73","iics" "73","cvs2svn" "73","ember-controllers" "73","stetho" "73","md5-file" "73","query-analyzer" "73","google-knowledge-graph" "73","embedded-ruby" "73","predictive" "73","styledtext" "73","amazon-app-runner" "73","bgr" "73","queuing" "73","flutter-onpressed" "73","webdev.webserver" "72","skphysicscontact" "72","jetson-xavier" "72","babel-preset-env" "72","jdbc-pool" "72","fbsdkloginkit" "72","srv" "72","termcap" "72","weakmap" "72","stamp" "72","jdwp" "72","fennec" "72","well-formed" "72","filecontentresult" "72","matplotlib-venn" "72","class-instance-variables" "72","mass" "72","websphere-9" "72","phonejs" "72","fluid-styled-content" "72","printjs" "72","clp" "72","truezip" "72","flooding" "72","self-host-webapi" "72","bit.dev" "72","admin-generator" "72","umbraco-blog" "72","symfony-components" "72","bisonc++" "72","freetts" "72","firemonkey-fm3" "72","aec" "72","cilk" "72","xmlmapper" "72","impressions" "72","laravel-envoy" "72","bitcoin-testnet" "72","xdist" "72","pingdom" "72","addtextchangedlistener" "72","fiware-cosmos" "72","page-index-changed" "72","variable-substitution" "72","createthread" "72","simpletransformers" "72","against" "72","falcor" "72","cap-theorem" "72","narrator" "72","wcf-callbacks" "72","readerwriterlock" "72","serenity-js" "72","inline-images" "72","blotter" "72","guitar" "72","era5" "72","sap-data-services" "72","app-secret" "72","navigationlink" "72","postgresql-16" "72","junit5-extension-model" "72","app-themes" "72","sap" "72","positional-parameter" "72","mongock" "72","worker-service" "72","infinite-recursion" "72","deform" "72","svnserve" "72","simics" "72","ionide" "72","coderunner" "72","sigchld" "72","colander" "72","system.exit" "72","kotlin-dsl" "72","ksort" "72","form-post" "72","with-clause" "72","mailboxprocessor" "72","pyes" "72","windowstate" "72","magic-quotes-gpc" "72","google-blockly" "72","audit-tables" "72","facebook-fbml" "72","register-allocation" "72","openxr" "72","explicit-constructor" "72","redux-firestore" "72","togglz" "72","bullseye" "72","scope-resolution" "72","null-coalescing" "72","tabulizer" "72","dfu" "72","drupal-panels" "72","hibernate-cache" "72","device-mapper" "72","control-center" "72","scalate" "72","sqlobject" "72","tagname" "72","doxygen-wizard" "72","logentries" "72","custom-cursor" "72","evp-cipher" "72","pfquerytableviewcontrolle" "72","charactercount" "72","pythonxy" "72","character-replacement" "72","react-d3" "72","merb" "72","angular-compiler-cli" "72","esprima" "72","getdirectories" "72","cubemx" "72","messagepack" "72","center-align" "72","ios8.2" "72","httrack" "72","react-ga" "72","geoviews" "72","http-host" "72","olap4j" "72","mergefield" "72","commonschunkplugin" "72","react-fiber" "72","message-bus" "72","splunk-sdk" "72","qradiobutton" "72","propertyeditor" "72","stripping" "72","ilgenerator" "72","sony-smarteyeglass" "72","user-preferences" "72","computer-algebra-systems" "72","zend-amf" "72","mci" "72","bazel-cpp" "72","structure-from-motion" "72","utorrent" "72","fontello" "72","compatibility-mode" "72","solace-mq" "72","urlsearchparams" "72","parallel-arrays" "72","weborb" "72","qt5.2" "72","parents" "72","global-hotkey" "72","emq" "72","google-managed-vm" "72","alpn" "72","stdany" "71","floppy" "71","xtratreelist" "71","vue-meta" "71","cmsamplebufferref" "71","cloudways" "71","flopy" "71","eclipse-photon" "71","grid.mvc" "71","graphql-tag" "71","photo-upload" "71","multiple-matches" "71","slicknav" "71","react-routing" "71","youtube.net-api" "71","web-setup-project" "71","edititemtemplate" "71","installation-path" "71","ssh2-exec" "71","standardization" "71","pgvector" "71","multiple-return-values" "71","background-repeat" "71","nextsibling" "71","pact-lang" "71","adaptive-bitrate" "71","xpdf" "71","cbperipheralmanager" "71","python-dedupe" "71","firebug-lite" "71","distinguishedname" "71","mainloop" "71","next-generation-plugin" "71","implicit-typing" "71","connectycube" "71","undefined-variable" "71","cheminformatics" "71","pipfile" "71","firmata" "71","python-nonlocal" "71","varcharmax" "71","alertifyjs" "71","jni4net" "71","grafika" "71","angular-ui-tree" "71","angular-templatecache" "71","alarms" "71","unspecified-behavior" "71","rmq" "71","cap" "71","rpivottable" "71","jocl" "71","callable-object" "71","cakephp-2.7" "71","kissfft" "71","facetime" "71","operationcontract" "71","pyarmor" "71","micro-orm" "71","cradle" "71","kdoc" "71","android-shortcut" "71","cqlengine" "71","nspersistentdocument" "71","dynamics-crm-portals" "71","inquirerjs" "71","android-studio-bumblebee" "71","nsorderedset" "71","delete-record" "71","popen3" "71","nesc" "71","apptrackingtransparency" "71","applicationhost" "71","covariant" "71","opendds" "71","auth0-lock" "71","risc" "71","build-numbers" "71","minikanren" "71","ubsan" "71","signed-integer" "71","2phase-commit" "71","pyenv-virtualenv" "71","2dsphere" "71","netduino" "71","rfc2616" "71","vimeo-android" "71","winium" "71","facebook-business-sdk" "71","google-books-api" "71","eye-detection" "71","occlusion" "71","object-create" "71","schemaless" "71","honeywell" "71","nugetgallery" "71","ds-5" "71","redux-devtools-extension" "71","hilo" "71","scala-template" "71","openimaj" "71","hammingweight" "71","devicemotion" "71","gemset" "71","mkpolygon" "71","mobile-country-code" "71","c17" "71","playing" "71","targetinvocationexception" "71","timeslots" "71","uisearchbardisplaycontrol" "71","j48" "71","message-loop" "71","compact-framework2.0" "71","spray-client" "71","cgaffinetransformscale" "71","angular-fontawesome" "71","storage-engines" "71","stripe-payment-intent" "71","ektorp" "71","dundas" "71","mpmediaitemcollection" "71","cudafy.net" "71","eventlog-source" "71","elasticsearch-high-level-restclient" "71","qqmlapplicationengine" "71","currentuiculture" "71","perfview" "71","prometheus-java" "71","color-blending" "71","google-cloud-vpn" "71","permute" "71","angular-grid" "71","long-format-data" "71","qb64" "71","lua-5.1" "71","bep20" "71","state-diagram" "71","google-hadoop" "71","availability-zone" "71","mdt" "71","hcl-notes" "71","webharvest" "71","parsing-error" "71","papermill" "71","automount" "71","tiktok-api" "71","query-hints" "71","glance" "71","alternative-functor" "71","quasiquotes" "71","vaadin-charts" "71","parrot-os" "71","bernoulli-probability" "71","glteximage2d" "70","jdeps" "70","trichedit" "70","program-flow" "70","processors" "70","privilege" "70","cnf" "70","proc-report" "70","phpldapadmin" "70","printstacktrace" "70","multi-upload" "70","debug-information" "70","cldc" "70","gridex" "70","ef-power-tools" "70","mastodon" "70","lipo" "70","jform" "70","react-native-snap-carousel" "70","feedzirra" "70","muxer" "70","anytree" "70","martini" "70","cloudamqp" "70","yellowbrick" "70","bitronix" "70","over-the-air" "70","swinject" "70","mailtrap" "70","apache-velocity" "70","connector-j" "70","pkg-file" "70","physijs" "70","xml-nil" "70","firebase-polymer" "70","pageant" "70","bing-search" "70","rule-of-three" "70","lab-color-space" "70","uitoolbaritem" "70","vsixmanifest" "70","pitch-tracking" "70","adonisjs-ace" "70","cinemachine" "70","python-keyring" "70","adox" "70","mappoint" "70","data-lineage" "70","planetscale" "70","rxdatasources" "70","content-editor" "70","microsoft.codeanalysis" "70","value-initialization" "70","watcom" "70","joined-subclass" "70","mysql-select-db" "70","canexecute" "70","rugged" "70","variable-templates" "70","kentico-mvc" "70","gpg-agent" "70","rowtype" "70","josso" "70","fastled" "70","document-conversion" "70","dllnotfoundexception" "70","aws-backup" "70","mysql-error-1452" "70","avcapturemoviefileoutput" "70","swarmplot" "70","environments" "70","blazor-editform" "70","enquire.js" "70","ion-range-slider" "70","android-timer" "70","sap-xi" "70","azure-connect" "70","dynamic-resizing" "70","azure-dashboard" "70","ncache" "70","corrupt-data" "70","nat-traversal" "70","wso2-as" "70","twa" "70","group-summaries" "70","awt-eventqueue" "70","infobubble" "70","bluetooth-peripheral" "70","pdfhtml" "70","forward-list" "70","typescript-declarations" "70","netbeans-7.1" "70","vlc-android" "70","ktable" "70","winget" "70","shift-register" "70","pyrfc" "70","audio-converter" "70","wofstream" "70","coinbase-php" "70","richtextblock" "70","attunity" "70","system.data.oracleclient" "70","atlassian-crucible" "70","codeeffects" "70","korma" "70","ocmockito" "70","viewhelper" "70","jaxb2-basics" "70","victory-native" "70","reward" "70","vertex-array-object" "70","radiant" "70","qutip" "70","dropbox-sdk-js" "70","azure-sdk-for-java" "70","open-session-in-view" "70","scatterview" "70","pluck" "70","dev-null" "70","sqlcommandbuilder" "70","uitabcontroller" "70","tkinter.checkbutton" "70","drupal-10" "70","uibackgroundtask" "70","modalpopups" "70","directoryindex" "70","xbox-live" "70","non-convex" "70","azure-management" "70","no-duplicates" "70","c++builder-xe5" "70","angular2-form-validation" "70","angular-content-projection" "70","react-lifecycle-hooks" "70","petri-net" "70","splay-tree" "70","prolog-setof" "70","angular-dragdrop" "70","electron.net" "70","chaplinjs" "70","mergeddictionaries" "70","mesi" "70","chained-payments" "70","event-triggers" "70","ethercat" "70","stroke-dasharray" "70","storyblok" "70","personality-insights" "70","leaf" "70","merchant-account" "70","zypper" "70","httpentity" "70","generated-columns" "70","weblate" "70","toolstripbutton" "70","sonarlint-intellij" "70","google-shopping" "70","thread-abort" "70","thanos" "70","webcam.js" "70","flutter-sliverappbar" "70","static-resource" "70","sumoselect.js" "70","image-editor" "70","tibco-rv" "70","statusstrip" "70","elmo" "70","heartrate" "70","archlinux-arm" "70","mu" "70","amazon-comprehend" "70","autodeploy" "70","user-activity" "70","mujoco" "70","median-of-medians" "70","parallel-execution" "70","parasoft" "70","cyclicbarrier" "70","parse-javascript-sdk" "70","powershell-7.3" "70","zend-soap" "70","shelveset" "70","std-span" "70","solar" "69","template-aliases" "69","cloudkit-web-services" "69","github-actions-runners" "69","mat-sidenav" "69","remoteapi" "69","team-project" "69","phpdocumentor2" "69","mathprog" "69","tempo" "69","dbo" "69","ssa" "69","debug-backtrace" "69","int128" "69","stable-sort" "69","multipass" "69","related-content" "69","jcolorchooser" "69","jax-ws-customization" "69","transloco" "69","yank" "69","trx" "69","sssd" "69","xlsread" "69","disambiguation" "69","xmlunit-2" "69","xdgutils" "69","snipcart" "69","swiftui-text" "69","const-char" "69","app-data" "69","flask-jwt" "69","incanter" "69","swift-structs" "69","rust-ndarray" "69","flask-cache" "69","apng" "69","consul-template" "69","catch-all" "69","self-attention" "69","pagerduty" "69","containstable" "69","python-exec" "69","camel-http" "69","myspace" "69","windows-nt" "69","roo-gem" "69","icsharpcode" "69","jitterbit" "69","angular-validator" "69","rollout" "69","job-control" "69","redaction" "69","journaling" "69","roberta-language-model" "69","agsxmpp" "69","realex-payments-api" "69","fastlane-gym" "69","serilog-aspnetcore" "69","csquery" "69","index-signature" "69","svg-sprite" "69","interfacing" "69","enum-map" "69","suppression" "69","dynamic-links" "69","neoload" "69","apprtcdemo" "69","nservicebus5" "69","jquery-clone" "69","module-path" "69","mod-php" "69","applozic" "69","applicationdomain" "69","gstring" "69","svn-repository" "69","core-api" "69","inline-svg" "69","swift-dictionary" "69","mongodb-oplog" "69","houghlinesp" "69","nshttpcookie" "69","libgcc" "69","gollum-wiki" "69","typo3-4.5" "69","typst" "69","ribboncontrolslibrary" "69","coefplot" "69","amphp" "69","reverse-shell" "69","lexicon" "69","lexical-cast" "69","bro" "69","formats" "69","fabrication-gem" "69","kohana-auth" "69","go-colly" "69","kraft" "69","btle" "69","coingecko" "69","pysdl2" "69","visual-c++-2015" "69","hashids" "69","nsubiquitouskeyvaluestore" "69","doxywizard" "69","azure-webjobs-continuous" "69","tkinter-scale" "69","mochiweb" "69","taint" "69","hangfire-sql" "69","mknetworkkit" "69","scala-swing" "69","dsolve" "69","mobx-react-lite" "69","tinyurl" "69","spynner" "69","dremio" "69","uiimagepngrepresentation" "69","continuous-fourier" "69","bulksms" "69","downloadfileasync" "69","dotnet-test" "69","mlpack" "69","hashbytes" "69","bulk-email" "69","harfbuzz" "69","espressif-idf" "69","active-relation" "69","move-assignment-operator" "69","zscaler" "69","responsive-filemanager" "69","lua-5.2" "69","resharper-9.0" "69","ios-navigationview" "69","spreadsheet-protection" "69","react-cookie" "69","launching" "69","excanvas" "69","accessible" "69","terraform-provider" "69","compact-database" "69","http-status-code-200" "69","zstack" "69","spiffs" "69","motherboard" "69","chartjs-plugin-zoom" "69","mercurialeclipse" "69","tfs-web-access" "69","ms-project-server-2010" "69","linked-service" "69","amazon-redshift-serverless" "69","query-parser" "69","qtvirtualkeyboard" "69","usb4java" "69","amazon-cloudwatch-events" "69","amazon-chime" "69","transactional-email" "69","iec61131-3" "69","usermode" "69","haxelib" "69","folly" "68","federated-queries" "68","apache2-module" "68","clarion" "68","relational-operators" "68","click-through" "68","flow-js" "68","defects" "68","websocket++" "68","xsbt-web-plugin" "68","trustmanager" "68","fedora-23" "68","webseal" "68","ggpairs" "68","slrequest" "68","match-phrase" "68","whiptail" "68","tripadvisor" "68","function-binding" "68","major-upgrade" "68","json2html" "68","vscodium" "68","page-break-inside" "68","xmlhttprequest-level2" "68","mariadb-10.1" "68","data-virtualization" "68","runc" "68","data-members" "68","black-box" "68","laravel-factory" "68","circuit-sdk" "68","after-save" "68","imapclient" "68","binary-reproducibility" "68","swiftui-button" "68","imutils" "68","admin-ajax" "68","fs-extra" "68","kylo" "68","fixed-length-record" "68","segment-io" "68","confirmation-email" "68","pandas-explode" "68","date-sorting" "68","jpa-2.2" "68","jodd" "68","url-design" "68","rsh" "68","pulsar" "68","database-server" "68","winavr" "68","aws-appsync-resolver" "68","oracle-fusion-apps" "68","kgdb" "68","react-sortable-hoc" "68","alexa-internet" "68","watchos-4" "68","data-handling" "68","inequalities" "68","mysql-proxy" "68","twig-filter" "68","supplier" "68","blazor-component" "68","boost-gil" "68","tvjs" "68","inference-engine" "68","naturallyspeaking" "68","jquery-migrate" "68","wp-editor" "68","hortonworks-dataflow" "68","sap-r3" "68","mongo-express" "68","detekt" "68","easing-functions" "68","typed.js" "68","bootable" "68","anemic-domain-model" "68","write-host" "68","positional-argument" "68","boost-msm" "68","nssegmentedcontrol" "68","hostheaders" "68","guizero" "68","jquery-1.5" "68","dynamic-css" "68","pdf-lib.js" "68","go-build" "68","broadcom" "68","kotlin-reified-type-parameters" "68","bringtofront" "68","android-architecture-lifecycle" "68","nx.dev" "68","showdown" "68","google-appsheet" "68","type-kinds" "68","tzinfo" "68","outlook-object-model" "68","rbm" "68","rapache" "68","amibroker" "68","3d-engine" "68","shippo" "68","known-types" "68","pygame-clock" "68","woff2" "68","wkinterfacecontroller" "68","wmd-editor" "68","liblinear" "68","typesense" "68","java-security-manager" "68","sigbus" "68","macos-system-extension" "68","digital-ocean-apps" "68","execute-script" "68","execute-sql-task" "68","xcode6-beta6" "68","tinyscrollbar" "68","itemcommand" "68","vibed" "68","android-for-work" "68","c++builder-xe7" "68","xcode8-beta6" "68","copy-and-swap" "68","ui-calendar" "68","dfc" "68","sqlgeometry" "68","mlm" "68","android-chrome" "68","sqlitemanager" "68","mockito-kotlin" "68","c23" "68","drawbitmap" "68","isort" "68","copyonwritearraylist" "68","timestamping" "68","strictness" "68","elgamal" "68","prophet" "68","geoalchemy2" "68","change-management" "68","string-algorithm" "68","huggingface-hub" "68","qdbus" "68","custom-arrayadapter" "68","qgraphicstextitem" "68","splist" "68","http-kit" "68","genomicranges" "68","android-paint" "68","actor-model" "68","strawberry-graphql" "68","comparevalidator" "68","pendulum" "68","monochrome" "68","mosby" "68","react-memo" "68","etw-eventsource" "68","spectral-density" "68","request-response" "68","actioncontext" "68","eventfilter" "68","angular2-mdl" "68","protractor-net" "68","scriptrunner-for-jira" "68","space-efficiency" "68","solr-cell" "68","automocking" "68","glazedlists" "68","webarchive" "68","user-event" "68","security-testing" "68","mtproto" "68","thephpleague" "68","bias-neuron" "68","tfjs-node" "68","liclipse" "68","imageai" "68","ijson" "68","sonarlint-vs" "68","webdriverjs" "68","zend-inputfilter" "68","googletrans" "68","helpfile" "68","ember.js-2" "68","ierrorhandler" "68","parental-control" "68","msxsl" "68","the-little-schemer" "68","multiboot" "68","email-forwarding" "68","utility-method" "68","secp256k1" "68","queuetrigger" "68","concatmap" "68","emc" "68","compiled-query" "67","trusted" "67","xsi" "67","fedora20" "67","fedora-21" "67","ginkgo" "67","gini" "67","github-secret" "67","git-gc" "67","webtorrent" "67","renewal" "67","gibbon" "67","github-linguist" "67","processing-instruction" "67","clockwork" "67","profanity" "67","flutter-animatedlist" "67","ghost.py" "67","deepsecurity" "67","reportmanager" "67","markupbuilder" "67","ecj" "67","multiple-select-query" "67","integrator" "67","mutation-events" "67","yang" "67","clamav" "67","reification" "67","list-comparison" "67","filemerge" "67","clipper" "67","year2038" "67","sms-verification" "67","x-macros" "67","ulong" "67","apksigner" "67","aescryptoserviceprovider" "67","biomart" "67","finch" "67","swift-optionals" "67","mapping-model" "67","bjyauthorize" "67","smart-on-fhir" "67","file-security" "67","cassandra-4.0" "67","language-ext" "67","constraint-layout-chains" "67","ng-idle" "67","divio" "67","chat-gpt-4" "67","database-cluster" "67","unmodifiable" "67","rubular" "67","angular-redux" "67","cakephp-3.7" "67","rowset" "67","unmanagedresources" "67","pubspec.yaml" "67","google-weather-api" "67","indic" "67","facebook-workplace" "67","docker-java" "67","psr-2" "67","oracle-adf-mobile" "67","polyml" "67","boost-units" "67","epel" "67","tweenjs" "67","justgage" "67","working-set" "67","dynamic-analysis" "67","htmlcontrols" "67","spring-android" "67","sweet.js" "67","nested-documents" "67","nspredicateeditor" "67","keccak" "67","azure-acs" "67","juno-ide" "67","pbr" "67","jquery-ui-timepicker" "67","azure-cosmosdb-changefeed" "67","worklight-appcenter" "67","sangria" "67","wise" "67","viewbuilder" "67","pys60" "67","librsvg" "67","code-maintainability" "67","oauth2-proxy" "67","siesta-swift" "67","coda-slider" "67","abtest" "67","buildnumber-maven-plugin" "67","pysal" "67","android-6.0.1-marshmallow" "67","netsuite-rest-api" "67","klee" "67","retool" "67","analysisservices" "67","ucontext" "67","ras" "67","lzx" "67","external-js" "67","left-to-right" "67","bs4dash" "67","vmc" "67","milestone" "67","visitors" "67","object-comparison" "67","ranged-loops" "67","pyral" "67","radiobuttonfor" "67","nt" "67","jad" "67","ntlmv2" "67","ivyde" "67","mlrun" "67","tkinter.optionmenu" "67","scraperwiki" "67","button-to" "67","sqlc" "67","hilbert-curve" "67","byval" "67","scalameta" "67","openj9" "67","android-identifiers" "67","non-linear" "67","dotted-line" "67","cache-expiration" "67","devtoolset" "67","spree-auth-devise" "67","accumarray" "67","laravel-views" "67","custom-draw" "67","custom-directive" "67","google-cloud-trace" "67","irony" "67","isam" "67","stripos" "67","stringindexoutofbounds" "67","long-filenames" "67","lateral" "67","qhash" "67","sparse-file" "67","textreader" "67","cgbitmapcontextcreate" "67","oculusgo" "67","luabridge" "67","custompaging" "67","hubspot-crm" "67","straight-line-detection" "67","linden-scripting-language" "67","google-maps-engine" "67","zomato-api" "67","thingworx" "67","google-http-client" "67","emcee" "67","concave" "67","qstandarditem" "67","thickness" "67","tilde-expansion" "67","array-key-exists" "67","suhosin" "67","line-height" "67","berkeley-sockets" "67","avaudiofile" "67","stencils" "67","suggestbox" "67","cvzone" "67","compositing" "66","flixel" "66","fileloadexception" "66","materialized" "66","mathematica-frontend" "66","feathers-authentication" "66","cloudcustodian" "66","mutating-table" "66","anonymous-users" "66","intel-mic" "66","backblaze" "66","private-messaging" "66","stagewebview" "66","multi-page-application" "66","welcome-file" "66","graphicscontext" "66","balloon-tip" "66","eclipse-ditto" "66","rendered-attribute" "66","stack-corruption" "66","phantom-types" "66","matconvnet" "66","jboss-esb" "66","cmocka" "66","cleditor" "66","lmertest" "66","livescript" "66","dd-wrt" "66","clients" "66","matrix-transform" "66","musicxml" "66","matblazor" "66","skstorereviewcontroller" "66","declspec" "66","tsne" "66","primefaces-mobile" "66","lmax" "66","sencha-touch-2.2" "66","vosk" "66","js-of-ocaml" "66","laravel-dompdf" "66","laravel-admin" "66","firebase-app-indexing" "66","data-scrubbing" "66","managed-property" "66","cherokee" "66","cefsharp.offscreen" "66","segmentedcontrol" "66","xmltask" "66","dbaccess" "66","rosetta-stone" "66","sitecore7.1" "66","doi" "66","django-profiles" "66","mfp" "66","docusignapextoolkit" "66","jgrowl" "66","rows-affected" "66","mysqljs" "66","jhipster-gateway" "66","sitecollection" "66","alexa-smart-home-skill" "66","rlike" "66","rspec-mocks" "66","method-parameters" "66","nativecall" "66","canalyzer" "66","vueuse" "66","icenium" "66","root-certificate" "66","camlp4" "66","wiktionary" "66","readdirectorychangesw" "66","servletexception" "66","agm" "66","gs1-128" "66","twitpic" "66","svg-edit" "66","ion-select" "66","openfaces" "66","early-binding" "66","dependent-name" "66","onem2m" "66","wpf-extended-toolkit" "66","mom" "66","appsource" "66","nsdatadetector" "66","grunt-contrib-sass" "66","spring-junit" "66","swagger-maven-plugin" "66","table-alias" "66","ray-tune" "66","android-architecture" "66","outer-apply" "66","kraken.com" "66","brave-browser" "66","google-appengine-node" "66","kotlin-sharedflow" "66","rancher-desktop" "66","macvlan" "66","system.net.sockets" "66","machine-instruction" "66","system-alert-window" "66","magenta" "66","build-variant" "66","libgphoto2" "66","wml" "66","microsoft-speech-platform" "66","javascript-marked" "66","dom-repeat" "66","pyfftw" "66","library-design" "66","bubble.io" "66","24-bit" "66","ammonite" "66","tmuxinator" "66","jalali-calendar" "66","targets-r-package" "66","scanpy" "66","cookiemanager" "66","target-action" "66","sqlitejdbc" "66","asp.net-core-scaffolding" "66","time-measurement" "66","plumatic-schema" "66","dropnet" "66","devserver" "66","spring-social-twitter" "66","pointer-aliasing" "66","dialog-preference" "66","noty" "66","ispostback" "66","wxgrid" "66","tix" "66","openmeetings" "66","hal-json" "66","nsurlcredential" "66","redisclient" "66","excellibrary" "66","google-datastream" "66","qmdiarea" "66","protobuf-python" "66","prolog-findall" "66","splines" "66","propel2" "66","loglog" "66","google-dl-platform" "66","ton" "66","lavalamp" "66","cfqueryparam" "66","mellanox" "66","google-cloud-code" "66","http-status-code-204" "66","hugs" "66","iota" "66","layout-animation" "66","memory-optimized-tables" "66","nlua" "66","lstm-stateful" "66","launch-agent" "66","commutativity" "66","angularjs-bindings" "66","cssom" "66","locomotivejs" "66","colima" "66","prepros" "66","sublime-anaconda" "66","google-maps-urls" "66","automated-deployment" "66","elmish" "66","lifelines" "66","solidworksapi" "66","panresponder" "66","urlvariables" "66","webengine" "66","line-profiler" "66","google-pagespeed-insights-api" "66","zoneinfo" "66","web-garden" "66","parallel-python" "66","ie8-browser-mode" "66","mdbreact" "66","linearization" "66","urlrewriter.net" "65","report-builder2.0" "65","jaxws-maven-plugin" "65","ed" "65","materialbutton" "65","jenkins-build-flow" "65","cluetip" "65","skpaymenttransaction" "65","react-native-webrtc" "65","ecmascript-2020" "65","local-class" "65","react-native-swiper" "65","react-native-permissions" "65","defaultbutton" "65","git-interactive-rebase" "65","troposphere" "65","getstream-chat" "65","cloudwatch" "65","instagram-story" "65","vue-mixin" "65","background-transfer" "65","aos.js" "65","principles" "65","matlab-load" "65","classloading" "65","multiple-entries" "65","pg-trgm" "65","react-native-drawer" "65","teamsite" "65","wii" "65","mapinfo" "65","directxtk" "65","switch-expression" "65","apache-toree" "65","snapping" "65","xposed-framework" "65","markitup" "65","ngx-extended-pdf-viewer" "65","apache-royale" "65","firebird-.net-provider" "65","db2-connect" "65","adehabitathr" "65","incoming-mail" "65","jsvc" "65","kube-prometheus-stack" "65","l2tp" "65","django-ajax-selects" "65","jsperf" "65","distcc" "65","jsdt" "65","funq" "65","pivotaltracker" "65","afp" "65","python-regex" "65","bit-packing" "65","pades" "65","disnake" "65","function-fitting" "65","pixel-density" "65","px4" "65","go-sqlmock" "65","readable" "65","iban" "65","jpda" "65","hyperledger-fabric-sdk-go" "65","value-class" "65","icepdf" "65","recursive-type" "65","docker-exec" "65","cross-origin-resource-policy" "65","database-view" "65","django-notification" "65","rss2" "65","microsoft-forms" "65","cross-cutting-concerns" "65","roundtrip" "65","mysql-x-devapi" "65","server-side-attacks" "65","datadirectory" "65","n-api" "65","metis" "65","candlesticks" "65","factor-lang" "65","docxtemplater" "65","jqmobi" "65","input-parameters" "65","spring-mvc-initbinders" "65","dynamic-ui" "65","opencv-mat" "65","design-view" "65","swift-framework" "65","password-manager" "65","iolanguage" "65","guard-clause" "65","openconnect" "65","application-verifier" "65","android-studio-4.2" "65","wscript.shell" "65","patroni" "65","html-object" "65","android-studio-3.6" "65","insecure-connection" "65","apple-app-site-associate" "65","dynamic-script-loading" "65","onejar" "65","payflowlink" "65","risk-analysis" "65","visual-prolog" "65","ripgrep" "65",".emf" "65","codenarc" "65","rave-reports" "65","microsoft-graph-intune" "65","for-json" "65","libarchive" "65","fortran2008" "65","browser-console" "65","viewmodifier" "65","viridis" "65","codehighlighter" "65","wolfssl" "65",".aspxauth" "65","ammo.js" "65","gccgo" "65","rails-3.1" "65","asp.net-development-serv" "65","handlebars.java" "65","schema-migration" "65","non-alphanumeric" "65","draggesture" "65","reflex" "65","dijit.tree" "65","cookielib" "65","regex-replace" "65","rack-middleware" "65","numpy-indexing" "65","hive-udf" "65","android-gravity" "65","nme" "65","pg8000" "65","ipojo" "65","mpi-io" "65","lpt" "65","esri-leaflet" "65","geosparql" "65","memory-warning" "65","pywavelets" "65","android-jack-and-jill" "65","react-native-community-netinfo" "65","perl-pod" "65","cfgrid" "65","eulers-number" "65","reactive-kafka" "65","qmetaobject" "65","comonad" "65","leaflet-geoman" "65","iphoto" "65","message-listener" "65","coldfusion-7" "65","omniorb" "65","stringgrid" "65","custom-backend" "65","billboard.js" "65","statamic" "65","global-state" "65","google-nearby-connections" "65","gnn" "65","heaps-algorithm" "65","amazon-cognito-facebook" "65","gl-triangle-strip" "65","cvi" "65","foolproof-validation" "65","authzforce" "65","automapper-4" "65","styleddocument" "65","google-pie-chart" "65","ido" "65","foreign-collection" "65","qt5.9" "65","ie-automation" "65","quantization-aware-training" "65","flutter-in-app-purchase" "65","paredit" "65","sparkcore" "65","mqtt.js" "65","git-shell" "65","std-future" "65","tr24731" "65","medium-editor" "65","linker-warning" "65","zend-tool" "65","stm32h7" "64","phpexcel-1.8.0" "64","github-release" "64","cldr" "64","yara" "64","react-native-sqlite-storage" "64","trivy" "64","remotecommand" "64","back-button-control" "64","matroska" "64","photologue" "64","ffbase" "64","profile-picture" "64","great-firewall-of-china" "64","marko" "64","intel-mpi" "64","vuetify-datatable" "64","c-libraries" "64","liquid-template" "64","yii-widgets" "64","snowfall" "64","kubernetes-rbac" "64","addin-express" "64","ccaction" "64","implicit-declaration" "64","adodb-php" "64","django-cron" "64","chronoforms" "64","ovirt" "64","pixel-bender" "64","adxstudio-portals" "64","xdr" "64","function-approximation" "64","bionic" "64","full-table-scan" "64","flashback" "64","apollo-cache-inmemory" "64","managed-directx" "64","first-chance-exception" "64","smoke-testing" "64","xhtml-transitional" "64","pipedrive-api" "64","palm" "64","alex" "64","dojo-build" "64","ptc-windchill" "64","alfred" "64","datafield" "64","dataflow-diagram" "64","nanoframework" "64","routetable" "64","documentum6.5" "64","rstanarm" "64","docbook-5" "64","jil" "64","venmo" "64","google-website-optimizer" "64","rope" "64","nativewind" "64","negamax" "64","opc-da" "64","enterprise-library-6" "64","nesper" "64","nservicebus-sagas" "64","bootstrap-tokenfield" "64","spring-data-mongodb-reactive" "64","android-virtual-keyboard" "64","spring-data-envers" "64","dynamics-ax7" "64","modi" "64","axacropdf" "64","tufte" "64","axis2c" "64","hp-nonstop" "64","inherited-widget" "64","delicious-api" "64","boofcv" "64","entity-framework-core-migrations" "64","onos" "64","pdl" "64","cosign-api" "64","woocommerce-memberships" "64","object-serialization" "64","orchardcms-1.10" "64","winnovative" "64","accent-insensitive" "64","osisoft" "64","r-googlesheets" "64","sigfpe" "64","vline" "64","godeps" "64","libimobiledevice" "64","goo.gl" "64","asyncapi" "64","wm-copydata" "64","rangevalidator" "64","lvalue-to-rvalue" "64","misspelling" "64","typescript-class" "64","ripple-effect" "64","visual-c++-2013" "64","nethereum" "64","facebook-feed" "64","virtual-desktop" "64","numpydoc" "64","refile" "64","dhall" "64","dotnet-aspire" "64","bybit" "64","sqlbase" "64","scalapack" "64","rabbitmq-shovel" "64","coords" "64","xcodeproj" "64","point-of-interest" "64","nsvalue" "64","dreamfactory" "64","redmi-device" "64","uiinputviewcontroller" "64","handoff" "64","gaps-in-visuals" "64","sqlite-json1" "64","pnotify" "64","numeric-keypad" "64","exchange-server-2016" "64","taffydb" "64","tao-framework" "64","openoffice-base" "64","ironsource" "64","motorola-droid" "64","geoip2" "64","spreadsheetlight" "64","nls-lang" "64","iri" "64","spfx-extension" "64","angular-daterangepicker" "64","google-domain-api" "64","nlu" "64","android-jetpack-compose-layout" "64","geom-hline" "64","exadata" "64","performance-monitor" "64","customer-account-data-api" "64","respond.js" "64","resty-gwt" "64","electron-react-boilerplate" "64","node-orm2" "64","ldflags" "64","mule-cluster" "64","arithmeticexception" "64","partial-postback" "64","scriptella" "64","pantheon" "64","web-architecture" "64","stateserver" "64","dandelion" "64","mrunit" "64","fluxcd" "64","zend-date" "64","autogeneratecolumn" "64","autogrow" "64","amazon-appflow" "64","qstyle" "64","git-untracked" "64","secure-crt" "64","starscream" "64","scrollcontroller" "64","glitch-framework" "64","alivepdf" "64","articulate-storyline" "64","uwamp" "63","web-share" "63","github-codereviews" "63","background-application" "63","reportng" "63","xvalue" "63","tealium" "63","ef-model-builder" "63","ssziparchive" "63","template-inheritance" "63","ssg" "63","reportgenerator" "63","mxe" "63","graphical-programming" "63","localtunnel" "63","backbone-forms" "63","ssao" "63","private-inheritance" "63","smartadmin" "63","greenhills" "63","fhir-server-for-azure" "63","process-explorer" "63","webpagetest" "63","react-native-linking" "63","apache-beam-kafkaio" "63","llvmlite" "63","liveedit" "63","xml-dml" "63","packageinstaller" "63","p6spy" "63","xoom" "63","unit-type" "63","umbraco-ucommerce" "63","imap-open" "63","uncaught-reference-error" "63","mantissa" "63","xlabs" "63","fstab" "63","python-textfsm" "63","distribution-list" "63","xinetd" "63","adminjs" "63","datamodule" "63","jscience" "63","fitsharp" "63","flask-script" "63","choetl" "63","cim" "63","smartsvn" "63","pixelate" "63","data-tier-applications" "63","cielab" "63","microsoft-ajax" "63","angularjs-ng-class" "63","fantom" "63","wcf-routing" "63","go-zap" "63","rubaxa-sortable" "63","rubber-band" "63","shared-data" "63","rtems" "63","kitti" "63","sitecore-workflow" "63","named-graphs" "63","mysql-error-1146" "63","vwdexpress" "63","angular-material-datetimepicker" "63","granularity" "63","graaljs" "63","server-rendering" "63","datahandler" "63","wamp64" "63","myget" "63","aggregateexception" "63","invitation" "63","html-help" "63","type-2-dimension" "63","httpapplication" "63","sast" "63","nested-map" "63","jump-table" "63","boost-coroutine" "63","android-unity-plugin" "63","apps-for-office" "63","pdfpages" "63","azure-devops-hosted-agent" "63","svndump" "63","deployment-target" "63","nats-jetstream" "63","passport-twitter" "63","delphi-ide" "63","springlayout" "63","houdini" "63","blockchain.info-api" "63","saxon-js" "63","android-speech-api" "63","appstorage" "63","cppyy" "63","nservicebus3" "63","ws-client" "63","visual-artifacts" "63","fortrabbit" "63","browsershot" "63","ratchet-2" "63","system.security" "63","richtextfx" "63","8thwall-xr" "63","libmemcache" "63","ableton-live" "63","objectscript" "63","2048" "63","object-to-string" "63","tablefilter" "63","vimage" "63","cocos2d-html5" "63","osqa" "63","vms" "63","google-bucket" "63","rd" "63","authority" "63","rgui" "63","go-map" "63","typo3-7.x" "63","tablegateway" "63","rcw" "63","outlook-for-mac" "63","ocra" "63","coco" "63","attr-encrypted" "63",".net-4.7.1" "63","rauth" "63","shred" "63","retro-computing" "63","luminance" "63","retrywhen" "63","virtual-network" "63","wordcloud2" "63","oas" "63",".npmrc" "63","vidyo" "63","redeclaration" "63","contracts" "63","uiprogressbar" "63","directfb" "63","contiki-ng" "63","j#" "63","timeofday" "63","nullif" "63","dotcmis" "63","dtf" "63","item-decoration" "63","mo" "63","harmon.ie" "63","qurl" "63","gatling-plugin" "63","uisearchresultscontroller" "63","gdataxml" "63","mobilefirst-appcenter" "63","coordinator-pattern" "63","harp" "63","azure-site-recovery" "63","general-network-error" "63","table-structure" "63","openmq" "63","asp.net-webhooks" "63","oneclick" "63","mpiexec" "63","pfrelation" "63","terraform-aws-modules" "63","android-pagetransformer" "63","ofx" "63","get-mapping" "63","collapsiblepanelextender" "63","perl-critic" "63","leadbolt" "63","generic-type-parameters" "63","qpropertyanimation" "63","qproperty" "63","http-unit" "63","tesselation" "63","test-class" "63","elixir-poison" "63","strongswan" "63","member-access" "63","logos" "63","react-hoc" "63","tomcat-jdbc" "63","google-shared-contacts" "63","ember-octane" "63","lifo" "63","quectel" "63","asammdf" "63","mecab" "63","auto-close" "63","structlog" "63","pascalcasing" "63","iis-manager" "63","embedded-browser" "63","illegal-instruction" "63","qualified-name" "63","zabbix-api" "63","qtplugin" "63","elpy" "63","haskell-mode" "63","mediabrowserservicecompat" "63","querypath" "63","seesaw" "63","parameterized-tests" "63","complex-networks" "63","powerdns" "63","beancreationexception" "63","focusmanager" "63","zendesk-app" "63","flutterwave" "63","alibaba-cloud-ecs" "63","arbor.js" "62","apache-commons-daemon" "62","debugview" "62","photon-pun" "62","apache-commons-codec" "62","install-name-tool" "62","sql-server-json" "62","loadnibnamed" "62","llama-cpp-python" "62","tritium" "62","instantiationexception" "62","load-path" "62","photosphere" "62","easyslider" "62","clique-problem" "62","master-data-management" "62","massif" "62","gh-unit" "62","mwphotobrowser" "62","graphql-schema" "62","clientbundle" "62","when-js" "62","skyscanner" "62","xunit2" "62","private-network" "62","mathquill" "62","default-interface-member" "62","deface" "62","vows" "62","chomsky-normal-form" "62","running-count" "62","s3-kafka-connector" "62","nhibernate-envers" "62","dbfit" "62","appgyver" "62","pkgdown" "62","umbraco5" "62","labwindows" "62","ims" "62","pintos" "62","adgroup" "62","unchecked-exception" "62","addobserver" "62","xhprof" "62","uncss" "62","fiware-wilma" "62","makie.jl" "62","pancakeswap" "62","binlog" "62","firefox-quantum" "62","windows-2000" "62","hyperledger-caliper" "62","dll-reference" "62","windows-rs" "62","camel-cxf" "62","albumentations" "62","update-site" "62","ropensci" "62","routerlinkactive" "62","rprofile" "62","database-diagram" "62","pvs-studio" "62","meta-predicate" "62","simpsons-rule" "62","reasoner" "62","pure-css" "62","kendo-validator" "62","vaapi" "62","rpython" "62","keypaths" "62","nagiosxi" "62","unity-web-player" "62","universal-reference" "62","kepler" "62","name-clash" "62","jquery-ui-touch-punch" "62","keepass" "62","box-sizing" "62","aws-sdk-js-v3" "62","wsdualhttpbinding" "62","counterclockwise" "62","jxta" "62","juggernaut" "62","hpcc" "62","www-authenticate" "62","dynamic-type-feature" "62","jqtransform" "62","on-premises-instances" "62","initializecomponent" "62","pdp" "62","jquery-mobile-navbar" "62","poplib" "62","spring-initializr" "62","lucidworks" "62","setrlimit" "62","lucid" "62","audio-worklet" "62","windows-users" "62","form-load" "62","go-context" "62","buildah" "62","visual-studio-app-center-distribute" "62","audiovideoplayback" "62","libnet" "62","android-autofill-manager" "62","kotlin-js-interop" "62","google-api-javascript-client" "62","pyngrok" "62","ubuntu-9.04" "62","lgpl" "62","java-19" "62","viewdidunload" "62","mailcatcher" "62","system-requirements" "62","visionkit" "62","facebook-messages" "62","build-events" "62","android-4.1-jelly-bean" "62","virtualalloc" "62","vlang" "62","driver-signing" "62","jacorb" "62","exe4j" "62","poller" "62","versioninfo" "62","dredd" "62","contextroot" "62","highcharts-gantt" "62","bump-mapping" "62","playstation" "62","hardware-id" "62","scala-xml" "62","azure-media-player" "62","redistogo" "62","pointerlock" "62","modal-view" "62","playorm" "62","exchange-online" "62","excel-lambda" "62","gvnix" "62","assisted-inject" "62","directory-permissions" "62","digital-persona-sdk" "62","dotmemory" "62","quicksight-embedding" "62","azure-stack" "62","mkmapitem" "62","opennebula" "62","redcloth" "62","android-custom-attributes" "62","gant" "62","gdax-api" "62","pocket" "62","terratest" "62","generic-variance" "62","iperf3" "62","textctrl" "62","ironworker" "62","eula" "62","perfect-hash" "62","lastpass" "62","okta-signin-widget" "62","property-injection" "62","google-cloud-pubsub-emulator" "62","spookyjs" "62","custom-attribute" "62","node-html-pdf" "62","lpcwstr" "62","strtod" "62","csvwriter" "62","project-panama" "62","eventtocommand" "62","omegaconf" "62","toolsapi" "62","use-form" "62","predix" "62","security-policy" "62","msbuild-target" "62","authorized-keys" "62","scxml" "62","alter-column" "62","soundfile" "62","papertrail-app" "62","zend-config" "62","autobean" "62","google-maps-styling" "62","usmap" "62","zend-http-client" "62","auto-responder" "62","imagedata" "62","auto-route" "62","tortoisecvs" "62","image-clipping" "62","user-variables" "62","authsub" "62","scriptlab" "62","structural-pattern-matching" "62","trailblazer" "62","beast" "62","mser" "62","tilelist" "62","thunderclient" "62","userdetailsservice" "61","phpdocx" "61","stanza" "61","vue-formulate" "61","prism-5" "61","sql-server-native-client" "61","maui-ios" "61","intellij-idea-2016" "61","phpdesktop" "61","matisse" "61","installscript-msi" "61","edb" "61","background-sync" "61","fluentftp" "61","apache-directory" "61","github-ci" "61","react-pdfrenderer" "61","r-environment" "61","git-annex" "61","marklogic-7" "61","fieldofview" "61","php-pest" "61","integromat-apps" "61","wgsl" "61","slack-dialog" "61","yourls" "61","babel-cli" "61","github-oauth" "61","skphysicsworld" "61","insertadjacenthtml" "61","xemacs" "61","frombodyattribute" "61","swiftui-ontapgesture" "61","swiftui-previews" "61","dirty-data" "61","paceautomationframework" "61","xmpppy" "61","swirl" "61","swift-nio" "61","rythm" "61","adal4j" "61","nexus-prisma" "61","chomp" "61","dataspell" "61","rsl" "61","akka-remoting" "61","dmp" "61","session-fixation" "61","recent-file-list" "61","rtl-sdr" "61","oracle-rest-data-services" "61","docx-mailmerge" "61","go-pg" "61","jnativehook" "61","cryptarithmetic-puzzle" "61","name-decoration" "61","unreachable-statement" "61","upstream-branch" "61","oracleapplications" "61","aws-s3-client" "61","variants" "61","fast-csv" "61","angular-ng-class" "61","urbancode" "61","serverless-application-model" "61","rtcmulticonnection" "61","dlookup" "61","windows-clustering" "61","meteor-packages" "61","postgresql-8.3" "61","aws-vpc-peering" "61","hotjar" "61","supertype" "61","core-file" "61","popsql" "61","dynamics-crm-365-v9" "61","neo4j-java-api" "61","nscursor" "61","dvorak" "61","erlang-nif" "61","html-generation" "61","pdf-writer" "61","neo4j-browser" "61","pausing-execution" "61","azure-cosmosdb-tables" "61","aptos" "61","applicationcontroller" "61","post-conditions" "61","passport-local-mongoose" "61","botman" "61","nested-views" "61","desctools" "61","jwrapper" "61","gulp-typescript" "61","deselect" "61","sap-successfactors" "61","epoxy" "61","modifier-key" "61","silent-notification" "61","java-calendar" "61","video-upload" "61","amp-list" "61","codemirror-modes" "61","fortran-common-block" "61","wmi-service" "61","codacy" "61","attach-to-process" "61","system-tables" "61","google-app-engine-go" "61","kotlinc" "61","systemcolors" "61","uci" "61","midje" "61","breakpoint-sass" "61","word-2003" "61","udeploy" "61","rfc2822" "61","formmail" "61","knockout-templating" "61","magento-layout-xml" "61","abseil" "61","codesourcery" "61","knp-snappy" "61","codeanywhere" "61","maemo" "61","bulk-operations" "61","dotnet-tool" "61","historian" "61","convention-over-configur" "61","gchart" "61","drupal-comments" "61","context-switching" "61","gcloud-python" "61","drbd" "61","radchart" "61","model-driven-development" "61","android-image-capture" "61","gated-checkin" "61","mod-dav-svn" "61","quick-search" "61","modelbinder" "61","r6rs" "61","redux-mock-store" "61","non-unicode" "61","xamarin.forms.maps" "61","npm-shrinkwrap" "61","export-to-xml" "61","sql-server-group-concat" "61","tcpreplay" "61","nsvaluetransformer" "61","xctestexpectation" "61","nsurlerrordomain" "61","gwt-bootstrap" "61","genson" "61","node-config" "61","officewriter" "61","spreadjs" "61","lowest-common-ancestor" "61","respect-validation" "61","ipaf" "61","office-communicator" "61","resiliency" "61","zurb-joyride" "61","hungarian-notation" "61","hung" "61","custom-event" "61","locked-files" "61","comfortable-mexican-sofa" "61","android-layout-editor" "61","project-loom" "61","httpoison" "61","njsonschema" "61","colon-equals" "61","angular-cli-v8" "61","android-photoview" "61","moped" "61","geom-vline" "61","elementary-os" "61","react-image" "61","cfform" "61","resource-scheduling" "61","tiki-wiki" "61","hcaptcha" "61","security-framework" "61","msflexgrid" "61","sttwitterapi" "61","cyber-panel" "61","lineseries" "61","dacl" "61","emblem.js" "61","asciidoctor-pdf" "61","font-style" "61","stdev" "61","auto-keras" "61","allocatable-array" "61","autoit-c#-wrapper" "61","google-play-internal-testing" "61","concourse-pipeline" "61","flutter-positioned" "61","tracesource" "61","haystack" "61","search-engine-bots" "61","web-console" "60","websolr" "60","yearmonth" "60","echonest" "60","sitefinity-4" "60","antenna-house" "60","f-bounded-polymorphism" "60","ant-colony" "60","multitexturing" "60","file-in-use" "60","squishit" "60","dbms-job" "60","web-search" "60","feature-flags" "60","smalldatetime" "60","slugify" "60","react-snap" "60","render-to-string" "60","defer-keyword" "60","skeleton-code" "60","trellis" "60","jdk6" "60","widgetliveactivity" "60","clicking" "60","proget" "60","flutter-aws-amplify" "60","jet-sql" "60","apache-apisix" "60","tronweb" "60","marklogic-optic-api" "60","skobbler-maps" "60","symfony-http-foundation" "60","disclosure" "60","imeoptions" "60","datarelation" "60","xproc" "60","jsqlparser" "60","marker-interfaces" "60","conftest" "60","jsr330" "60","software-update" "60","mappedbytebuffer" "60","jscodeshift" "60","s3distcp" "60","circuit-diagram" "60","image-replacement" "60","piracy" "60","flaui" "60","jsforce" "60","bindableproperty" "60","ng-app" "60","imageprocessor" "60","xpack" "60","firemonkey-fm2" "60","datanitro" "60","database-scan" "60","gps-time" "60","read-replication" "60","servicepointmanager" "60","jinput" "60","django-rq" "60","alfresco-maven" "60","windows-phone-toolkit" "60","until-loop" "60","wcffacility" "60","facebook-stream-story" "60","react-to-print" "60","psalm-php" "60","alglib" "60","algorand" "60","keymaps" "60","joomla-article" "60","jooq-codegen" "60","wasi" "60","factoring" "60","angular-loopback" "60","react-tabs" "60","oppo" "60","warc" "60","angular-nativescript" "60","avisynth" "60","cal" "60","spring-cloud-bus" "60","ionic-vue" "60","azkaban" "60","jrun" "60","onitemlongclicklistener" "60","spring-data-commons" "60","boost-spirit-lex" "60","scala-generics" "60","html-components" "60","axshockwaveflash" "60","appstats" "60","sap-cap" "60","dx-data-grid" "60","initramfs" "60","path-separator" "60","mongodb-nodejs-driver" "60","interface-segregation-principle" "60","azure-appfabric" "60","popviewcontrolleranimated" "60","nscontrol" "60","apple-pdfkit" "60","azure-elastic-scale" "60","mido" "60","set-comprehension" "60","shogun" "60","rfc5766turnserver" "60","pyroot" "60","pylatex" "60","jasper-plugin" "60","microsoft-graph-onenote" "60","signaling" "60","vista64" "60","miracast" "60","network-service" "60","riak-search" "60","typeddict" "60","libressl" "60","ably-realtime" "60","gofmt" "60","google-app-indexing" "60","t3" "60","ntpd" "60","non-modal" "60","associated-object" "60","iunknown" "60","dial-up" "60","uialertviewdelegate" "60","isomorphic-fetch-api" "60","hksamplequery" "60","genealogy" "60","gwt-2.5" "60","sqlps" "60","version-control-migration" "60","gboard" "60","hashcat" "60","plugin-architecture" "60","scale-color-manual" "60","uidynamicanimator" "60","itemcontainerstyle" "60","digg" "60","hook-form-alter" "60","hook-menu" "60","xbim" "60","azure-static-website-hosting" "60","spdep" "60","movilizer" "60","ehcache-bigmemory" "60","custom-painter" "60","angular2-di" "60","test-framework" "60","android-network-security-config" "60","acts-as-taggable" "60","percona-xtradb-cluster" "60","lawnchair" "60","evaluator" "60","change-notification" "60","zurb-ink" "60","android-ondestroy" "60","pedestal" "60","pentaho-ctools" "60","spire.doc" "60","requestscope" "60","actionbardrawertoggle" "60","tessnet2" "60","ninject-interception" "60","commodore" "60","character-limit" "60","nineoldandroids" "60","motion-planning" "60","generative-art" "60","ios-multithreading" "60","tom-select" "60","cgpdf" "60","certenroll" "60","layerdrawable" "60","merit-gem" "60","l-systems" "60","webobjects" "60","zohobooks" "60","head.js" "60","almalinux" "60","sum-of-digits" "60","sttwitter" "60","sectionedrecyclerviewadapter" "60","yowsup" "60","lightroom" "60","lightspeed" "60","dart-2" "60","web-container" "60","web-ide" "60","component-diagram" "60","gml-geographic-markup-lan" "60","shellcheck" "60","flutter-html" "60","fluxible" "60","link-to-remote" "60","helicontech" "60","touchablehighlight" "60","fnmatch" "60","composite-id" "60","partitioner" "60","dajax" "60","fme" "60","webfont-loader" "60","ifndef" "59","mvs" "59","easy-thumbnails" "59","green-threads" "59","greenrobot-eventbus-3.0" "59","edn" "59","trustpilot" "59","yii-cmodel" "59","jest-dom" "59","editorformodel" "59","greendao-generator" "59","triplet" "59","jetbrains-compose" "59","dcevm" "59","yocto-layer" "59","slam-algorithm" "59","webrtc-ios" "59","effort" "59","react-native-render-html" "59","interactive-mode" "59","live-video" "59","wgl" "59","procdump" "59","clientaccesspolicy.xml" "59","listcontrol" "59","clio-api" "59","anonymous-objects" "59","playfab" "59","ceedling" "59","xhtmlrenderer" "59","childviews" "59","imx8" "59","ccmenuitem" "59","pi4j" "59","apiclient" "59","unbounded-wildcard" "59","cblas" "59","apollo-android" "59","flair" "59","managed-code" "59","paddleocr" "59","pixastic" "59","xml-builder" "59","vsam" "59","datarowview" "59","xpinc" "59","fusionpbx" "59","disposable" "59","console2" "59","major-mode" "59","django-bootstrap3" "59","django-caching" "59","s7-1200" "59","rune" "59","filestreamresult" "59","smartsheet-c#-sdk-v2" "59","displaylist" "59","alamofire-request" "59","shark-sql" "59","role-based" "59","data-hiding" "59","data-exchange" "59","crouton" "59","psycopg" "59","icarus" "59","rpt" "59","verbatim-string" "59","ruby-2.7" "59","aws-cost-explorer" "59","n2" "59","aws-roles" "59","rshiny" "59","angularjs-provider" "59","aws-marketplace" "59","nalgebra" "59","pybullet" "59","django-mssql" "59","angular-ui-modal" "59","windows-firewall-api" "59","single-logout" "59","single-precision" "59","demorgans-law" "59","posix-api" "59","jwt-go" "59","swiftcharts" "59","grub2" "59","spring-cloud-dataflow-ui" "59","www-mechanize-firefox" "59","bloom" "59","onnewintent" "59","borrow" "59","ereg" "59","word-template" "59","deployment-descriptor" "59","writablebitmap" "59","turbolinks-5" "59","boot-clj" "59","sbt-web" "59","kairosdb" "59","jquery-csv" "59","go-git" "59","rightnow-crm" "59","kompose" "59","luci" "59","minima" "59","typer" "59","system-preferences" "59","objectquery" "59","lua-userdata" "59","buildspec" "59","cocosbuilder" "59","astyle" "59","androidappsonchromeos" "59","java-mission-control" "59","signed-url" "59","rayshader" "59","facebook4j" "59","oval" "59","o365-flow" "59","analog-digital-converter" "59","system-verilog-dpi" "59","buffalo" "59","knockout-kendo" "59","magic-quotes" "59","osgi-fragment" "59","android-buildconfig" "59","janino" "59","nt-native-api" "59","expression-web" "59","podman-compose" "59","dot42" "59","pointer-to-array" "59","nonblank" "59","asp.net-mvc-sitemap" "59","excelpackage" "59","mktileoverlay" "59","pluggable" "59","no-response" "59","qwebelement" "59","exchange-server-2003" "59","downloading-website-files" "59","tandem" "59","gcc8" "59","poly" "59","azure-storage-explorer" "59","vertical-scroll" "59","tarjans-algorithm" "59","tarsosdsp" "59","registerclientscriptblock" "59","openssl-engine" "59","qiime" "59","geopackage" "59","qiodevice" "59","offsetdatetime" "59","collectioneditor" "59","commonsware" "59","colordialog" "59","hypercorn" "59","acts-as-audited" "59","http-status-code-307" "59","human-interface" "59","custom-notification" "59","custom-build" "59","petitparser" "59","elasticsearch-marvel" "59","com.sun.net.httpserver" "59","qpdf" "59","metalsmith" "59","mpj-express" "59","lpcstr" "59","ipmi" "59","textstyle" "59","angular-errorhandler" "59","specifier" "59","angular-amd" "59","splitstackshape" "59","split-button" "59","iphone-sdk-3.1" "59","parent-node" "59","enclave" "59","flutter-redux" "59","subscript-operator" "59","imagedatagenerator" "59","tfs-2012" "59","qtxml" "59","amazon-machine-learning" "59","mdbtools" "59","stddraw" "59","maven-wagon-plugin" "59","pandera" "59","stdhash" "59","starvation" "59","google-reseller-api" "59","usb-camera" "59","predefined-variables" "59","linuxbrew" "59","passive-mode" "59","google-sheets-custom-function" "59","webintents" "58","class-fields" "58","massmail" "58","yield-from" "58","cloaking" "58","slimbox" "58","clang-complete" "58","eco" "58","base-address" "58","multiple-constructors" "58","relational-model" "58","skipper" "58","jcop" "58","trygetvalue" "58","git-clean" "58","trumbowyg" "58","marklogic-corb" "58","eclipse-mat" "58","web-vitals" "58","eer-model" "58","local-system-account" "58","flexform" "58","fenics" "58","bam" "58","weibo" "58","remobjects" "58","mathtype" "58","mat-input" "58","snaplogic" "58","flax" "58","jsdata" "58","pako" "58","blackberry-qnx" "58","python-huey" "58","page-init" "58","cellpadding" "58","fuse.js" "58","binomial-cdf" "58","jsonstream" "58","pipelined-function" "58","makestyles" "58","data-layer" "58","datawedge" "58","conjunctive-normal-form" "58","finalization" "58","select-n-plus-1" "58","consul-kv" "58","swiftui-state" "58","categorical" "58","laplacian" "58","apereo" "58","imperative" "58","awss3transferutility" "58","cross-origin-embedder-policy" "58","rsa-sha256" "58","shared-worker" "58","kinect.toolbox" "58","avrcp" "58","window-chrome" "58","shapesheet" "58","rotten-tomatoes" "58","django-select2" "58","oracle.manageddataaccess" "58","ora-00932" "58","dask-kubernetes" "58","django-custom-tags" "58","datagridcolumnheader" "58","uri-scheme" "58","pyav" "58","agile-processes" "58","data-dump" "58","p-table" "58","csplit" "58","angular-toastr" "58","databricks-repos" "58","spring-actuator" "58","sas-jmp" "58","aws-sdk-java" "58","twitter-finagle" "58","onflow-cadence" "58","nsq" "58","nemerle" "58","nsprintoperation" "58","opacitymask" "58","deis" "58","ionic-appflow" "58","wpf-grid" "58","spring-cloud-stream-binder" "58","grunt-contrib-less" "58","oocss" "58","entity-framework-core-3.0" "58","hsb" "58","gtkentry" "58","app-shell" "58","htmlgenericcontrol" "58","pdfdocument" "58","spring-loaded" "58","neato" "58","bleu" "58","google-admin-settings-api" "58","amplitude-analytics" "58","orchardcore" "58","java-money" "58","ocaml-core" "58","minecraft-commands" "58","sgd" "58","amp-story" "58","lektor" "58","netconf" "58","audience" "58","netbeans-7.2" "58","amazon-workmail" "58","atdd" "58","51degrees" "58","formatted-input" "58","overlapping-matches" "58","javax.script" "58",".nettiers" "58","faas" "58","shopify-liquid" "58","newrow" "58","typehead" "58","kotlin-android" "58","b-tree-index" "58","bssid" "58","openjdk-17" "58","dspack" "58","control-panel" "58","ntext" "58","xcode7-beta4" "58","nsusernotificationcenter" "58","quora" "58","taskdialog" "58","timepickerdialog" "58","sql-import-wizard" "58","gap-system" "58","gdc" "58","plcrashreporter" "58","dotnet-isolated" "58","xajax" "58","regional" "58","azure-role-environment" "58","redeploy" "58","quick-nimble" "58","drupal-content-types" "58","xc16" "58","aspnet-api-versioning" "58","npp" "58","draw2d-js" "58","policy-based-design" "58","businesscentral" "58","pollingduplexhttpbinding" "58","textfieldparser" "58","strsep" "58","meta-analysis" "58","prompt-toolkit" "58","google-cloud-translate" "58","angular-input" "58","sphinx-napoleon" "58","cudd" "58","pyx" "58","espn" "58","actionmode" "58","pywebview" "58","cen-xfs" "58","android-jodatime" "58","iphone-sdk-4.1" "58","android-overlay" "58","angular-httpclient-interceptors" "58","omniauth-google-oauth2" "58","montage" "58","moveit" "58","google-cloud-compute-engine" "58","iphonecoredatarecipes" "58","elasticsearch-nested" "58","hunit" "58","prototype-pattern" "58","luac" "58","concurrent-mark-sweep" "58","powerbuilder-build-deploy" "58","tigris" "58","git-webhooks" "58","uuencode" "58","hfp" "58","array-reduce" "58","ms-office-script" "58","bcftools" "58","haskell-warp" "58","qt5.8" "58","asar" "58","subreports" "58","d3dx" "58","stdinitializerlist" "58","multidimensional-cube" "58","git-plumbing" "58","linspace" "58","array-sum" "58","mediatypeformatter" "58","zf3" "58","haskell-persistent" "58","hdbc" "58","theia" "58","measures" "58","argouml" "58","cvat" "58","qtoolbutton" "58","gmaven-plugin" "58","preempt-rt" "58","partition-problem" "58","embedly" "58","ase" "58","static-binding" "58","cwd" "58","flutter-stripe" "58","cypress-conditional-testing" "58","google-my-business" "58","qtruby" "58","ms-app-analytics" "57","sizewithfont" "57","jboss-modules" "57","multiple-arguments" "57","aol" "57","truclient" "57","math.js" "57","localized" "57","deep-residual-networks" "57","instabug" "57","wide-format-data" "57","ghc-mod" "57","marshmallow-sqlalchemy" "57","localconnection" "57","maskededitextender" "57","interactive-grid" "57","clearcanvas" "57","yahoo-messenger" "57","remote-registry" "57","eddystone-url" "57","phaselistener" "57","remote-backup" "57","clr4.0" "57","client-side-attacks" "57","llamacpp" "57","ss7" "57","graphenedb" "57","edgejs" "57","trialware" "57","sitefinity-10" "57","json2csv" "57","p4api.net" "57","fusebox" "57","kucoin" "57","imagespan" "57","birthday-paradox" "57","dbforge" "57","firewire" "57","disjoint-union" "57","configureawait" "57","pipx" "57","fsunit" "57","pipes-filters" "57","ngx-mask" "57","api-hook" "57","rviz" "57","ng2-pdfjs-viewer" "57","cda" "57","directxmath" "57","sailpoint" "57","swiftui-sheet" "57","nexus-one" "57","symfony-panther" "57","dirpagination" "57","jqmath" "57","camera-flash" "57","vungle-ads" "57","facebook-pop" "57","indy-9" "57","facebook-rest-api" "57","pycall" "57","docker-pull" "57","mysql-cli" "57","rosalind" "57","windows-hosting" "57","angularjs-ngmock" "57","name-hiding" "57","unnamed-namespace" "57","database-engine" "57","pyathena" "57","kentico-kontent" "57","ajax-update" "57","unselect" "57","documents4j" "57","psftp" "57","verisign" "57","jmapviewer" "57","r-parsnip" "57","v-autocomplete" "57","rq" "57","methodnotfound" "57","pcspim" "57","oomph" "57","salesforce-flow" "57","bloburls" "57","nsindexset" "57","appodeal" "57","natural-key" "57","post-processor" "57","kdeplot" "57","azure-availability-set" "57","twint" "57","pdf-manipulation" "57","ionic-tabs" "57","jquery-globalize" "57","spring-jersey" "57","jquery-ui-spinner" "57","spring-io" "57","superobject" "57","negotiate" "57","word-processor" "57","cors-anywhere" "57","interop-domino" "57","easypost" "57","erlang-ports" "57","azure-ad-powershell-v2" "57","doskey" "57","rights-management" "57","setparent" "57","acaccountstore" "57","minitab" "57","system.data.datatable" "57","ray-picking" "57","cocos2d-x-3.x" "57","ri" "57","showwindow" "57","bugsense" "57","libcloud" "57","oct2py" "57","libpd" "57","mindmapping" "57","ata" "57","typescript4.0" "57","itemgroup" "57","xcode5.0.1" "57","region-monitoring" "57","business-process" "57","drive-letter" "57","nswagstudio" "57","noip" "57","high-level" "57","cachedrowset" "57","timeval" "57","hana-studio" "57","plone-3.x" "57","nokiax" "57","mocha-phantomjs" "57","nsxpcconnection" "57","scene-manager" "57","tcp-keepalive" "57","timestampdiff" "57","h2o.ai" "57","racing" "57","ml5.js" "57","red-gate-ants" "57","xcode12.5" "57","azure-ml-pipelines" "57","uiimageorientation" "57","hgweb" "57","member-hiding" "57","nhibernate-validator" "57","logical-purity" "57","cusolver" "57","office-pia" "57","string-operations" "57","mercurial-convert" "57","customcolumn" "57","angular2-hostbinding" "57","mosync" "57","evosuite" "57","spectre" "57","activitylog" "57","mongo-scala-driver" "57","peer-connection" "57","ogc" "57","mousepress" "57","huawei-map-kit" "57","motion-blur" "57","concave-hull" "57","maven-gae-plugin" "57","gm-xmlhttprequest" "57","foaf" "57","power-virtual-agents" "57","computational-finance" "57","avaudiopcmbuffer" "57","prefix-tree" "57","cyber-ark" "57","ardent" "57","partial-matches" "57","git-rev-list" "57","sourcegear-vault" "57","state-saving" "57","web.sitemap" "57","traffic-measurement" "57","weblogic8.x" "57","line-drawing" "57","autopilot" "57","haskell-diagrams" "57","max-size" "57","image-extraction" "57","substance" "57","mbcs" "57","bdc" "57","static-import" "57","static-data" "57","qtest" "57","zend-guard" "57","pg-hba.conf" "56","backlight" "56","declare-styleable" "56","livevalidation" "56","processwire" "56","webservicetemplate" "56","ansistring" "56","mass-emails" "56","decodeuricomponent" "56","materialdatepicker" "56","ecl" "56","dedicated" "56","tern" "56","phlivephoto" "56","bandpass-filter" "56","maven-ant-tasks" "56","dbutils" "56","treelistview" "56","phantom-reference" "56","php-builtin-server" "56","yelp-fusion-api" "56","yii-modules" "56","matplotlib-gridspec" "56","vue-testing-library" "56","default-copy-constructor" "56","dblinq" "56","installshield-2009" "56","sse4" "56","adobe-scriptui" "56","xmlschema" "56","rwlock" "56","blackberry-world" "56","container-image" "56","mappingexception" "56","addressables" "56","s3-bucket" "56","software-serial" "56","pixel-manipulation" "56","catamorphism" "56","language-construct" "56","phrets" "56","appian" "56","apache-spark-encoders" "56","labjs" "56","churn" "56","python-magic" "56","soaphandler" "56","python-memcached" "56","ccombobox" "56","divi-theme" "56","flash-video" "56","self-destruction" "56","snoop" "56","flasgger" "56","in-class-initialization" "56","platform-specific" "56","json-arrayagg" "56","undef" "56","riverpod-generator" "56","fswatch" "56","datastax-python-driver" "56","binary-matrix" "56","django-treebeard" "56","windowed" "56","r-marginaleffects" "56","wack" "56","react-ssr" "56","ora-00936" "56","wildcard-mapping" "56","camera-api" "56","watson-nlu" "56","fan-page" "56","watchos-5" "56","walkthrough" "56","angularjs-ng-resource" "56","cross-origin-opener-policy" "56","oracle-fdw" "56","kendo-panelbar" "56","realm-js" "56","data-cube" "56","roulette-wheel-selection" "56","angular-ui-bootstrap-tab" "56","rsuite" "56","govendor" "56","publish-actions" "56","rootkit" "56","metatag" "56","gulp-livereload" "56","wsdl.exe" "56","ws-discovery" "56","modulus.io" "56","pdf-rendering" "56","tus" "56","txtextcontrol" "56","neko" "56","ncalc" "56","boost-polygon" "56","nsbitmapimagerep" "56","junos-automation" "56","boids" "56","nsmanagedobjectmodel" "56","mongokit" "56","bluepill" "56","html-post" "56","payment-request-api" "56","input-filtering" "56","sap-selection-screens" "56","ontime" "56","covering-index" "56","bluetooth-device-discovery" "56","io.js" "56","spring-reactor" "56","magnify" "56","external-application" "56","shopware5" "56","osm.pbf" "56","maildir" "56","pyorient" "56","osql" "56","3g-network" "56","rcppparallel" "56","extreact" "56","object-initialization" "56","amazon-simple-email-service" "56","facebook-graph-api-v2.4" "56","forward-compatibility" "56","ravendb4" "56","rainbowtable" "56","fortigate" "56","sieve-language" "56","fortify-source" "56","pyfmi" "56","hibernate-jpa" "56","drupal-services" "56","screen-off" "56","handlebars.net" "56","tinymce-3" "56","itcl" "56","handleerror" "56","dialplan" "56","ispf" "56","uimenuitem" "56","uinput" "56","android-input-filter" "56","openslide" "56","gwt-openlayers" "56","rails-generate" "56","scala-spark" "56","sqlreportingservice" "56","nsvisualeffectview" "56","device-width" "56","jackson-dataformat-csv" "56","vesa" "56","vfw" "56","dotnetcorecli" "56","tdataset" "56","c++builder-10.3-rio" "56","refcounting" "56","bunifu" "56","historical-db" "56","c2664" "56","non-repetitive" "56","mpmoviewcontroller" "56","activepython" "56","pyxb" "56","geogebra" "56","es5-shim" "56","logical-foundations" "56","spot-instances" "56","esent" "56","iron" "56","stockfish" "56","ctree" "56","cer" "56","login-attempts" "56","moo" "56","learndash" "56","iris-recognition" "56","mergemap" "56","nintendo" "56","zpt" "56","google-form-quiz" "56","csvkit" "56","cstdio" "56","irs" "56","acts-as-commentable" "56","ackermann" "56","css-parsing" "56","geom-raster" "56","angular-auth-oidc-client" "56","log4r" "56","zurb-reveal" "56","elasticsearch-percolate" "56","mule-flow" "56","embedded-javascript" "56","flutter-upgrade" "56","msbuild-propertygroup" "56","static-array" "56","presto-jdbc" "56","st-link" "56","zebra-scanners" "56","zend-controller-router" "56","concrete5-8.x" "56","altorouter" "56","concat-ws" "56","zend-framework-routing" "56","mediastreamsource" "56","stsadm" "56","scriptcs" "56","urlretrieve" "56","authorize.net-arb" "56","queueing" "56","structuremap4" "56","behaviorspace" "56","qt-linguist" "56","thingsboard-gateway" "56","arrayaccess" "56","parallel-builds" "56","dart-shelf" "56","styled-jsx" "56","cyclic-graph" "56","global-namespace" "56","user-identification" "56","sharpmap" "56","global-assembly-cache" "55","vue-dynamic-components" "55","math-functions" "55","anytime" "55","clr-profiling-api" "55","flutter-engine" "55","feathers-hook" "55","bamboo-specs" "55","gidsignin" "55","grdb" "55","multiple-results" "55","remote-repository" "55","sql-server-openxml" "55","template-variables" "55","inspectdb" "55","flipboard" "55","livelink" "55","gitlab-ee" "55","apache-camel-3" "55","ckeditor.net" "55","git-init" "55","git-ftp" "55","clojurescript-javascript-interop" "55","material-dialog" "55","ant-design-vue" "55","clearml" "55","tspan" "55","fileopenpicker" "55","data-segment" "55","soa-suite" "55","imgkit" "55","incredibuild" "55","nextval" "55","apache-sentry" "55","socketasynceventargs" "55","adonetappender" "55","fleet" "55","mappings" "55","filter-input" "55","xml-entities" "55","safearea" "55","flask-ask" "55","dispatchgroup" "55","appery.io" "55","packet-injection" "55","fromjson" "55","discogs-api" "55","xpathquery" "55","smartystreets" "55","unity3d-terrain" "55","angular-social-login" "55","method-names" "55","oracle-apex-20.2" "55","grandstack" "55","sim-toolkit" "55","fasthttp" "55","upshot" "55","avcodec" "55","rosetta-2" "55","unix-head" "55","pure-js" "55","rubymine-7" "55","database-deployment" "55","aide" "55","angularjs-ng-href" "55","windows-screensaver" "55","databound-controls" "55","microsoft-extensions-logging" "55","gorm-mongodb" "55","mysql-spatial" "55","jniwrapper" "55","unslider" "55","informatica-data-integration-hub" "55","jquery-ui-theme" "55","apple-numbers" "55","pasteboard" "55","gulp-babel" "55","word-sense-disambiguation" "55","springjunit4classrunner" "55","tx-gridelements" "55","postbackurl" "55","neo4django" "55","popup-balloons" "55","grunt-contrib-compass" "55","sata" "55","svn-update" "55","silentpush" "55","typo3-tca" "55","system.drawing.color" "55","luks" "55","virtual-path" "55","audiostreamer" "55","amstock" "55","ubuntu-13.04" "55","libtorrent-rasterbar" "55","m2doc" "55","google-api-go-client" "55","ril" "55","outbox-pattern" "55","retrofit2.6" "55","atomicreference" "55","asynchronous-messaging-protocol" "55","pykafka" "55","luajava" "55","rcu" "55","context-bound" "55","tabpy" "55","digital-filter" "55","context-sensitive-grammar" "55","opensc" "55","gcal" "55","npm-vulnerabilities" "55","playlists" "55","android-cookiemanager" "55","open-telemetry-java" "55","dstore" "55","guvnor" "55","tawk.to" "55","non-volatile" "55","high-traffic" "55","qvboxlayout" "55","gecode" "55","itmstransporter" "55","nsurlsessiontask" "55","copy-initialization" "55","timeunit" "55","genbank" "55","hibernate-reactive" "55","convenience-methods" "55","leader-election" "55","iproute" "55","hubspot-api" "55","react-motion" "55","elasticsearch-api" "55","elastic-cache" "55","ipyleaflet" "55","pywin" "55","nimbus-jose-jwt" "55","geom-segment" "55","node-imagemagick" "55","reactfire" "55","human-computer-interface" "55","niftynet" "55","egui" "55","command-timeout" "55","zsh-zle" "55","everyplay" "55","pytransitions" "55","angular2-databinding" "55","android-make" "55","genesys" "55","http-head" "55","suexec" "55","flysystem-google-drive" "55","glympse" "55","msxml2" "55","gluon-desktop" "55","pass-by-const-reference" "55","medium.com-publishing-api" "55","particle-filter" "55","transactional-memory" "55","mda" "55","cycle2" "55","globalcompositeoperation" "55","styleframe" "55","qt3" "55","threadstatic" "55","cylindrical" "55","hermit" "55","powershell-v6.0" "55","image-enlarge" "55","powerpoint-2016" "55","elpa" "55","threepenny-gui" "55","bastion-host" "55","steeltoe" "55","pants" "55","structured-logging" "55","qtdbus" "54","vsta" "54","vsql" "54","vue-options-api" "54","cloud-object-storage" "54","staggeredgridlayoutmanager" "54","dbmail" "54","clustering-key" "54","php-shorttags" "54","yii2-extension" "54","localytics" "54","yahoo-boss-api" "54","deadlines" "54","llvm-3.0" "54","list.js" "54","sqltools" "54","flexible-search" "54","web-statistics" "54","flipkart-api" "54","cloudcaptain" "54","clr-hosting" "54","cisco-axl" "54","backups" "54","antisamy" "54","fieldinfo" "54","trusted-computing" "54","treecellrenderer" "54","edt" "54","basename" "54","multiple-browsers" "54","telegraf-plugins" "54","ffill" "54","req" "54","intel-parallel-studio" "54","translation-unit" "54","feincms" "54","run-app" "54","snapshot-isolation" "54","runsettings" "54","cassette" "54","marc" "54","mapstatetoprops" "54","jsonlint" "54","xdebug-profiler" "54","saf" "54","snakecasing" "54","packager" "54","soap4r" "54","cellspacing" "54","cilium" "54","xfdf" "54","uname" "54","unitils" "54","ng-apexcharts" "54","config-transformation" "54","python-coverage" "54","python-jedi" "54","datecreated" "54","constantcontact" "54","freshjs" "54","python-dotenv" "54","distributed-filesystem" "54","simple-openni" "54","ibm-cloud-plugin" "54","jqgrid-inlinenav" "54","jfrog-pipelines" "54","joomla4" "54","aws-glue-connection" "54","jide" "54","aiff" "54","ora2pg" "54","redactor.js" "54","servicestack-razor" "54","ibatis.net" "54","verilator" "54","rke" "54","agal" "54","servicebehavior" "54","django-sitemaps" "54","django-widget-tweaks" "54","angular-route-segment" "54","avif" "54","windowless" "54","keycloak-nodejs-connect" "54","unoconv" "54","wikimedia-commons" "54","croogo" "54","dnx50" "54","mysite" "54","nameko" "54","aws-rds-data-service" "54","nacl-cryptography" "54","mysql-5.0" "54","validationrule" "54","vcloud-director-rest-api" "54","payout" "54","twistd" "54","apple-cryptokit" "54","gulp-rename" "54","guice-persist" "54","svnant" "54","cosmos-sdk" "54","mongodb-mms" "54","wse3.0" "54","open-generics" "54","android-unit-testing" "54","bogus" "54","jtwitter" "54","android-screen-pinning" "54","nservicebus-distributor" "54","portia" "54","jxcore" "54","swaggerhub" "54","aws-service-catalog" "54","neography" "54","sca" "54","swagger-codegen-maven-plugin" "54","botpress" "54","neo4j-desktop" "54","botium-box" "54","core-services" "54","oniguruma" "54","momentics" "54","boost-tuples" "54","javax.ws.rs" "54","pydio" "54","shopify-hydrogen" "54","return-by-value" "54","sifr3" "54","codio" "54","raspbian-buster" "54","virtualmode" "54",".mov" "54","form-designer" "54","word-2016" "54","golden-layout" "54","pypandoc" "54","minimatch" "54","virtual-column" "54","kmalloc" "54","java-memory-leaks" "54","formsauthenticationticket" "54","rfc3986" "54","formatjs" "54","objective-c-literals" "54","raiseerror" "54","facebook-live-api" "54","code39" "54","krypton-toolkit" "54","cocoahttpserver" "54","f#-scripting" "54","macdeployqt" "54","typelist" "54","macos-darkmode" "54","vision-transformer" "54","android-applicationrecord" "54","vitess" "54","reform" "54","poe" "54","sqlfluff" "54","c++builder-xe8" "54","hook-wordpress" "54","isapi-redirect" "54","control-p5" "54","buttonbar" "54","driverless-ai" "54","mixture" "54","plv8" "54","drupal-5" "54","gb2312" "54","azure-public-ip" "54","dublin-core" "54","spl-autoloader" "54","angular-in-memory-web-api" "54","getpass" "54","commonmark" "54","nntp" "54","google-cloud-ai" "54","eigenclass" "54","qpainterpath" "54","geocomplete" "54","storybook-addon" "54","laravel-response" "54","toolbaritems" "54","http-status-code-407" "54","ninject.web" "54","chargify" "54","lsb" "54","ejabberd-hooks" "54","textflow" "54","laravel-upgrade" "54","command-query-separation" "54","pyuno" "54","message-pump" "54","active-window" "54","sprig-template-functions" "54","moses" "54","meta-method" "54","cucm" "54","off-by-one" "54","strongly-connected-graph" "54","google-data-catalog" "54","qdrant" "54","autobahnws" "54","tig" "54","msmq-wcf" "54","uwebsockets" "54","altivec" "54","heatmaply" "54","spark-ada" "54","maven-repository" "54","enchant" "54","arquillian-drone" "54","alt-tab" "54","qt-slot" "54","array-walk" "54","qstatemachine" "54","web3modal" "54","shell32.dll" "54","flutter-webrtc" "54","solrconfig" "54","preferslargetitles" "54","iglistkit" "54","suitescript1.0" "54","igmp" "54","global-payments-api" "54","dart-unittest" "54","linecache" "54","glblendfunc" "54","herestring" "54","topbraid-composer" "54","completion-block" "54","source-insight" "54","web-compiler" "54","compiler-specific" "54","flutter-intl" "54","pareto-chart" "54","igoogle" "53","transit" "53","pg-upgrade" "53","vue2-google-maps" "53","dbup" "53","clipperlib" "53","phalcon-orm" "53","sql-server-job" "53","instant-run" "53","clicktag" "53","babelify" "53","fiddle" "53","skos" "53","mask-rcnn" "53","jenkins-github-plugin" "53","figaro-ruby" "53","groupchat" "53","webpage-rendering" "53","php-imagine" "53","gitlens" "53","clientip" "53","live-connect-sdk" "53","matchtemplate" "53","apache-kafka-security" "53","gitlab-8" "53","webtrends" "53","github-projects" "53","ants" "53","fetchcontent" "53","php-mssql" "53","probing" "53","ggcorrplot" "53","phoneme" "53","probot" "53","ngrx-router-store" "53","underscores-wp" "53","swiftydropbox" "53","flexboxgrid" "53","daypilot" "53","bit-masks" "53","rxvt" "53","firstdata" "53","adaptive-ui" "53","file-system-access-api" "53","select-function" "53","chrome-for-android" "53","bizspark" "53","jsr356" "53","image-viewer" "53","firebird1.5" "53","swift-mt" "53","imputets" "53","palm-pre" "53","fsfs" "53","distributed-lock" "53","xmladapter" "53","biological-neural-network" "53","palantir-foundry-api" "53","connman" "53","find-by-sql" "53","uml-designer" "53","apache-nms" "53","checkin-policy" "53","indexing-service" "53","social-tables" "53","kube-state-metrics" "53","flash-scope" "53","kubespray" "53","findfirst" "53","imagenamed" "53","map-force" "53","xenomai" "53","sal" "53","constexpr-function" "53","varying" "53","mysql-error-2002" "53","recorder.js" "53","opkg" "53","crowdsourcing" "53","grails-services" "53","camera-view" "53","agora-implementation" "53","psoc" "53","doctrine-phpcr" "53","dataitem" "53","microkernel" "53","ruby-enterprise-edition" "53","createobjecturl" "53","pycodestyle" "53","google-wallet" "53","google-web-component" "53","goose" "53","fail-fast" "53","oracle-dump" "53","rswag" "53","caldroid" "53","valuemember" "53","microsoft-graph-edu" "53","meteor-slingshot" "53","ajdt" "53","vega-lite-api" "53","vega-embed" "53","jhtmlarea" "53","django-react" "53","episerver-6" "53","html-injections" "53","twitter-anywhere" "53","createcontext" "53","modelio" "53","easyautocomplete" "53","pathauto" "53","password-confirmation" "53","epub.js" "53","navigation-timing-api" "53","ontap" "53","android-studio-3.4" "53","spring-cloud-loadbalancer" "53","openaccess" "53","cqlinq" "53","paymill" "53","application-data" "53","swfaddress" "53","entity-model" "53","environ" "53","kbhit" "53","juju" "53","entityset" "53","postgresql-triggers" "53","kafka-partition" "53","android-textattributes" "53","view-hierarchy" "53","atata" "53","browser-action" "53","pygrib" "53","windows-xp-embedded" "53","oracle-wallet" "53","mikrotik" "53","lexicographic-ordering" "53","audioeffect" "53","netbeans7.0" "53","lexical-closures" "53","codeskulptor" "53","oracle-xml-db" "53","extensible" "53","object-identity" "53","foundry-code-workbooks" "53","windows-template-studio" "53","magic-draw" "53","less-loader" "53","neutralinojs" "53","rikulo" "53","external-data-source" "53","mahotas" "53","oauth.io" "53","facebook-batch-request" "53","aubio" "53","system-paths" "53","tabular-form" "53","asort" "53","jaggery-js" "53","modeline" "53","xaml-binding" "53","drizzle-orm" "53","hig" "53","hibernate-search-6" "53","gcc6" "53","not-operator" "53","gcc-plugins" "53","aspose-slides" "53","drawellipse" "53","gabor-filter" "53","excel-pivot" "53","playwright-sharp" "53","x-accel-redirect" "53","tbitmap" "53","toit" "53","iserializable" "53","double-hashing" "53","xcode7-beta3" "53","numerics" "53","xctool" "53","tabris" "53","offsetwidth" "53","httpruntime.cache" "53","angular2-providers" "53","http-protocols" "53","nibble" "53","excel-4.0" "53","strophe.js" "53","nicegui" "53","command-line-parser" "53","elephantbird" "53","login-with-amazon" "53","loguru" "53","spectral" "53","resource-id" "53","launch-services" "53","ios-homekit" "53","cupertinopicker" "53","mountebank" "53","protorpc" "53","oltu" "53","node-neo4j" "53","mosca" "53","morphic" "53","sphinx-apidoc" "53","geom-area" "53","launchdarkly" "53","reactjs-native" "53","log4cpp" "53","merge-statement" "53","las" "53","concurrently" "53","amazon-fsx" "53","thread-exceptions" "53","zen" "53","mean-shift" "53","goaccess" "53","line-spacing" "53","quarkus-oidc" "53","shibboleth-sp" "53","emacs-ecb" "53","suckerfish" "53","webcal" "53","scribd" "53","v4l" "53","query-notifications" "53","auth-request" "53","embedded-tomcat" "53","sugarbean" "53","webgl-extensions" "53","gnome-builder" "53","yticks" "53","ms-forms" "53","qt5.15" "53","hazard" "53","zigzag" "53","powerbi-rest-api" "53","qt4.6" "53","zope.interface" "53","engine.io" "53","webkit.net" "53","asdoc" "53","mediasession" "53","asf" "53","ber" "53","heads-up-notifications" "52","jenkins-kubernetes" "52","sql-server-performance" "52","linux-toolchain" "52","xrp" "52","group-membership" "52","filecompare" "52","jconnect" "52","lispworks" "52","multiway-tree" "52","primeflex" "52","cling" "52","mathematical-lattices" "52","tensorflow2" "52","flutter-debug" "52","multi-table-inheritance" "52","sitefinity-5" "52","apache-commons-pool" "52","eclipse-sirius" "52","floor-division" "52","liveconnect" "52","transport-security" "52","materialcardview" "52","fetchrequest" "52","git-archive" "52","ssp" "52","apache-chainsaw" "52","mat-card" "52","safeareaview" "52","chrome-remote-debugging" "52","addon-domain" "52","swiftui-layout" "52","jsonb-api" "52","unbuffered" "52","safari-web-extension" "52","appcelerator-hyperloop" "52","unchecked-cast" "52","python-for-android" "52","mapbox-gl-draw" "52","smartscreen" "52","contactpicker" "52","piracy-prevention" "52","snapshot-testing" "52","console.readkey" "52","python-moderngl" "52","rxdb" "52","confluent-control-center" "52","chewy-gem" "52","symfony-2.0" "52","dismo" "52","xl-deploy" "52","kurtosis" "52","smtpd" "52","chefdk" "52","runcommand" "52","jtapplecalendar" "52","runjags" "52","sms-retriever-api" "52","diskarbitration" "52","socket.io-java-client" "52","binding.scala" "52","connectionexception" "52","mysql-innodb-cluster" "52","wildfly-26" "52","datajs" "52","gradle-shadow-plugin" "52","gradle-release-plugin" "52","aws-media-live" "52","simplekml" "52","mysqltuner" "52","wildcard-expansion" "52","jgitflow-maven-plugin" "52","waveout" "52","jive" "52","django-management-command" "52","seq-logging" "52","pyamf" "52","csip-simple" "52","windows-administration" "52","angular-spectator" "52","angular-state-managmement" "52","angular-ui-datepicker" "52","wagon" "52","django-dev-server" "52","angularjs-view" "52","angularjs-track-by" "52","rsvp-promise" "52","windows-2003-webserver" "52","routedevent" "52","windowsdomainaccount" "52","windows-driver" "52","kendo-menu" "52","dmx512" "52","grape-entity" "52","windows-forms-core" "52","rst2pdf" "52","datadog-dashboard" "52","caller-id" "52","pattern-synonyms" "52","nested-set-model" "52","application-icon" "52","jquery-mobile-ajax" "52","ini4j" "52","boehm-gc" "52","jquery-layout" "52","boost-locale" "52","android-traceview" "52","modx-resources" "52","inria-spoon" "52","salt-cloud" "52","gulp-useref" "52","nssecurecoding" "52","dynamic-assemblies" "52","two.js" "52","eaccelerator" "52","dynamic-parallelism" "52","dynamic-values" "52","wsastartup" "52","cpplint" "52","inplace-editing" "52","bootcamp" "52","postgres-10" "52","inlines" "52","intrinsic-content-size" "52","inputverifier" "52","bonsai-elasticsearch" "52","mailhog" "52","typescript-definitions" "52","branchless" "52","javahelp" "52","libmagic" "52","tabbed-view" "52","system.type" "52","pygame2" "52","ampersand.js" "52","abortcontroller" "52","typescript2.2" "52","rdf-xml" "52","code-navigation" "52",".netrc" "52","build-triggers" "52","audio-source" "52","ramaze" "52","lessphp" "52","rcaller" "52","leksah" "52","gold-linker" "52","m2e-wtp" "52","syncsort" "52","pykalman" "52","word-field" "52","dompurify" "52","netbeans-7.3" "52","reversi" "52","knox-gateway" "52","azure-secrets" "52","pod-install" "52","buttonfield" "52","double-submit-problem" "52","table-statistics" "52","continuation" "52","scikit-optimize" "52","sqlhelper" "52","ispell" "52","expressionvisitor" "52","table-per-class" "52","reduce-reduce-conflict" "52","expression-encoder-sdk" "52","ganymede" "52","jade4j" "52","railway.js" "52","gaufrette" "52","red-zone" "52","gwt-compiler" "52","gemalto" "52","tcomport" "52","copybook" "52","ref-qualifier" "52","xcos" "52","drupal-navigation" "52","dex2jar" "52","azure-function-async" "52","uimenu" "52","drives" "52","tapkey" "52","tinkerpop-blueprint" "52","sql-server-2017-express" "52","radrails" "52","dev-mode" "52","getproperties" "52","property-observer" "52","current-page" "52","geom-ribbon" "52","chalk" "52","oh-my-posh" "52","movable" "52","cumulative-layout-shift" "52","acts-as-tree" "52","chaiscript" "52","event-wait-handle" "52","prtg" "52","elasticsearch.net" "52","ejbql" "52","spotfire-webplayer" "52","event-capturing" "52","cfiledialog" "52","geometry-instancing" "52","react-datetime" "52","perlscript" "52","dumpdata" "52","iphone-vibrate" "52","monitors" "52","qcar-sdk" "52","reactive-cocoa-3" "52","csx" "52","lazyvstack" "52","monolithic" "52","msp" "52","behind" "52","amazon-deequ" "52","avassetimagegenerator" "52","passlib" "52","asadmin" "52","hft" "52","lidr" "52","multimarkdown" "52","stxxl" "52","comvisible" "52","zendx" "52","pgfplots" "52","pangocairo" "52","healthconnect" "52","czml" "52","amazon-kinesis-kpl" "52","seadragon" "52","em-websocket" "52","glassfish-2.x" "52","qt5.1" "52","multiarch" "52","image-cropper" "52","maximization" "52","linear-probing" "52","arduinojson" "52","multicollinearity" "52","starcluster" "51","groovy-eclipse" "51","flexunit4" "51","dbproviderfactories" "51","white-box-testing" "51","technical-debt" "51","yajsw" "51","graphql-playground" "51","vssdk" "51","xui" "51","relativedelta" "51","reorderable-list" "51","yii-cactiverecord" "51","matchmaking" "51","masspay" "51","ginput" "51","phpstorm-2017.1" "51","apache-apex" "51","gimbal" "51","apache-crunch" "51","mathcad" "51","base36" "51","wep" "51","filab" "51","yii-chtml" "51","integer-partition" "51","dateparser" "51","fsspec" "51","configobj" "51","pipelinedb" "51","xml-declaration" "51","pandaboard" "51","firebase-queue" "51","filterfunction" "51","disk-access" "51","page-setup" "51","fts5" "51","ceilometer" "51","binascii" "51","snowplow" "51","catalystbyzoho" "51","swupdate" "51","content-for" "51","fromfile" "51","rust-async-std" "51","switchpreference" "51","constraint-validation-api" "51","cassandra-jdbc" "51","chromeless" "51","kuzzle" "51","ng-mocks" "51","rust-obsolete" "51","ngx-toastr" "51","distributed-objects" "51","cassandra-0.7" "51","pureconfig" "51","i2s" "51","up-navigation" "51","docxtpl" "51","datajoint" "51","aho-corasick" "51","gopls" "51","verlet-integration" "51","upsource" "51","aws-devops" "51","django-formtools" "51","upx" "51","serenity-platform" "51","got" "51","angulartics" "51","angular-testing-library" "51","windows-server-2000" "51","ruby-2.5" "51","facetwp" "51","mystic" "51","call-hierarchy" "51","kframework" "51","rose-plot" "51","django-polymorphic" "51","simpledialog" "51","metrics-server" "51","rspec-puppet" "51","aws-amplify-sdk-android" "51","namespace-package" "51","vcproj" "51","wspbuilder" "51","cray" "51","nativescript-cli" "51","navigationsplitview" "51","infobip" "51","android-window" "51","gtrendsr" "51","axon-framework" "51","monger" "51","wp-nav-menu-item" "51","azure-emulator" "51","wowza-transcoder" "51","corewcf" "51","txmldocument" "51","boost-spirit-karma" "51","popuppanel" "51","onepage-checkout" "51","gtkmm4" "51","gulp-rev" "51","invision-power-board" "51","html-help-workshop" "51","android-simple-facebook" "51","swift-keypath" "51","application-security" "51","postgres-xl" "51","dynamicparameters" "51","pasting" "51","libdispatch" "51","ocmod" "51","synedit" "51","wordpress.com" "51","pysam" "51","netbeans-7.4" "51","synopsys-vcs" "51","mini-forge" "51","winforms-to-web" "51","google-2fa" "51","rainmeter" "51","fragment-transitions" "51","fpgrowth" "51","sgplot" "51","tableau-prep" "51","google-alerts" "51","visual-leak-detector" "51","siege" "51","sidr" "51","pymodbustcp" "51","asynccontroller" "51","vmd" "51","xcode7-beta6" "51","android-firmware" "51","halo" "51","scalastyle" "51","hibernation" "51","taleo" "51","cacheapi" "51","hoare-logic" "51","uidynamicbehavior" "51","sql-match-all" "51","android-components" "51","azure-subscription" "51","gwt-activities" "51","table-partitioning" "51","controller-action" "51","mobicents-sip-servlets" "51","gbk" "51","dotween" "51","hilla" "51","spring-social-linkedin" "51","tdm-mingw" "51","direct-labels" "51","android-dateutils" "51","exif-js" "51","devkitpro" "51","tivoli-work-scheduler" "51","xattribute" "51","azure-sql" "51","android-bottom-nav-view" "51","rackspace-cloudfiles" "51","tagfile" "51","gcmlistenerservice" "51","timemachine" "51","android-d8" "51","dib" "51","dtd-parsing" "51","polarssl" "51","scala-metals" "51","assemblyversions" "51","isomorphic" "51","tolist" "51","tokudb" "51","gal" "51","penetration-tools" "51","moto-360" "51","respond-with" "51","cfrunloop" "51","movefile" "51","get-eventlog" "51","getfeatureinfo" "51","spinning" "51","eggplant" "51","ojs" "51","eggdrop" "51","custom-receiver" "51","ironmq" "51","qgraphicspixmapitem" "51","node-pg-pool" "51","google-cloud-debugger" "51","latent-semantic-indexing" "51","command-window" "51","angularjs-interpolate" "51","node-https" "51","android-photos" "51","ipynb" "51","node-promisify" "51","mesh-collider" "51","node.js-nan" "51","ltrace" "51","pyvenv" "51","event-based-programming" "51","event-arc" "51","testrigor" "51","spatial-data-frame" "51","nmock" "51","nltk-trainer" "51","multidplyr" "51","suitesparse" "51","qstylesheet" "51","array-combine" "51","idispatchmessageinspector" "51","zend-test" "51","daab" "51","prelaunch" "51","parallel-data-warehouse" "51","user-defined-data-types" "51","idle-processing" "51","thinkscript" "51","stereotype" "51","lingo" "51","parse-dashboard" "51","gkmatchmaker" "51","sound-recognition" "51","subsonic-active-record" "51","limma" "51","bigchaindb" "51","gnu-efi" "51","comsol" "51","auto-build" "51","artwork" "51","scrolledwindow" "51","hexagon-dsp" "51","authz" "51","alpine-package-keeper" "51","compojure-api" "50","cleverhans" "50","matrix-synapse" "50","probabilistic-programming" "50","class-properties" "50","groupstyle" "50","flowgear" "50","multiple-makefiles" "50","markov-decision-process" "50","xtradb" "50","feedly" "50","websvn" "50","listmodel" "50","php-stream-wrappers" "50","ssis-2019" "50","vue.draggable" "50","primeng-treetable" "50","phalanger" "50","jericho-html-parser" "50","intellitest" "50","default.png" "50","flutter-deep-link" "50","packetbeat" "50","lammps" "50","content-tag" "50","container-queries" "50","unified-service-desk" "50","biplot" "50","package-private" "50","impyla" "50","fixed-point-iteration" "50","language-switching" "50","r-zelig" "50","pia" "50","ccd" "50","apache-sshd" "50","adm-zip" "50","seneca" "50","chrome-declarativenetrequest" "50","distillery" "50","jsencrypt" "50","xml-generation" "50","ng" "50","rust-clippy" "50","jtopen" "50","flashplayer-10" "50","runlevel" "50","dataviewwebpart" "50","diskcache" "50","blanket.js" "50","mariadb-10.6" "50","grafana-dashboard" "50","unshelve" "50","server-migration" "50","sharepoint-userprofile" "50","pvrtc" "50","waitgroup" "50","windows-mobile-6.1" "50","crystal-reports-2013" "50","ora-00979" "50","upwork-api" "50","document.evaluate" "50","keyrelease" "50","gora" "50","shared-secret" "50","docker-command" "50","wcf-extensions" "50","service-object" "50","named-routing" "50","windows-share" "50","sequential-number" "50","read-uncommitted" "50","read-text" "50","mysql-error-1055" "50","ora-00001" "50","meteor-methods" "50","optics-algorithm" "50","routevalues" "50","angularjs-ng-pattern" "50","createwritestream" "50","microsoft365-defender" "50","avcaptureoutput" "50","simultaneous-calls" "50","option-strict" "50","windows-process" "50","upsetr" "50","boost-ublas" "50","pawn" "50","openbugs" "50","ereg-replace" "50","openbmc" "50","htcsense" "50","inno-setup-v6" "50","dynamic-delivery" "50","appinstaller" "50","word-table" "50","open-flash-chart" "50","turbo-frames" "50","guided-access" "50","simplecaptcha" "50","mongodb-ruby" "50","houghlines" "50","boost-dynamic-bitset" "50","cqwp" "50","densenet" "50","k3d" "50","nativewindow" "50","html5mode" "50","html-escape" "50","typedarray" "50","kcat" "50","salesforce-ios-sdk" "50","surge.sh" "50","online-compilation" "50","typebuilder" "50","dependency-graph" "50","desktop-duplication" "50","twelvemonkeys" "50","azure-cost-calculation" "50","nestjs-mongoose" "50","jaspic" "50","setdefault" "50","libtcod" "50","lwuit-resource-editor" "50","extjs2" "50","objectfactory" "50","fable" "50","google-api-objc-client" "50","richdatatable" "50","cocoa-sheet" "50","rcpp11" "50","freedesktop.org" "50","ubuntu-14.10" "50","btdf" "50","sysv-ipc" "50","a2lix-translation" "50","pynacl" "50","formit" "50","system.numerics" "50","riff" "50","facebook-invite-friends" "50","broadcast-channel" "50","68hc12" "50","viewdidlayoutsubviews" "50","extract-value" "50","objc-bridging-header" "50","forward-reference" "50","javahl" "50","rake-test" "50","set-based" "50","amortization" "50","nyquist" "50","plexus" "50","redhat-brms" "50","copytree" "50","c#-interactive" "50","exposure" "50","tcombobox" "50","scipy.ndimage" "50","tdm-gcc" "50","nokia-imaging-sdk" "50","conventional-commits" "50","contentview" "50","wxperl" "50","dot-operator" "50","schemaexport" "50","xapi" "50","itemplate" "50","caemittercell" "50","itemspaneltemplate" "50","itemwriter" "50","cachemanager" "50","driveinfo" "50","radscheduler" "50","plugin.xml" "50","diagnostic-tools" "50","modality" "50","dinktopdf" "50","diophantine" "50","xclip" "50","continuum" "50","uipopoverpresentationcontroller" "50","nvidia-deepstream" "50","npm-init" "50","angular-gridster2" "50","log4javascript" "50","angular-akita" "50","layout-inspector" "50","collection-initializer" "50","httppostedfile" "50","spire" "50","httpruntime" "50","movies" "50","string-utils" "50","peoplesoft-app-engine" "50","google-elevation-api" "50","tether" "50","rest-security" "50","mpu" "50","result-of" "50","getmessage" "50","memory-size" "50","etrade-api" "50","etcd3" "50","react-native-config" "50","october-form-controller" "50","node-pre-gyp" "50","activecampaign" "50","react-apexcharts" "50","project-online" "50","mop" "50","centura" "50","react-final-form-arrays" "50","getid3" "50","cfstream" "50","mui-x-charts" "50","cypher-3.1" "50","sdmx" "50","summarytools" "50","auto-versioning" "50","powershell-v5.1" "50","foreignobject" "50","paramarray" "50","timber-android" "50","tfs-2017" "50","powercfg" "50","statusline" "50","bazel-java" "50","stlport" "50","pglogical" "50","parallel-collections" "50","haskell-turtle" "50","ignite-ui-angular" "50","threaded-comments" "50","scrolledcomposite" "50","gmaps4rails2" "50","tpagecontrol" "50","subfigure" "50","basm" "50","sublime-build" "50","ar-foundation" "50","zebra-striping" "50","compositecollection" "50","batman.js" "50","concourse-git-resource" "50","mediacapture" "50","star-schema-datawarehouse" "50","structlayout" "50","qsslsocket" "50","scribble" "50","linux-distro" "50","pptxgenjs" "49","react-native-popup-menu" "49","grep-indesign" "49","phppresentation" "49","repmgr" "49","slf4j-api" "49","loadable-component" "49","dday" "49","multiple-sites" "49","report-viewer2012" "49","phpstorm-2017.2" "49","jetbrains-toolbox" "49","cloc" "49","multiserver" "49","gfs" "49","pgo" "49","treecontrol" "49","feature-store" "49","ghostdoc" "49","whisper" "49","vtt" "49","termcolor" "49","clickable-image" "49","websocket4net" "49","jdbi3" "49","jdbc-postgres" "49","programmers-notepad" "49","clevertap" "49","coalescing" "49","clang-cl" "49","groovyscriptengine" "49","telerik-scheduler" "49","flask-dance" "49","jstilemap" "49","address-operator" "49","bindingnavigator" "49","socketscan" "49","make-install" "49","votive" "49","functional-java" "49","run-time-polymorphism" "49","blat" "49","self-executing-function" "49","semantic-zoom" "49","semigroup" "49","image-reader" "49","chronograf" "49","selenium-remotedriver" "49","ultrawebgrid" "49","fsck" "49","blackberry-editfield" "49","pick" "49","disconnection" "49","discord.io" "49","imanage" "49","p4merge" "49","safari-content-blocker" "49","selectcommand" "49","language-extension" "49","jsp-fragments" "49","unexpectendoffile" "49","impactjs" "49","xmldiff" "49","unfold" "49","rxjs-marbles" "49","dataset-designer" "49","implicit-flow" "49","apigee-baas" "49","recursive-regex" "49","pushy" "49","hyperref" "49","watermelondb" "49","pthreads-win32" "49","name-value" "49","pycocotools" "49","createtextnode" "49","data-formats" "49","meteor-tracker" "49","angular-tree-component" "49","django-oauth-toolkit" "49","airflow-xcom" "49","fastjson" "49","dashboard-designer" "49","kite" "49","django-mailer" "49","gpt4all" "49","wildfly-18" "49","sharepoint-object-model" "49","server-farm" "49","pxssh" "49","read-sql" "49","rtx" "49","gopacket" "49","icanhaz.js" "49","gossip" "49","infinispan-9" "49","juice-ui" "49","deployment-project" "49","pdoc" "49","bootstrap-icons" "49","htdp" "49","pdist" "49","html-tableextract" "49","dynamics-365-sales" "49","samd21" "49","invariantculture" "49","invariance" "49","intrusive-containers" "49","mongodb-c" "49","bluetooth-socket" "49","sbt-idea" "49","errorprone" "49","opaque-types" "49","initwithcoder" "49","dynamics-crm-uci" "49","html.listboxfor" "49","easy-peasy" "49","dynamic-finders" "49","sap-smp" "49","azure-devops-services" "49","nsmatrix" "49","jzy3d" "49","superpixels" "49","gulp-ruby-sass" "49","postgres-14" "49","wuapi" "49","onrender" "49","ooyala" "49","pax-web" "49","svelte-transition" "49","svndumpfilter" "49","jquery-multidatespicker" "49","nshttpurlresponse" "49","wso2-stratos" "49","jquery-ajax" "49","patternlab.io" "49","libxml-ruby" "49","buildkite" "49","codi" "49","8thwall-web" "49","audioinputstream" "49","system.speech.recognition" "49","objectname" "49","miragejs" "49","cocotb" "49","pyjamas" "49","external-tools" "49","external-url" "49","rgooglemaps" "49","libgee" "49","codecvt" "49","format-patch" "49","lemon-graph-library" "49","oclint" "49","ubifs" "49","netzke" "49","vlc-qt" "49","amp-analytics" "49","brokeredmessage" "49","formfield" "49","pymoo" "49","freeform" "49","uipickerviewdatasource" "49","quickdialog" "49","refinery" "49","nstextcontainer" "49","nosuchmethod" "49","mjs" "49","android-ide" "49","game-maker-studio-1.4" "49","drupal-feeds" "49","gwt-places" "49","raddatepicker" "49","gwt-history" "49","xcode4.6.3" "49","itanium" "49","schemagen" "49","scala-maven-plugin" "49","uiculture" "49","tlistbox" "49","doze" "49","g77" "49","timeuuid" "49","opentripplanner" "49","opentest" "49","tdatetime" "49","todomvc" "49","uiimageasset" "49","dhl" "49","exiv2" "49","dotnet-restore" "49","azure-managed-disk" "49","j1939" "49","testability" "49","chararray" "49","android-rom" "49","memory-safety" "49","test-results" "49","android-jetpack-compose-testing" "49","chap-links-library" "49","storing-information" "49","moodle-theme" "49","omnibox" "49","android-percentrelativelayout" "49","getrusage" "49","omdbapi" "49","android-pdf-api" "49","acumos" "49","angular-chosen" "49","lcds" "49","angular-date-format" "49","getasync" "49","activeweb" "49","elasticsearch-template" "49","account-linking" "49","cuckoo" "49","dulwich" "49","ldf" "49","google-dataflow" "49","mplab-c18" "49","ipfw" "49","acts-as-paranoid" "49","color-theory" "49","activity-monitor" "49","qcc" "49","qchartview" "49","sphero" "49","aceoledb" "49","towerjs" "49","webcenter-sites" "49","pandas-ta" "49","sortables" "49","google-indexing-api" "49","stdmutex" "49","googleio" "49","mb-convert-encoding" "49","topography" "49","darcs" "49","maxreceivedmessagesize" "49","bb-messenger" "49","screwturn" "49","toolstripitem" "49","tfs-reports" "49","flutter-material" "49","pppd" "49","powergui" "49","ms-mpi" "49","powerpacks" "49","shazam" "49","cvs2git" "49","msi-patch" "49","stuff" "49","soundtouch" "49","zeebe" "49","stylegan" "49","md-chip" "49","linq-method-syntax" "49","heremaps-ios-sdk" "49","search-tree" "49","liferay-7.1" "49","zorba" "49","user-generated-content" "49","partial-index" "48","jekyll-paginator" "48","git-apply" "48","relative-addressing" "48","srid" "48","reprojection-error" "48","llvm-codegen" "48","multiple-accounts" "48","insert-id" "48","pheanstalk" "48","ggpattern" "48","fluidsynth" "48","griddle" "48","cloudboost" "48","react-native-modules" "48","privacy-manifest" "48","react-native-svg-charts" "48","mat-pagination" "48","figma-api" "48","greendroid" "48","procmon" "48","eclipse-rcptt" "48","react-popper" "48","dcount" "48","printqueue" "48","echo-cancellation" "48","db-schema" "48","vue2leaflet" "48","remote-host" "48","client-side-rendering" "48","flexpaper" "48","jboss-seam" "48","weex" "48","freetexttable" "48","swiftsoup" "48","contenttemplate" "48","rust-tonic" "48","fileprovider-extension" "48","xlform" "48","cclabelttf" "48","filtered-index" "48","symlink-traversal" "48","rulers" "48","softkeys" "48","xilinx-edk" "48","sxs" "48","xpath-3.0" "48","binary-semaphore" "48","configsection" "48","import-libraries" "48","fubumvc" "48","jst" "48","find-package" "48","labeled-statements" "48","jsignature" "48","administrate" "48","add-type" "48","adobe-cirrus" "48","kubernetespodoperator" "48","oxid" "48","playframework-json" "48","apex-trigger" "48","languageservice" "48","cidetector" "48","g++-4.7" "48","docker-cli" "48","wallaby.js" "48","pybuilder" "48","optimus" "48","wincc" "48","jovo-framework" "48","validation-application-bl" "48","aikau" "48","ora-00911" "48","django-rest-knox" "48","database-integrity" "48","kimono" "48","aws-reserved-instances" "48","database-theory" "48","updatecommand" "48","jointplot" "48","django-pyodbc-azure" "48","up-button" "48","vb5" "48","windows-hello" "48","alacritty" "48","rosbag" "48","data-lakehouse" "48","react-thunk" "48","cakephp-3.3" "48","name-conflict" "48","aws-pipeline" "48","react-table-v6" "48","fast-math" "48","sharepointfoundation2010" "48","micronaut-aws" "48","rocksdb-java" "48","onpaste" "48","boost-logging" "48","pdfparser" "48","nsstackview" "48","cppcms" "48","appv" "48","sim800l" "48","azure-cosmosdb-emulator" "48","tsyringe" "48","blynk" "48","oom" "48","grunt-browserify" "48","monday.com" "48","nsparagraphstyle" "48","tyk" "48","mod-rails" "48","openfst" "48","approval-tests" "48","modx-templates" "48","jquery-ias" "48","jquery-ui-menu" "48","application-layer" "48","nsdatecomponentsformatter" "48","sas-dis" "48","jxpath" "48","hosted-app" "48","spring-cloud-security" "48","azure-entra-id" "48","cosu" "48","bootstrap-form-helper" "48","externalizable" "48","external-display" "48","libunwind" "48","oslc" "48","oslog" "48","lumen-5.4" "48","knpmenu" "48","klarna" "48","google-api-webmasters" "48","videodisplay" "48","rcov" "48","libnotify" "48","kotlin-gradle-plugin" "48","facebook-checkins" "48","table-calendar" "48","lxml.objectify" "48","objective-c-protocol" "48","rhino-mocks-3.5" "48","libxml-js" "48","sysprep" "48","view-components" "48","pygresql" "48","pymodbus3" "48","system-configuration" "48","kotlinx" "48","viewstack" "48","pyldavis" "48","osx-yosemite-beta" "48","newspaper3k" "48","go-micro" "48","netplan" "48","uft-api" "48","outer-classes" "48","ocaml-lwt" "48","systemevent" "48","pyscard" "48","f#-giraffe" "48","qwebenginepage" "48","gae-quotas" "48","redux-saga-test-plan" "48","rack-cors" "48","node-windows" "48","open-nfc" "48","uinavigationbarappearance" "48","dtplyr" "48","redux-promise" "48","hmacsha256" "48","tivoli-identity-manager" "48","openprocess" "48","numeric-input" "48","mobile-ffmpeg" "48","rackup" "48","nook" "48","dotnetnuke-settings" "48","non-equi-join" "48","time-management" "48","ismouseover" "48","tbb-flow-graph" "48","ml.net-model-builder" "48","tipfy" "48","qwizard" "48","expo-image-picker" "48","npmjs" "48","tinylog" "48","rails-sprockets" "48","haskell-criterion" "48","drupal-contextual-filters" "48","drf-nested-routers" "48","numeral.js" "48","isparta" "48","double-submit-prevention" "48","rails-ujs" "48","cub" "48","comboboxmodel" "48","nlg" "48","huxtable" "48","genericdao" "48","reroute" "48","lua-5.3" "48","common-dialog" "48","locf" "48","lcg" "48","splfileobject" "48","lsh" "48","mercadopago" "48","google-container-builder" "48","node.js-got" "48","geodesic-sphere" "48","eventreceiver" "48","http-parameters" "48","ios11.2" "48","cfs" "48","httpforbiddenhandler" "48","nodebb" "48","reactive-cocoa-4" "48","lattice-diamond" "48","ios10-today-widget" "48","react-infinite-scroll-component" "48","durability" "48","resize-crop" "48","io-uring" "48","logstash-filter" "48","node-oidc-provider" "48","react-codemirror" "48","android-parsequeryadapter" "48","metaphone" "48","login-system" "48","google-cloud-automl-nl" "48","logic-error" "48","excel-2021" "48","erwin" "48","chained-assignment" "48","perf4j" "48","image-load" "48","spark-checkpoint" "48","maven-versions-plugin" "48","webpack-bundle-analyzer" "48","maxifs" "48","zerorpc" "48","msmtp" "48","google-reviews" "48","heap-profiling" "48","autopy" "48","alternate-data-stream" "48","ushort" "48","flutter-module" "48","beforeupdate" "48","theorem" "48","zohocatalyst" "48","webinvoke" "48","scrumboard" "48","qtranslate-x" "48","cycle-detection" "48","suiteql" "48","asciiencoding" "48","zoomcharts" "48","flutter-slider" "48","liferay-hook" "48","qtwayland" "48","starmap" "48","flutter-web-browser" "47","standard-layout" "47","travis-ci-cli" "47","github-pages-deploy-action" "47","trove4j" "47","flutter-file" "47","proc-object" "47","anonymity" "47","remote-actors" "47","graph-explorer" "47","wechat-miniprogram" "47","relative-date" "47","fbsdksharekit" "47","claudiajs" "47","slowmotion" "47","webviewchromium" "47","tensorflow-data-validation" "47","graphedit" "47","tritonserver" "47","eclipse-formatter" "47","xyz" "47","mutablestateof" "47","basic-msi" "47","skeletal-mesh" "47","jboss-4.0.x" "47","grouping-sets" "47","mvcgrid" "47","react-native-dropdown-picker" "47","vue-render-function" "47","jcmd" "47","skvideonode" "47","clplacemark" "47","jcabi" "47","bacula" "47","xml-editor" "47","selectbooleancheckbox" "47","apns-sharp" "47","physicsjs" "47","runit" "47","xna-3.0" "47","ngx-chips" "47","rust-bindgen" "47","rust-ink" "47","afincrementalstore" "47","pimcore-v5" "47","cassandra-python-driver" "47","apfs" "47","dismissviewcontroller" "47","fsyacc" "47","dismissible" "47","incron" "47","ujson" "47","distriqt" "47","phrases" "47","managedobjectcontext" "47","flask-assets" "47","semantic-search" "47","software-collections" "47","mapsui" "47","chromium-os" "47","fuchsia" "47","safety-critical" "47","pagertabstrip" "47","python-bytearray" "47","method-group" "47","django-tenants" "47","angular-localize" "47","n" "47","documentclient" "47","waypoint" "47","pyasn1" "47","capicom" "47","oracle-cdc" "47","django-parler" "47","windows-machine-learning" "47","na.rm" "47","wavemaker" "47","django-datatable" "47","jnotify" "47","grandchild" "47","ice-cube" "47","airbyte" "47","server-core" "47","walrus-operator" "47","docker-push" "47","public-key-pinning" "47","dllmain" "47","cakephp-routing" "47","aws-app-config" "47","grails3.2.0" "47","jobrunr" "47","cricheditctrl" "47","wikimedia-dumps" "47","robotframework-sshlibrary" "47","aws-private-link" "47","grails-searchable" "47","grunt-contrib-jshint" "47","grunt-contrib-jasmine" "47","neo4j-python-driver" "47","twilio-node" "47","simgrid" "47","bonferroni" "47","sametime" "47","oneplusone" "47","bootstrap-dialog" "47","saxon-c" "47","epg" "47","enyim" "47","spring-oxm" "47","opcodes" "47","nsscroller" "47","iommu" "47","kaitai-struct" "47","navigatetourl" "47","natsort" "47","online-store" "47","karel" "47","btrace" "47","oai" "47","gocardless" "47","overlayitem" "47","new-style-class" "47","ob-get-contents" "47","razorsql" "47","rapidclipse" "47","object.observe" "47","abrecord" "47","set-cover" "47","pypiserver" "47","setforegroundwindow" "47","acc" "47","google-bigquery-storage-api" "47","libusbdotnet" "47","ezaudio" "47","osm2pgsql" "47","ride" "47","javascript-function-declaration" "47","golangci-lint" "47","virtual-printer" "47","libgpiod" "47","codesynthesis" "47","amd-rocm" "47","brk" "47","reverse-lookup" "47","learnr" "47","rawimage" "47","code-map" "47","2-legged" "47","uc-browser" "47","accent-sensitive" "47","game-boy-advance" "47","tobjectlist" "47","registrar" "47","associate" "47","rails-4-2-1" "47","tatsu" "47","halt" "47","expo-web" "47","iterator-traits" "47","timefield" "47","ml-studio" "47","uic" "47","opera-mobile" "47","xcode14.3" "47","spring-validation" "47","takesscreenshot" "47","controlfile" "47","drop-database" "47","exceptionmapper" "47","xcode10.3" "47","table-rename" "47","exception-specification" "47","dsbulk" "47","continuewith" "47","haneke" "47","isolate" "47","uint8list" "47","wxnotebook" "47","openstack-cinder" "47","contextily" "47","spritefont" "47","scoped-model" "47","tapjoy" "47","scanline" "47","mobile-data" "47","asp.net-core-configuration" "47","androidimageslider" "47","isession" "47","communicationexception" "47","onappear" "47","google-cloud-repository" "47","common-test" "47","prolog-assert" "47","requestfiltering" "47","column-types" "47","stream-graph" "47","laravel-package" "47","tomee-8" "47","morelinq" "47","spek" "47","testcasesource" "47","testem" "47","membershipreboot" "47","humanize" "47","cfile" "47","irepository" "47","logo-lang" "47","android-mms" "47","resource-file" "47","ctakes" "47","launch-configuration" "47","text-analytics-api" "47","leap-second" "47","stripchart" "47","elasticsearch-rest-client" "47","ninjaframework" "47","protocol-oriented" "47","evict" "47","http-equiv" "47","elasticsearch-model" "47","permissionerror" "47","resharper-5.0" "47","prosody-im" "47","moxios" "47","qjsonobject" "47","emr-serverless" "47","zend-filter" "47","dapper-contrib" "47","pandas-udf" "47","utm-tracking" "47","emojione" "47","panelgrid" "47","panel-pyviz" "47","urlrewriter" "47","gnuplot-iostream" "47","bigsql" "47","soomla" "47","tiddlywiki5" "47","heist" "47","tpanel" "47","quazip" "47","bijection" "47","hellosign-api" "47","sublimetext-snippet" "47","bilstm" "47","thirdweb" "47","prefixes" "47","scrollviewreader" "47","seaborn-objects" "47","torii" "47","flutter-release" "47","subparsers" "47","emacs-prelude" "47","asa" "47","useselector" "47","style-transfer" "47","yui2" "47","tfs-2013" "47","compiler-explorer" "47","sdl-1.2" "47","haskell-prelude" "47","conductor" "47","static-order-fiasco" "47","end-of-life" "46","intellij-scala" "46","xslkey" "46","lisp-macros" "46","listbuffer" "46","sql-server-mars" "46","flex-mx" "46","git-ls-files" "46","gf" "46","yii-relations" "46","weld-se" "46","react-router-relay" "46","vue-ssr" "46","flutter-apk" "46","teaspoon" "46","flowdocumentreader" "46","stackless" "46","debhelper" "46","sitemappath" "46","yahoo-maps" "46","processing-ide" "46","jboss-cache" "46","fluorinefx" "46","default-browser" "46","materialized-path-pattern" "46","barcode4j" "46","private-repository" "46","cloudevents" "46","sslpinning" "46","translators" "46","temporal-difference" "46","fluent-ribbon" "46","chrome-ios" "46","adornerlayer" "46","appdomainsetup" "46","apache-minifi" "46","display-manager" "46","python-applymap" "46","cassandra-stress" "46","jslink" "46","apache-metamodel" "46","distilbert" "46","rust-no-std" "46","mapbox-studio" "46","ngrx-data" "46","json-framework" "46","unattended-processing" "46","addr2line" "46","cassandra-2.2" "46","laravel-broadcast" "46","cc-mode" "46","content-delivery-network" "46","nextjs-rewrites" "46","undelete" "46","swxmlhash" "46","socketcluster" "46","freetextbox" "46","console-input" "46","xpath-3.1" "46","fiscal" "46","manifest-merging" "46","flatiron.js" "46","unittest++" "46","pair-programming" "46","implicitwait" "46","xirr" "46","pimple" "46","capped-collections" "46","css-cascade" "46","aws-ec2-instance-connect" "46","urhosharp" "46","wasabi" "46","waitformultipleobjects" "46","angular-ui-sortable" "46","aircrack-ng" "46","cakephp-3.6" "46","aws-direct-connect" "46","icu4j" "46","ruby-test" "46","sharefile" "46","veeam" "46","kiali" "46","rsocket-java" "46","vector-multiplication" "46","unpkg" "46","aws-lambda-containers" "46","server-communication" "46","real-time-multiplayer" "46","google-voice-actions" "46","rolap" "46","server-monitoring" "46","rocky-os" "46","keycloak-spi" "46","aws-control-tower" "46","sharetribe" "46","vcftools" "46","avspeechutterance" "46","aws-access-policy" "46","servlet-3.1" "46","publishing-site" "46","optapy" "46","mysql-error-1052" "46","pulumi-python" "46","facebook-ui" "46","icloneable" "46","joomla3.5" "46","sine-wave" "46","nantcontrib" "46","nested-select" "46","jviewport" "46","dynamic-method" "46","tycho-surefire-plugin" "46","boost-statechart" "46","botconnector" "46","polymorphic-relationship" "46","keepalived" "46","twiki" "46","app-thinning" "46","mongoose-models" "46","jwysiwyg" "46","ioref" "46","eot" "46","applocker" "46","boost-foreach" "46","monetdblite" "46","mongoalchemy" "46","julia-dataframe" "46","karate-call-single" "46","popupmenubutton" "46","invokemember" "46","ioio" "46","nspopupbuttoncell" "46","jubula" "46","writexl" "46","delimited-continuations" "46","jtreetable" "46","htmleditorextender" "46","entity-bean" "46","inno-download-plugin" "46","pebble" "46","nrql" "46","bootstrap-wysiwyg" "46","nelmio-alice" "46","app-route" "46","crdt" "46","wp-mail" "46","http.server" "46","pcre2" "46","kaios" "46","spring-data-hadoop" "46","moinmoin" "46","ospf" "46","netty4" "46","microsoft-query" "46","missing-symbols" "46","microsoft-store" "46","ubuntu-21.04" "46","typewriter" "46","lyft-api" "46","ucos" "46","fragment-oncreateview" "46","google-client-login" "46","netbeans-9" "46","oci-java-sdk" "46","orbitcontrols" "46",".net-security" "46","fourcc" "46","audioclip" "46","netlify-cli" "46","godot-shader-language" "46","synclock" "46","shodan" "46","about-box" "46","razor-declarative-helpers" "46","amp-bind" "46","extrinsic-parameters" "46","ancova" "46","withings" "46","brushes" "46","extended-precision" "46","winghci" "46","winginx" "46","javafx-9" "46","randomized-algorithm" "46","facebook-app-settings" "46","virtual-ip-address" "46","difference-lists" "46","gcc-extensions" "46","xaml-islands" "46","nvapi" "46","dot.js" "46","gcc9" "46","hashicorp-packer" "46","xamarin-forms-4" "46","uibarbuttonitemstyle" "46","galen" "46","gatein" "46","quil" "46","exchange-management-shell" "46","continuous-testing" "46","xampp-vm" "46","drawertoggle" "46","asqueryable" "46","nuxtjs2" "46","rack-test" "46","sqlbrite" "46","jam" "46","uimodaltransitionstyle" "46","control-language" "46","redhat-bpm" "46","scalar-subquery" "46","hammock" "46","aspen" "46","vertex-ai-pipeline" "46","radix-tree" "46","dotspatial" "46","notification-area" "46","uidocumentinteractioncontroller" "46","xcode7-beta2" "46","nose2" "46","sql.js" "46","hibernate-filters" "46","dr-memory" "46","qxmlstreamreader" "46","gambling" "46","rails-upgrade" "46","redirect-uri" "46","spectra" "46","react-flatlist" "46","spotlight-dbpedia" "46","react-font-awesome" "46","actualheight" "46","google-cloud-identity-aware-proxy" "46","duplex-channel" "46","resize-observer" "46","speculative-execution" "46","low-level-code" "46","http-range" "46","lpeg" "46","cufflinks" "46","react-native-bridge" "46","qodbc" "46","android-ktx" "46","qopenglwidget" "46","android-reboot" "46","actionform" "46","large-title" "46","cuda-driver" "46","cuda-context" "46","melpa" "46","act" "46","requirejs-text" "46","memberof" "46","hwpf" "46","cssresource" "46","http-status-code-303" "46","geospark" "46","cfpdf" "46","mdpi" "46","automationelement" "46","amazon-cognito-identity-js" "46","tpot" "46","passive-view" "46","zend-rest" "46","preg-grep" "46","scsf" "46","mcisendstring" "46","autoreconf" "46","parameter-sniffing" "46","pre-allocation" "46","automap" "46","beam-sql" "46","sosex" "46","threadcontext" "46","tooltwist" "46","web-feature-service" "46","fomantic-ui" "46","iformatprovider" "46","linear-optimization" "46","lidgren" "46","google-roads-api" "46","ihttpclientfactory" "46","google-inbox" "46","toplink-essentials" "46","gluu" "46","hbase-shell" "46","starlark" "46","stateless-session" "46","glscene" "46","maven-reactor" "46","flyspell" "45","git-describe" "45","graphdiff" "45","jcodemodel" "45","tree-search" "45","yii-routing" "45","ggh4x" "45","cmdb" "45","squashfs" "45","wheelnav.js" "45","ant-media-server-sdk" "45","stackage" "45","click-tracking" "45","eazfuscator" "45","feature-scaling" "45","insert-query" "45","babel-core" "45","jet-engine" "45","sktime" "45","jets3t" "45","llc" "45","relaunch" "45","progmem" "45","multimodal" "45","vte" "45","page-replacement" "45","binding-context" "45","findoneandupdate" "45","xmobar" "45","runtime-environment" "45","cdb" "45","kyotocabinet" "45","smart-quotes" "45","unittest2" "45","python-binance" "45","xop" "45","connectiq" "45","play-framework-2.7" "45","fullcalendar-2" "45","conll" "45","ultimate-member" "45","displayname-attribute" "45","python-cmd" "45","firefox-android" "45","constantfolding" "45","kube-scheduler" "45","jtapi" "45","oxm" "45","flattr" "45","apache-spark-1.5" "45","date-histogram" "45","xml-encoding" "45","pitch-detection" "45","xmlelement" "45","directory-tree" "45","django-sphinx" "45","dnsimple" "45","django-custom-manager" "45","watson-knowledge-studio" "45","createremotethread" "45","docker-logs" "45","cryptanalysis" "45","csound" "45","server-load" "45","crosswalk-project" "45","oraclecommand" "45","w3wp.exe" "45","vector-auto-regression" "45","crf++" "45","sharepoint-addin" "45","unobtrusive" "45","kfp" "45","vctrs" "45","aws-msk-connect" "45","datadetectortypes" "45","go-packages" "45","fall-through" "45","pugxmultiuserbundle" "45","gramex" "45","pssnapin" "45","jotform" "45","pwabuilder" "45","mi" "45","wikibase" "45","datagridviewcellstyle" "45","anjuta" "45","agda-mode" "45","myo" "45","dataguard" "45","rsvg" "45","facebook-sdk-3.14.x" "45","facebook-python-business-sdk" "45","react-tooltip" "45","failed-to-connect" "45","rebalancing" "45","input-buffer" "45","application-blocks" "45","kamon" "45","kaboom" "45","one-click-web-publishing" "45","kde4" "45","mongo-go-driver" "45","grunt-contrib-imagemin" "45","tweedie" "45","nested-properties" "45","bpython" "45","azure-custom-domain" "45","dependency-resolution" "45","mongodb.driver" "45","springdoc-openui" "45","enterprise-portal" "45","easy-digital-downloads" "45","couchrest" "45","jquery-1.8" "45","azure-dsvm" "45","opendap" "45","dynamic-class" "45","mongodb-lookup" "45","intermec" "45","intermediate-code" "45","grunt-wiredep" "45","dynamic-view" "45","jquery-attributes" "45","gs1-ai-syntax" "45","nslayoutanchor" "45","jquery-resizable" "45","ingest" "45","typemock-isolator" "45","type-members" "45","java-print" "45","google-aiy" "45","uia" "45","ratchet-bootstrap" "45","occlusion-culling" "45","code-server" "45","lunrjs" "45","shinydashboardplus" "45","systemexit" "45","winexe" "45","midi-instrument" "45","magic-function" "45","netdata" "45","system-identification" "45","freebasic" "45","dosgi" "45","extjs6.5" "45","goclipse" "45","oasis" "45","gobblin" "45","google-blogger-api" "45","formborderstyle" "45","missing-template" "45","lync-server-2010" "45","asus-xtion" "45","shorthand-if" "45","iterated-function" "45","openhardwaremonitor" "45","drupal-ctools" "45","hono" "45","bungeecord" "45","devpi" "45","railsinstaller" "45","hash-code-uniqueness" "45","xamarin-live-player" "45","halogen" "45","spweb" "45","expo-auth-session" "45","dgl" "45","radosgw" "45","gedcom" "45","gwtupload" "45","mkmapsnapshotter" "45","gwttestcase" "45","railtie" "45","highpass-filter" "45","android-designer" "45","sqitch" "45","built-value" "45","gembox-document" "45","xai" "45","collocation" "45","progressmonitor" "45","resource-loading" "45","iredmail" "45","android-jetpack-compose-tv" "45","ipmitool" "45","angular-cli-v9" "45","activerecord-import" "45","colt" "45","tomography-reconstruction" "45","resolveurl" "45","excel-dates" "45","angular-broadcast" "45","geolite2" "45","terraform-provider-vsphere" "45","moonlight" "45","lazy-high-charts" "45","google-cloud-ops-agent" "45","resilience4j-retry" "45","geostatistics" "45","storable" "45","angular2-moment" "45","node-archiver" "45","storekit2" "45","angular2-injection" "45","request.servervariables" "45","stripe-payments-js" "45","generative" "45","character-entities" "45","spoof" "45","qcoreapplication" "45","property-files" "45","laravel-octane" "45","cfsocket" "45","spine" "45","protobuf-csharp-port" "45","zend-log" "45","pgi-accelerator" "45","sparrow-framework" "45","ember.js-view" "45","mediatorlivedata" "45","aliexpress" "45","ms-access-data-macro" "45","google-keep" "45","pre-rendering" "45","google-maps-autocomplete" "45","mclust" "45","light-4j" "45","sonarqube5.2" "45","footprint" "45","archilogic" "45","soundfont" "45","spark-operator" "45","enaml" "45","mediawiki-installation" "45","amazon-marketplace" "45","quaggajs" "45","compiled-language" "45","powershell-dsc" "45","total-commander" "45","enet" "45","hfs+" "45","timagelist" "45","almond" "45","webdrivermanager-python" "45","partial-trust" "45","sorttable.js" "45","conceptual-model" "45","usebean" "45","array-unset" "45","question2answer" "45","pass-by-name" "45","customtool" "45","google-product-search" "45","identitymanager" "45","spark-excel" "45","webget" "44","vue-property-decorator" "44","editablegrid" "44","gridviewrow" "44","tedgebrowser" "44","graylog3" "44","greenhopper" "44","clickstream" "44","truestudio" "44","multiplechoicefield" "44","material-you" "44","stackalloc" "44","ddl-trigger" "44","claims-authentication" "44","git-bundle" "44","wdio-v5" "44","yguard" "44","clearcase-automation" "44","react-native-text" "44","react-native-share" "44","econnect" "44","program-slicing" "44","deadbolt-2" "44","deadbolt" "44","react-native-pdf" "44","cobol85" "44","flutter-devtools" "44","yesod-forms" "44","ecmascript-intl" "44","programdata" "44","imap-tools" "44","catboostregressor" "44","g++4.9" "44","symfony-http-client" "44","switch-user" "44","labelimg" "44","soapexception" "44","contacts-framework" "44","contact-list" "44","vrtk" "44","xmlschemaset" "44","nginx-upstreams" "44","adplus" "44","snowflake-stage" "44","jstree-dnd" "44","nhapi" "44","fromhtml" "44","aerospike-ce" "44","cellinfo" "44","afhttpclient" "44","umts" "44","smbj" "44","filenet-process-engine" "44","xmpp4r" "44","vscode-liveshare" "44","datemodified" "44","bit-representation" "44","package-info" "44","firefox-headless" "44","distroless" "44","consensys-truffle" "44","carousel-slider" "44","flask-httpauth" "44","finatra" "44","python-standalone" "44","flask-caching" "44","bing-translator-api" "44","bindservice" "44","fairseq" "44","gpu-warp" "44","upickle" "44","root-access" "44","jpct" "44","recognizer-intent" "44","rodeo" "44","sipml" "44","ibis" "44","i18next-http-backend" "44","optional-binding" "44","simplex-algorithm" "44","data-filtering" "44","fastjsonapi" "44","calendarkit" "44","keyeventargs" "44","microsoft-commerce-server" "44","robotjs" "44","serverless-plugins" "44","crystal-reports-2011" "44","unity-components" "44","favorite" "44","shareplum" "44","n3" "44","windowsformsintegration" "44","akita" "44","angularjs-ng-checked" "44","canjs-model" "44","wcf-4" "44","icloud-documents" "44","grads" "44","aws-sct" "44","ibm-domino" "44","rowsorter" "44","recursive-mutex" "44","rtmps" "44","jml" "44","shared-variable" "44","aws-networking" "44","avro4s" "44","cri-o" "44","ruby-2.6" "44","joinfaces" "44","fastavro" "44","window-position" "44","rostering" "44","session-store" "44","covariant-return-types" "44","detailtextlabel" "44","ws-reliablemessaging" "44","azure-database-postgresql" "44","postman-native-app" "44","apple-app-site-association" "44","native-file-system-api-js" "44","spring-integration-mqtt" "44","nehotspothelper" "44","neo4j-graphql-js" "44","approximate-nn-searching" "44","kazoo" "44","mojolang" "44","wrds" "44","ararat-synapse" "44","justpy" "44","simctl" "44","nested-datalist" "44","scala-implicits" "44","html-frames" "44","inproc" "44","swifter" "44","tvos9.1" "44","wordpress-json-api" "44","mongodb-cluster" "44","sap-cpi" "44","pattern-layout" "44","simile" "44","wpforms" "44","aws-session-manager" "44","guardian" "44","boost-proto" "44","pdfobject" "44","android-video-record" "44","boxsizer" "44","intersystems-iris" "44","path-2d" "44","epp" "44","nested-transactions" "44","win-phone-silverlight-8.1" "44","minibuffer" "44","orbited" "44","ezplatform" "44","ktlint" "44","javascript-security" "44","klaxon" "44","system-services" "44","t4scaffolding" "44","netty-socketio" "44","kotlin-java-interop" "44","netbox" "44","android-a11y" "44","ezsql" "44","millennial-media" "44","visual-studio-shell" "44","orientdb3.0" "44","known-folders" "44","aswebauthenticationsession" "44","obfuscar" "44","ocs" "44","bscscan" "44","ocsigen" "44","java-interop" "44","m4v" "44","lustre" "44","async-iterator" "44","nvvp" "44","sysdba" "44","rete" "44","dom-to-image" "44","wordpad" "44","libstreaming" "44","libopencm3" "44","java-binding" "44","syswow64" "44","system.windows.media" "44","lz77" "44","attachevent" "44","viber-bot" "44","knative-eventing" "44","netdatacontractserializer" "44","viber-api" "44","tls1.1" "44","sqlcompare" "44","jammit" "44","tailwind-elements" "44","sqlcode" "44","cachestorage" "44","uidocumentbrowservc" "44","geemap" "44","highrise" "44","isqlquery" "44","gvm" "44","harvest" "44","openxml-powertools" "44","android-debugging" "44","hive-configuration" "44","mkdocs-material" "44","ithit-ajax-file-browser" "44","azure-web-pubsub" "44","qz-tray" "44","xamarin-linker" "44","caa" "44","plottable" "44","drawingvisual" "44","asterisk-ari" "44","xamarin-android-player" "44","android-custom-keyboard" "44","hibernate-types" "44","sql-graph" "44","drupal-search" "44","conv1d" "44","sqlbuilder" "44","xcode-build-settings" "44","gdelt" "44","react-link" "44","color-conversion" "44","color-coding" "44","csv-parser" "44","laravel-ui" "44","color-blindness" "44","node.js-tape" "44","qresource" "44","gentelella" "44","spatial-data" "44","project-properties" "44","qfilesystemwatcher" "44","ip-fragmentation" "44","exactly-once" "44","chakra" "44","e-signature" "44","actionsheet" "44","zune" "44","angular2-guards" "44","event-stream-processing" "44","testing-strategies" "44","specular" "44","dub" "44","google-cloud-ai-platform-pipelines" "44","perl-xs" "44","nltk-book" "44","leader" "44","octoprint" "44","react-component-unmount" "44","qmutex" "44","perplexity" "44","lsusb" "44","text-comparison" "44","stress" "44","prcomp" "44","torchserve" "44","subst" "44","prebid" "44","armclang" "44","thejit" "44","topendialog" "44","ember-i18n" "44","bea" "44","big5" "44","google-refine" "44","state-machine-workflow" "44","themeprovider" "44","webgl-globe" "44","zend-lucene" "44","gnu-arm" "44","transform-feedback" "44","emcc" "44","parquet-mr" "44","amazon-alb" "44","gnumeric" "44","bats-core" "44","computed-style" "44","glrotate" "44","arcgis-android-api" "44","tia-portal" "44","touchjson" "44","solaris-studio" "44","power-off" "44","tightly-coupled-code" "44","dali" "44","ikimageview" "44","multibyte-functions" "44","multibyte-characters" "44","pantheios" "44","sourcelink" "44","powershell-az-module" "44","powershell-jobs" "44","spark-framework" "43","floyd-cycle-finding" "43","llama3" "43","sskeychain" "43","installshield-2015" "43","multiple-gpu" "43","php-phantomjs" "43","prism-7" "43","sshkit" "43","jcasc" "43","tsoa" "43","gitahead" "43","git-filter" "43","bank-conflict" "43","tello-drone" "43","triton" "43","antimalware" "43","local-functions" "43","programming-pearls" "43","prezto" "43","intellij-inspections" "43","cmb2" "43","clam" "43","fieldcodes" "43","antlr4cs" "43","background-blend-mode" "43","cmenu" "43","decal" "43","location-based-service" "43","grouped-collection-select" "43","sql-variant" "43","symfit" "43","casing" "43","phpwkhtmltopdf" "43","rxalamofire" "43","check-digit" "43","dist-zilla" "43","datastax-php-driver" "43","rjb" "43","mariadb-connect-engine" "43","page-transition" "43","apartments" "43","xonsh" "43","firebase-machine-learning" "43","python-responses" "43","ftgl" "43","flask-sockets" "43","pact-java" "43","pythonmagick" "43","pip-tools" "43","xpce" "43","fslex" "43","next-pwa" "43","umount" "43","snmptrapd" "43","django-countries" "43","aerogear" "43","cefglue" "43","datalength" "43","chruby" "43","x-dwm" "43","semplot" "43","ccr" "43","syn" "43","image-stabilization" "43","chrome-app-developer-tool" "43","pkcs#5" "43","freezable" "43","python-contextvars" "43","s2i" "43","adoconnection" "43","ngx-echarts" "43","immutablelist" "43","chips" "43","readlink" "43","keynotfoundexception" "43","mysql.sock" "43","rnoaa" "43","microsoft.build" "43","optix" "43","crlf-vulnerability" "43","angularjs-ng-touch" "43","django-rest-swagger" "43","django-generic-relations" "43","rubyxl" "43","recess" "43","ib-insync" "43","servicestack-auth" "43","cryptographicexception" "43","rmstore" "43","jotai" "43","createwindowex" "43","awr" "43","capstone" "43","keyboard-maestro" "43","grapecity" "43","ptr-vector" "43","fastmember" "43","rkt" "43","akka.net-persistence" "43","role-manager" "43","callblocking" "43","wbem" "43","psreadline" "43","mysql-error-2003" "43","angular-ngfor" "43","mysql-error-1442" "43","ora-06512" "43","bluegiga" "43","oneupuploaderbundle" "43","android-wear-complication" "43","bnfc" "43","errbot" "43","password-checker" "43","hostmonster" "43","infineon" "43","nsdiffabledatasourcesnapshot" "43","jquery-globalization" "43","jquery-2.0" "43","inline-scripting" "43","onepage-scroll" "43","payload-cms" "43","azure-data-catalog" "43","svgwrite" "43","html5-notifications" "43","sas-metadata" "43","sap-business-application-studio" "43","enumerated-types" "43","aws-storage-gateway" "43","springrunner" "43","spring-data-graph" "43","kafka-transactions-api" "43","demographics" "43","apptainer" "43","bond" "43","apple-login" "43","envi" "43","asymmetric" "43","typeorm-datamapper" "43","rich-notifications" "43","riak-cs" "43","revenue" "43","visual-c++-2017" "43","vim-powerline" "43","netldap" "43","golint" "43","mailchimp-api-v3" "43","fosfacebookbundle" "43","netflix-conductor" "43","javascript-globalize" "43","browscap" "43","setup.exe" "43","rexcel" "43","btrieve" "43","richtextediting" "43","asynchronous-postback" "43","abstract-algebra" "43","rblpapi" "43","overlapping-instances" "43","video-memory" "43","java-nio" "43","pystray" "43","typeinitializeexception" "43","external-dns" "43","ossec" "43","formencode" "43","visual-inheritance" "43","lfsr" "43","extreme-programming" "43","learn-ruby-the-hard-way" "43","colcon" "43","signatures" "43","regexkitlite" "43","aspnetcore-environment" "43","gauss" "43","azure-releases" "43","aspnetzero" "43","refinements" "43","numbered-list" "43","radium" "43","galileo" "43","scala-pickling" "43","mobile-angular-ui" "43","x509trustmanager" "43","table-lock" "43","npcap" "43","xamarin.forms.entry" "43","diaspora" "43","pn532" "43","continuous-forms" "43","devicecheck" "43","itunesartwork" "43","xamarin.shell" "43","handshaking" "43","rails7" "43","xamarin.winphone" "43","isolation-forest" "43","astral-plane" "43","android-data-usage" "43","hashgraph" "43","wxglade" "43","dragonboard" "43","vert.x-webclient" "43","hierarchical-trees" "43","content-values" "43","rag" "43","sql-server-administration" "43","assemblyresolve" "43","openshift-online" "43","nuclio" "43","diffmerge" "43","gw-basic" "43","c++builder-10.1-berlin" "43","policyfiles" "43","quickform" "43","scmmanager" "43","nolearn" "43","nix-flake" "43","pep8-assembly" "43","storagefolder" "43","android-jetpack-compose-ui" "43","move-lang" "43","hummus.js" "43","react-multi-carousel" "43","generic.xaml" "43","huawei-account" "43","android-lazyloading" "43","angular-injector" "43","mercury" "43","charms-bar" "43","responder-chain" "43","collaborative" "43","movieplayer" "43","pfloginviewcontroller" "43","geotargetting" "43","chainlink-keepers" "43","geshi" "43","angularbuild" "43","perl-tidy" "43","eviews" "43","qquickwidget" "43","eventvalidation" "43","request-queueing" "43","texttemplate" "43","mootools1.2" "43","laravel-mix-vue3" "43","curry-howard" "43","react-ace" "43","qabstractitemview" "43","active-objects" "43","spectral-python" "43","elasticsearch-8" "43","spray-dsl" "43","pep517" "43","git-review" "43","web-mining" "43","third-normal-form" "43","mru" "43","google-search-platform" "43","alpaca" "43","tpc" "43","cvxr" "43","panoramio" "43","libyuv" "43","structured-concurrency" "43","qt-vs-addin" "43","biicode" "43","partcover" "43","emm" "43","mt" "43","conan-2" "43","arviz" "43","git-mv" "43","multi-configuration" "43","amazon-product-advertising-api" "43","transformation-matrix" "43","gl-matrix" "43","google-php-sdk" "43","scrollrect" "43","tfs-alerts" "43","secure-element" "43","premailer" "43","daq-mx" "43","google-plus-domains" "43","precompiler" "43","parsefacebookutils" "43","structr" "43","web-client" "43","heron" "43","google-streetview-publish" "42","slurp" "42","match-recognize" "42","banana-pi" "42","xwork" "42","cloudconvert" "42","ecryptfs" "42","masonry-ios-osx" "42","intellij-idea-2018" "42","wdio-v6" "42","define-syntax" "42","defaultifempty" "42","ssis-connection-manager" "42","troff" "42","graphql-php" "42","ec2-userdata" "42","defaultazurecredential" "42","process-control" "42","jboss-portal" "42","loadcontrol" "42","gideros" "42","xtype" "42","clipboard-interaction" "42","file-find" "42","skulpt" "42","jest-preset-angular" "42","ghost4j" "42","multiple-variable-return" "42","ghcr" "42","baseline-profile" "42","debug-diagnostic-tool" "42","intel-8080" "42","matlab-spm" "42","mvccontrib-testhelper" "42","phonertc" "42","mvp4g" "42","skcropnode" "42","flutter-background" "42","telerik-test-studio" "42","app-globalresources" "42","chrome-profile" "42","appassembler" "42","chopper" "42","adodbapi" "42","data-profiling" "42","jtemplates" "42","addremoveprograms" "42","jscharts" "42","filtered" "42","consuming" "42","confluent-kafka-go" "42","platform-agnostic" "42","cart-analysis" "42","fink" "42","aparapi" "42","flashlite" "42","volar" "42","bitmapdrawable" "42","rxcpp" "42","bitcount" "42","freestanding" "42","makemaker" "42","swiftystorekit" "42","xmlcatalog" "42","sa" "42","xmllist" "42","page.js" "42","xml-literals" "42","pagefile" "42","image-slider" "42","ftpwebresponse" "42","vscode-jsconfig" "42","django-auth-models" "42","xlm" "42","fvm" "42","xdoclet" "42","fxcopcmd" "42","pairplot" "42","uniobjects" "42","manifold" "42","pandas-merge" "42","seetest" "42","cargo-maven2-plugin" "42","fsharpchart" "42","rsi" "42","ruff" "42","fastlane-deliver" "42","aws-glue-workflow" "42","ora-01017" "42","aws-datasync" "42","unity-dots" "42","data-gateway" "42","waitforexit" "42","real-number" "42","sitecore-analytics" "42","validationgroup" "42","docker-ucp" "42","servicestack-autoquery" "42","windows-98" "42","iaik-jce" "42","windows-7-embedded" "42","native-aot" "42","keycloak-angular" "42","kinect-interaction" "42","gpuimagestillcamera" "42","datagridviewimagecolumn" "42","dockerignore" "42","angular-ui-tabset" "42","databasedotcom-gem" "42","shared-access-signatures" "42","roweditor" "42","icd" "42","rollovers" "42","gst-launch-1.0" "42","borb" "42","nsblockoperation" "42","wrk" "42","wsit" "42","boost-random" "42","delphi-10.4.2" "42","guard-statement" "42","guideline-support-library" "42","nslock" "42","jquery-get" "42","neo4j-bolt" "42","hotwire" "42","jquery-trigger" "42","error-list" "42","twrequest" "42","nestjs-fastify" "42","htonl" "42","turbo-prolog" "42","aps" "42","openfin" "42","mod-proxy-balancer" "42","cppwinrt" "42","sap-hr" "42","appledoc" "42","sbml" "42","html-renderer" "42","powerapps-portal" "42","postgresql-8.2" "42","workflow-foundation-4.5" "42","paypal-pdt" "42","u8darts" "42","typescript2.1" "42","vimeo-ios" "42","luasql" "42","rex" "42","mill" "42","javafx-tableview" "42","raw-loader" "42","code-security" "42","vivus" "42","extrafont" "42","outline-view" "42","outlining" "42",".net-runtime" "42","object-code" "42","rank-n-types" "42","audiosegment" "42","kotlin-symbol-processing" "42","formstack" "42","javascript-decorators" "42","pyfcm" "42","mio" "42","o365security-compliance" "42","coinduction" "42","new-item" "42","form-layout" "42","facebook-debugger" "42","virtual-drive" "42","bubblewrap" "42","kotlin-companion" "42","devsecops" "42","mobileiron" "42","radajaxmanager" "42","redislabs" "42","rails-generators" "42","horde" "42","novnc" "42","pljson" "42","tagless-final" "42","nuodb" "42","drupal-ajax" "42","hasattr" "42","scoped-ptr" "42","taction" "42","hardening" "42","azure-sphere" "42","racket-student-languages" "42","expandable-table" "42","time-estimation" "42","bundletransformer" "42","sql-except" "42","associated-domains" "42","cordova-media-plugin" "42","racsignal" "42","tobase64string" "42","hl7-v3" "42","itunes-search-api" "42","nszombieenabled" "42","mobclix" "42","task-management" "42","highgui" "42","opengl-2.0" "42","openwebbeans" "42","azure-private-dns" "42","qwerty" "42","notary" "42","notesview" "42","azure-hub" "42","android-exifinterface" "42","cfthread" "42","activitykit" "42","hudson-api" "42","geonetwork" "42","column-oriented" "42","iotivity" "42","european-data-format" "42","gethostbyaddr" "42","generic-interface" "42","spotless" "42","qjsengine" "42","hxcpp" "42","offscreen-canvas" "42","node-imap" "42","leaflet-draw" "42","low-level-api" "42","okuma" "42","metadatatype" "42","streaming-flv-video" "42","stringcollection" "42","ehcache-2" "42","perldoc" "42","ei" "42","protocolexception" "42","teststack" "42","hygiene" "42","chartjs-plugin-annotation" "42","spmd" "42","messagingcenter" "42","protostuff" "42","latex-suite" "42","terr" "42","logits" "42","hyperhtml" "42","react-native-ble-manager" "42","cfgrib" "42","monotorrent" "42","react-aad-msal" "42","spgridview" "42","cometchat" "42","elasticsearch-geo-shape" "42","mongovue" "42","transformable" "42","google-perftools" "42","alternation" "42","helium" "42","msf4j" "42","scriptcontrol" "42","alt-key" "42","argo-events" "42","msn-messenger" "42","limejs" "42","compilation-time" "42","arrayindexoutofboundsexception" "42","hermite" "42","global.asa" "42","heritrix" "42","webiopi" "42","usermetadata" "42","soundcloud-stratus" "42","d3.geo" "42","thegraph" "42","top-down" "42","enforcement" "42","webbot" "42","igx-grid" "42","flutter-row" "42","starter-kits" "42","git-rerere" "42","dart-packages" "42","has-many-polymorphs" "42","idempiere" "42","web-farm-framework" "42","webactivator" "42","cxml" "42","quadratic-curve" "42","lifecycle-hook" "42","southeast-asian-languages" "42","avalara" "41","mathgl" "41","mutating-function" "41","multistage-pipeline" "41","jedi-code-library" "41","clientwebsocket" "41","skeffectnode" "41","mutablemap" "41","sql-session-state" "41","jetbrains-fleet" "41","jcommander" "41","telerik-ajax" "41","fetch-mock" "41","size-type" "41","sre" "41","website-hosting" "41","skbio" "41","groovyclassloader" "41","sketchware" "41","fedora-commons" "41","vue-good-table" "41","tscrollbox" "41","fluent-design" "41","dc" "41","class-eval" "41","bartintcolor" "41","cmfctoolbar" "41","bartender" "41","treetagger" "41","white-box" "41","dddd" "41","edirectory" "41","easyxdm" "41","fluentlenium" "41","clickablespan" "41","ansible-ad-hoc" "41","yii2-rbac" "41","fluentvalidation-2.0" "41","barman" "41","bare-metal-server" "41","safe-publication" "41","managed-vm" "41","ccnode" "41","binary-log" "41","cbuttoncolumn" "41","dirtyread" "41","bing-speech" "41","pact-net" "41","unicast" "41","ng-html2js" "41","ng-flow" "41","bitcore" "41","apikit" "41","s" "41","ada2012" "41","xfire" "41","snowflake-pipe" "41","disable-link" "41","api-security" "41","python-language-server" "41","mainbundle" "41","firepad" "41","ngx-monaco-editor" "41","rvmrc" "41","ci-merchant" "41","cartogram" "41","appendtext" "41","vscode-api" "41","json-flattener" "41","divshot" "41","adobe-connect" "41","imapx" "41","language-binding" "41","chomsky-hierarchy" "41","markdown-it" "41","socks5" "41","socketstream" "41","dockerode" "41","wiki-markup" "41","public-key-exchange" "41","sitecore-sxa" "41","r-neo4j" "41","operationcontext" "41","vary" "41","gradle-daemon" "41","shared-resource" "41","oracle-analytics" "41","vdm++" "41","dnsjava" "41","django-viewsets" "41","unity-test-framework" "41","service-model" "41","doh" "41","nachos" "41","jform-designer" "41","session-affinity" "41","n-ary-tree" "41","gradle-multi-project-build" "41","document-class" "41","winamp" "41","pyarango" "41","rsa-key-fingerprint" "41","wasmtime" "41","oracle-cloud-infrastructure-classic" "41","valuetask" "41","afx" "41","pure-layout" "41","windows-phone-emulator" "41","hyperstack" "41","hyperscript" "41","rpres" "41","readkey" "41","w3m" "41","oracle-rac" "41","sips" "41","verbatim" "41","wpf-4.5" "41","jupyterbook" "41","design-time-data" "41","html-tbody" "41","opendatabase" "41","androidx-test" "41","svn-server" "41","tuxedo" "41","blitz++" "41","monadplus" "41","postcss-import" "41","braille" "41","module-map" "41","wpf-mediakit" "41","nsrunningapplication" "41","cp-optimizer" "41","sbv" "41","entitycollection" "41","infinitest" "41","nsdialogs" "41","tumblr-html" "41","jquery-ui-progressbar" "41","nestjs-graphql" "41","mongo-jackson-mapper" "41","nsnetservicebrowser" "41","posprinter" "41","pdal" "41","jquery-nestable" "41","devcon" "41","blender-2.61" "41","corosync" "41","sap-crm" "41","jquery-confirm" "41","spring-resource-server" "41","boltdb" "41","aurelia-fetch-client" "41","pymeshlab" "41","middy" "41","rapi" "41","visual-studio-package" "41","kmongo" "41","java-collections-api" "41","5g" "41","domaindatasource" "41","libmysqlclient" "41","rightfax" "41","libxl" "41","google-alloydb" "41","winmd" "41","libtool-xcode" "41","viewanimator" "41","formkit" "41","systemjs-builder" "41","virtual-disk" "41","androidasync-koush" "41","rapid-prototyping" "41","magento-1.13" "41","window-style" "41","visual-c++-2010-express" "41","augmented-assignment" "41","river-crossing-puzzle" "41","macrodef" "41","rdrand" "41","wind-river-workbench" "41","systemdynamics" "41","pytest-qt" "41","setwd" "41","viml" "41","american-fuzzy-lop" "41","opennmt" "41","dropbear" "41","vertx3" "41","drawingarea" "41","schemaspy" "41","highlightjs" "41","aspmenu-control" "41","redland" "41","asp.net-mvc-filters" "41","hibernateexception" "41","ntvs" "41","double-byte" "41","gdbm" "41","gwt-2.4" "41","polymer-elements" "41","versionupgrade" "41","policy-gradient-descent" "41","notification-bar" "41","h.323" "41","expo-sqlite" "41","uigraphicsimagerenderer" "41","expresso" "41","quill.io" "41","uikeycommand" "41","j2v8" "41","c++builder-10.4-sydney" "41","executable-format" "41","sqldb" "41","iso-3166" "41","uiapplicationshortcutitem" "41","tcomb-form-native" "41","timelion" "41","mod-auth" "41","xamarin.forms.labs" "41","ivalidatableobject" "41","tinkergraph" "41","tasklet" "41","iranges" "41","omniauth-linkedin" "41","messagebird" "41","cfimage" "41","character-trimming" "41","chatbase" "41","hybrid-cloud" "41","mouseleftbuttondown" "41","testfairy" "41","geo-replication" "41","google-cloud-resource-manager" "41","http-digest" "41","lts" "41","acsl" "41","response-entity" "41","office-online-server" "41","qextserialport" "41","curity" "41","active-pattern" "41","medusajs" "41","ios-3.x" "41","spill-range" "41","layered-windows" "41","respondstoselector" "41","geoext" "41","pyv8" "41","spike" "41","onactionexecuting" "41","nodename" "41","zero-pad" "41","searchqueryset" "41","google-profiles-api" "41","gmail-pop" "41","autodesk-realitycapture" "41","searchdisplaycontroller" "41","msp432" "41","alt-attribute" "41","webpack-config" "41","sunone" "41","zentest" "41","gmsa" "41","global-object" "41","arrange-act-assert" "41","qtgstreamer" "41","com-server" "41","light-sensor" "41","lightstreamer" "41","tradeoff" "41","thredds" "41","mt19937" "41","parity-io" "41","shellshock-bash-bug" "41","libyaml" "41","libz" "41","cwac-camera" "41","component-space" "41","max-path" "41","sonarqube-api" "41","beam-search" "41","d2xx" "41","autoscalemode" "41","completion-stage" "41","ms-access-97" "41","mdanalysis" "41","sonar-maven-plugin" "41","z-axis" "40","phppowerpoint" "40","ggdendro" "40","squirrel" "40","babel-register" "40","vue-instant-search" "40","fbs" "40","phonepe" "40","matic" "40","rentrez" "40","primus" "40","backgrounding" "40","loading-image" "40","ghc-api" "40","react-native-device-info" "40","instancetype" "40","wiki.js" "40","prism.js" "40","truedepth-camera" "40","teamcity-9.1" "40","fluid-framework" "40","git-am" "40","jenkins-git-plugin" "40","render-blocking" "40","dearpygui" "40","feedjira" "40","live-update" "40","flutter-assetimage" "40","bare" "40","antivirus-integration" "40","tearing" "40","skorch" "40","federated-table" "40","gilead" "40","intel-tsx" "40","slony" "40","youtrack-api" "40","listproperty" "40","annyang" "40","webtop" "40","syncfusion-calendar" "40","distube" "40","index-buffer" "40","apache-knox" "40","plasmoid" "40","nexusdb" "40","dividebyzeroexception" "40","python-aiofiles" "40","fst" "40","python-assignment-expression" "40","placeautocompletefragment" "40","chirp" "40","finalcut" "40","ftp4j" "40","data-quality-services" "40","connector-net" "40","apache-traffic-server" "40","fuzzy-c-means" "40","adpcm" "40","page-flipping" "40","jsonify" "40","pixel-ratio" "40","smartthings" "40","ovf" "40","displayfor" "40","circular-queue" "40","circularreveal" "40","packed-decimal" "40","pipewire" "40","package-manager-console" "40","swscale" "40","ccparticlesystem" "40","runonce" "40","catmull-rom-curve" "40","pickerinput" "40","freerdp" "40","cartridge" "40","sodium" "40","keycloak-js" "40","rnaturalearth" "40","microsoft.mshtml" "40","vanilla-forums" "40","value-restriction" "40","air-android" "40","windows-composition-api" "40","factominer" "40","windows-controls" "40","meteoric" "40","cro" "40","famous-angular" "40","microsoft-ajax-minifier" "40","metronome" "40","pvcs" "40","reader-macro" "40","recyclerlistview" "40","sitecore-xdb" "40","animatedvectordrawable" "40","grails-2.1" "40","css-hyphens" "40","shared-primary-key" "40","name-attribute" "40","vbc" "40","candidate" "40","unity3d-shaders" "40","carbide" "40","roomle" "40","aws-route53" "40","nagle" "40","rowdetailstemplate" "40","verifiable-c" "40","django-swagger" "40","dxva" "40","tuya" "40","nssplitviewcontroller" "40","spring-boot-testcontainers" "40","opendialog" "40","azure-defender" "40","appwarp" "40","bootclasspath" "40","inflector" "40","ergonomics" "40","equivalence-classes" "40","nssound" "40","azure-billing" "40","postgis-installation" "40","infobright" "40","pcapplusplus" "40","apple-configurator" "40","jquery-after" "40","correspondence" "40","ndk-gdb" "40","nestjs-gateways" "40","jquery-fileupload-rails" "40","axwebbrowser" "40","azure-acr" "40","swd" "40","patricia-trie" "40","gsettings" "40","nsapptransportsecurity" "40","inverse-transform" "40","mongodb4.0" "40","dynamodb-mapper" "40","derivingvia" "40","jquery-chaining" "40","gru" "40","mongodb-scala" "40","suppressmessage" "40","border-spacing" "40","entity-framework-mapping" "40","envoyer.io" "40","openbabel" "40","interior-mutability" "40","invokescript" "40","bootstrap-ui" "40","retinanet" "40","google-app-engine-golang" "40","godot3" "40","pyscipopt" "40","rasa-sdk" "40","pypsa" "40","wiris" "40","viewmodel-savedstate" "40","facebook-authorization" "40","magma" "40","3d-printing" "40","klipfolio" "40","m2e-pro" "40","vistadb" "40","octet-stream" "40","video4linux" "40","microsoft-graph-plannertasks" "40","rhdf5" "40","return-path" "40","rhodecode" "40","bref" "40","system.data.sqlclient" "40","u2netdk" "40","2-digit-year" "40","shopify-activemerchant" "40","wkinterfacelabel" "40","sidekick" "40","os161" "40","visual-studio-mac-2022" "40","word-boundaries" "40","viewwilltransitiontosize" "40","mindmap" "40","forwarderrorcorrection" "40","facebooker2" "40","typelite" "40","mixed-code" "40","reductio" "40","redhat-openjdk" "40","dhis-2" "40","excel-r1c1-notation" "40","xacml2" "40","redhat-sso" "40","redux-promise-middleware" "40","azure-mapping-data-flow" "40","xamarin.forms-styles" "40","openmap" "40","nvml" "40","openlink-virtuoso" "40","bull-queue" "40","istio-kiali" "40","xamarin-zebble" "40","bump" "40","istio-operator" "40","nstableheaderview" "40","contextclassloader" "40","wxruby" "40","nstabviewcontroller" "40","quickbasic" "40","android-include" "40","hard-coding" "40","vfork" "40","non-admin" "40","assembly.load" "40","pngquant" "40","sqlncli" "40","cacls" "40","plugman" "40","azure-iot-dps" "40","sql-pl" "40","qvideowidget" "40","android-emulator-plugin" "40","directory-browsing" "40","nsxmldocument" "40","qxmlquery" "40","number-sequence" "40","dta" "40","gwas" "40","expo-file-system" "40","scatterpie" "40","todoist" "40","scala-repl" "40","radmenu" "40","dsquery" "40","android-cast-api" "40","asp.net-caching" "40","ui-codemirror" "40","azure-spring-cloud" "40","gwt-jsinterop" "40","asp.net-core-mvc-2.1" "40","refinement-type" "40","hub" "40","dune" "40","meep" "40","android-multiple-users" "40","css-print" "40","properties.settings" "40","node-rest-client" "40","esri-arc-engine" "40","combres" "40","eulerr" "40","pg-cron" "40","ctp" "40","pytorch-forecasting" "40","spire.xls" "40","octopack" "40","http-post-vars" "40","exceed" "40","ohai-gem" "40","qdate" "40","excel-external-data" "40","pyxll" "40","logrus" "40","node.js-domains" "40","ctx" "40","android-lazyadapter" "40","stm32-hal" "40","google-diff-match-patch" "40","latexmk" "40","angular2-universal" "40","cfexecute" "40","logback-groovy" "40","hero" "40","idml" "40","webcodecs" "40","behavior-tree" "40","google-source-repositories" "40","heroku-redis" "40","flutter-layoutbuilder" "40","muc" "40","source-control-bindings" "40","params-keyword" "40","google-indoor-maps" "40","bcdedit" "40","ms-publisher" "40","spark-window-function" "40","asana-connect" "40","presentation-model" "40","as3crypto" "40","sdist" "40","glimmer.js" "40","staticlayout" "40","powerbuilder-pfc" "40","secrets" "40","git-refspec" "40","imagejpeg" "40","tfilestream" "40","shfb" "40","vaadin6" "40","compound-drawables" "40","stdformat" "40","pangram" "40","touch-up-inside" "40","ie-mobile" "40","panes" "40","tf-agent" "40","cypher-shell" "40","thick-client" "40","beatsmusic" "40","fluxor" "40","zend-application" "40","scriptable" "40","struts-html" "40","webconfigurationmanager" "40","predefined-macro" "40","gmagick" "40","static-allocation" "40","area-chart" "40","webformsmvp" "40","zend-form-sub-form" "40","automatic-storage" "40","lidar-data" "40","asianfonts" "40","user.config" "40","mscoco" "40","ms-clarity" "39","integration-patterns" "39","slack-bolt" "39","privilege-elevation" "39","anonymous-delegates" "39","flex-grow" "39","anonymous-struct" "39","yad" "39","cmis-workbench" "39","teradata-covalent" "39","bamboo-artifacts" "39","jbcrypt" "39","debezium-engine" "39","react-native-deep-linking" "39","clistview" "39","ecmascript-3" "39","flutter-facebook-login" "39","wds" "39","multitrigger" "39","rendering-engine" "39","gremlinnet" "39","getstaticpaths" "39","tensordot" "39","edmonds-karp" "39","mat-option" "39","apache-camel-k" "39","vuetify-tabs" "39","webstore" "39","instanceid" "39","ssh2-sftp-client" "39","mvxbind" "39","cljsbuild" "39","edid" "39","apache-camel-aws" "39","anydac" "39","ckasset" "39","deferred-shading" "39","backstop.js" "39","mat-expansion-panel" "39","vue-konva" "39","babel-plugin-react-css-modules" "39","webtestclient" "39","phpflickr" "39","backing-field" "39","phpdesigner" "39","react-router-native" "39","fbsdksharedialog" "39","ciscoconfparse" "39","yarnpkg-v3" "39","web-serial-api" "39","dcl" "39","whatsapp-flows" "39","insert-statement" "39","symbolic-execution" "39","mammoth" "39","binarystream" "39","nhibernate-configuration" "39","pairwise-distance" "39","unique-lock" "39","adler32" "39","jsonplaceholder" "39","swiftui-texteditor" "39","apache-spark-2.3" "39","xjb" "39","snap7" "39","mapmyindia-api" "39","unificationengine" "39","function-attributes" "39","ngx-cookie-service" "39","pik" "39","jsonix" "39","jsoniq" "39","sw-toolbox" "39","soffice" "39","python-holidays" "39","xml-import" "39","platform-tools" "39","sem" "39","xmodem" "39","apollo-ios" "39","content-pipeline" "39","play-authenticate" "39","adhoc-queries" "39","laravel-eloquent-resource" "39","jstree-search" "39","fsharp.data.typeproviders" "39","ngx-graph" "39","runnable-jar" "39","datavisualization.toolkit" "39","jstl-functions" "39","discord-interactions" "39","blaze-persistence" "39","chef-zero" "39","operational-transform" "39","fastadapter" "39","cross-application" "39","serena" "39","ice40" "39","microsoft.extensions.logging" "39","value-provider" "39","method-dispatch" "39","awaitility" "39","simplejdbccall" "39","winbugs14" "39","ibtool" "39","airpush" "39","djinni" "39","mysql-error-1292" "39","docsify" "39","sip-servlet" "39","microsoft-copilot" "39","cs-script" "39","vcpu" "39","aws-app-mesh" "39","jnaerator" "39","dartz" "39","gorp" "39","docker-ce" "39","fauxton" "39","google-voice-search" "39","wcf-authentication" "39","windows-ribbon-framework" "39","psse" "39","react-static" "39","datagridviewbuttoncolumn" "39","ibexpert" "39","r-taskscheduler" "39","vdso" "39","scalajs-bundler" "39","boost-bimap" "39","scalafmt" "39","jquery-focusout" "39","jquery-1.3" "39","swagger-node-express" "39","demangler" "39","errorformat" "39","errorplacement" "39","wptoolkit" "39","interface-orientation" "39","swift-macro" "39","desktop.ini" "39","intersystems-ensemble" "39","horizontal-pager" "39","angr" "39","blocked-threads" "39","dvd-burning" "39","open-gauss" "39","android-viewtreeobserver" "39","blender-2.67" "39","ios10.2" "39","nsbox" "39","kafka-cluster" "39","wsgiref" "39","tvos10" "39","androidsvg" "39","writexml" "39","salesforce-einstein" "39","svg-path" "39","sap-smart-forms" "39","apple-news" "39","kdc" "39","dynamic-island" "39","nsstoryboard" "39","ion-koush" "39","jquery-slide-effects" "39","apsw" "39","supersonic" "39","pyexiv2" "39","tzdata" "39","raymarching" "39","java-access-bridge" "39","68hc11" "39","pynotify" "39","output-window" "39","system2" "39","360-panorama-viewer" "39","razzle" "39","foundationdb" "39","android-api-31" "39","udpipe" "39","java-runtime-compiler" "39","type-projection" "39","ko-custom-binding" "39","gomoku" "39","goliath" "39","uglifier" "39","vite-reactjs" "39","typemaps" "39","rawcontacts" "39","pysimplesoap" "39","ucd" "39","lib-jitsi-meet" "39","google-ajax-api" "39","ext-direct" "39","pygame-tick" "39","shimmer" "39","jasmine-reporters" "39","oclif" "39","orientdb-etl" "39","visual-studio-setup" "39","build-helper-maven-plugin" "39","code-search-engine" "39","form-with" "39","pymacs" "39","facebook-conversions-api" "39","pyspider" "39","formsflow.ai" "39","randoop" "39","retina.js" "39","plperl" "39","sqlline" "39","jakarta-validation" "39","regex-alternation" "39","tapir" "39","nopcommerce-3.90" "39","talos" "39","mobilefirst-analytics" "39","x86-emulation" "39","sql-server-2012-localdb" "39","exploded" "39","mocha-webpack" "39","jake" "39","azure-migrate" "39","scrap-your-boilerplate" "39","hippomocks" "39","c++-loki" "39","hol" "39","uipickerviewdelegate" "39","tagged-templates" "39","home-screen-widget" "39","cordova-plugin-camera" "39","tokumx" "39","drive-mapping" "39","pointer-conversion" "39","regex-look-ahead" "39","asp.net-validators" "39","c#-12.0" "39","c++builder-5" "39","digicert" "39","android-crop" "39","ask-cli" "39","register-globals" "39","tkx" "39","executable-path" "39","express.io" "39","rails-cells" "39","gambit" "39","mkuserlocation" "39","handhelddevice" "39","xcode3to4" "39","no-framework" "39","j9" "39","android-gpuimageview" "39","ipfs-http-client" "39","elementname" "39","iron-ajax" "39","acceptance" "39","accessorytype" "39","pechkin" "39","google-genomics" "39","ipcmain" "39","offsetheight" "39","textacy" "39","restframeworkmongoengine" "39","geor" "39","angular6-json-schema-form" "39","laravel-paginate" "39","responsibility" "39","perlmagick" "39","android-multiselectlistpreference" "39","lossy-compression" "39","cgcolorspace" "39","property-wrapper-published" "39","python-zappa" "39","android-ndk-r7" "39","mox" "39","android-jetpack-compose-preview" "39","textout" "39","textrenderer" "39","dunitx" "39","getlatest" "39","hyperbolic-function" "39","geofence" "39","com-object" "39","mergeinfo" "39","petl" "39","strict-weak-ordering" "39","spquery" "39","sports-league-scheduling-problem" "39","sprache" "39","stretched" "39","mortar" "39","pandora" "39","mqueue" "39","iics-di" "39","multilingual-app-toolkit" "39","passcode" "39","qt5.12" "39","secret-manager" "39","stay-logged-in" "39","bazel-aspect" "39","concurrentskiplistmap" "39","totality" "39","webassets" "39","script-debugging" "39","gldrawarrays" "39","componentart" "39","heyzap" "39","git-notes" "39","alipay" "39","zebble" "39","flutter-ui" "39","ihttpasynchandler" "39","arena-simulation" "39","font-embedding" "39","static-factory" "39","identifiable" "39","urlmon" "39","cxxtest" "39","compiz" "39","tfsintegrationplatform" "39","uses-feature" "39","webcrypto" "39","starknet" "39","mcsession" "39","here-olp" "39","seedstack" "39","flutter-pub" "39","thread-state" "38","ecmascript-2018" "38","material-icons" "38","fedext" "38","transitivity" "38","greenmail" "38","yetanotherforum" "38","flutter-card" "38","remote-process" "38","flutter-column" "38","class-structure" "38","react-native-draggable-flatlist" "38","printthis" "38","jetpack-compose-modalbottomsheet" "38","wice-grid" "38","jet-ef-provider" "38","litho" "38","default-constraint" "38","file-moving" "38","ssis-2014" "38","litjson" "38","graphserviceclient" "38","priority-web-sdk" "38","tso" "38","cloud-security" "38","react-share" "38","instance-eval" "38","materialpageroute" "38","private-network-access" "38","xrmtoolbox" "38","weak-typing" "38","jaxbelement" "38","photoviewer" "38","phptal" "38","webpack-production" "38","close-application" "38","reportparameter" "38","cmock" "38","pgmpy" "38","tell" "38","github-api-v4" "38","renderui" "38","yaf" "38","srs" "38","feasibility" "38","vsm" "38","cmdline-args" "38","bash-function" "38","gfx" "38","function-literal" "38","fisher-yates-shuffle" "38","apimonitor" "38","birt-emitter" "38","caspol" "38","xml-database" "38","xmpphp" "38","functional-api" "38","symfony-dependency-injection" "38","swt-awt" "38","pa11y" "38","add-action" "38","voip-android" "38","aem-touch-ui" "38","owned-types" "38","swiftui-zstack" "38","connection-close" "38","addattribute" "38","von-neumann" "38","fuelcms" "38","python-keyboard" "38","appcelerator-arrow" "38","django-bootstrap4" "38","safari6" "38","directquery" "38","c-header" "38","imasdk" "38","snowpark" "38","frozen-columns" "38","ngmocke2e" "38","managementeventwatcher" "38","umijs" "38","datatableadapters" "38","datascroller" "38","palm-os" "38","nexus-10" "38","vsinstaller" "38","fstat" "38","snk" "38","const-pointer" "38","apache-shindig" "38","pigpio" "38","filestack" "38","langchain-agents" "38","go-sqlite3" "38","aws-copilot" "38","record-count" "38","rsconnect" "38","albacore" "38","py-appscript" "38","candeactivate" "38","gquery" "38","pureftpd" "38","cross-build" "38","dml-lang" "38","unnotificationtrigger" "38","cross-thread" "38","r-modis" "38","docker-ingress" "38","reality-composer-pro" "38","siri-remote" "38","routedata" "38","angular-material-8" "38","robohelp" "38","round-slider" "38","vuexfire" "38","rook-storage" "38","ruboto" "38","velocity-template-language" "38","opsgenie" "38","servicepacks" "38","django-ninja" "38","windows-server-2008-x64" "38","fbdialogs" "38","docker-layer" "38","ahah" "38","ais" "38","django-multilingual" "38","optparse-applicative" "38","grails-spring-security" "38","icedtea" "38","erlide" "38","katharsis" "38","mongodb-geospatial" "38","spring-kotlin" "38","botnet" "38","spring-rsocket" "38","nsight-compute" "38","nsapplescript" "38","gtid" "38","android-studio-3.1.3" "38","hosted-blazor-webassembly" "38","cpanel-xmlapi" "38","scadalts" "38","horovod" "38","entity-framework-extensions" "38","appirater" "38","mod-plsql" "38","interlacing" "38","appindicator" "38","kal" "38","pdf2htmlex" "38","tuespechkin" "38","html5-apps" "38","bluemix-app-scan" "38","delegatinghandler" "38","tuareg" "38","worklight-console" "38","salesforce-development" "38","moengage" "38","epublib" "38","initialization-order" "38","jquery-mobile-flipswitch" "38","onpremises-gateway" "38","anemone" "38","bqplot" "38","sasm" "38","kotlin-script" "38","visualgdb" "38","virtual-table" "38","jasmine-maven-plugin" "38","audioflinger" "38","outlook-filter" "38","async-hooks" "38","set-analysis" "38","windrose" "38","visual-programming" "38","facebook-business-manager" "38","system.transactions" "38","raygun" "38","3d.io" "38","setx" "38","pyro4" "38","setimmediate" "38","kleisli" "38","system.io.packaging" "38","signedness" "38","brew-framework" "38","bridging" "38","atomic-design" "38","formula-editor" "38","3270" "38","express-stormpath" "38","object-relationships" "38","uds" "38","buildaction" "38","objectbrowser" "38","liberator" "38","vim-registers" "38","letrec" "38","ubuntu-24.04" "38",".git-folder" "38","pykd" "38","system-codedom-compiler" "38","obspy" "38","vimgrep" "38","shopp" "38","abperson" "38","java2wsdl" "38","r-daisy" "38","mail-gem" "38","c2hs" "38","express-fileupload" "38","bulk-delete" "38","titanium-sdk" "38","hoogle" "38","pljava" "38","tag-soup" "38","business-connector" "38","scratchpad" "38","xades" "38","moby" "38","gaia" "38","xcode6gm" "38","reducing" "38","timespec" "38","exception-notification" "38","playscape" "38","contract-first" "38","dotnet-build" "38","qwraps2" "38","notify-send" "38","openrdf" "38","wymeditor" "38","direct3d10" "38","tagged-corpus" "38","taocp" "38","tagbuilder" "38","redistimeseries" "38","nsxmlelement" "38","uicontextualaction" "38","uicollisionbehavior" "38","sql-server-2019-express" "38","homotopy-type-theory" "38","tinkercad" "38","rabbitmq-c" "38","download-speed" "38","gatttool" "38","android-device-manager" "38","gem-bundler" "38","mobile-center" "38","xcode-scheme" "38","c++-actor-framework" "38","opensplice" "38","tdictionary" "38","openstack-glance" "38","redmon" "38","game-automation" "38","excel.application" "38","cusp-library" "38","escape-analysis" "38","text-rotation" "38","tomcat-manager" "38","perforce-branch-spec" "38","loggerfactory" "38","colormatrixfilter" "38","prophecy" "38","qbo3" "38","node-java" "38","restbed" "38","laterjs" "38","mpir" "38","georss" "38","android-job" "38","android-jetpack-compose-scaffold" "38","office365-rest-client" "38","nintendo-ds" "38","node-forge" "38","acl2" "38","string.xml" "38","responsys" "38","proof-general" "38","android-maps-extensions" "38","tone-analyzer" "38","angular-cache" "38","google-datatable" "38","resolution-independence" "38","ejml" "38","cgdb" "38","ejb-jar.xml" "38","search-guard" "38","searchkit" "38","textx" "38","webkit-animation" "38","ariadne-graphql" "38","urxvt" "38","zend-optimizer" "38","security-warning" "38","autocad-scripts" "38","usb-descriptor" "38","zeit-pkg" "38","tibco-designer" "38","to-timestamp" "38","zeek" "38","user-defined-aggregate" "38","idref" "38","powervr-sgx" "38","spark-launcher" "38","presentationml" "38","imageflow" "38","subapplication" "38","subcommand" "38","emacs-semantic" "38","parameter-sets" "38","linq-to-json" "38","pass-by-rvalue-reference" "38","scrutinizer" "38","sea-orm" "38","qsizepolicy" "38","focusin" "38","google-ranking" "38","mediabrowserservice" "38","quarkus-qute" "38","maven-jib" "38","custom-url-protocol" "38","d3dimage" "38","pardiso" "38","flutter-run" "38","alignas" "38","scrollreveal.js" "38","maven-nar-plugin" "37","phpdebugbar" "37","pg-stat-statements" "37","multiple-assignment" "37","ddmathparser" "37","live-cd" "37","proactive" "37","flexibility" "37","react-navigation-top-tabs" "37","tsify" "37","flightphp" "37","multiple-login" "37","babel-eslint" "37","processlist" "37","multivalue-database" "37","ts-morph" "37","flup" "37","debconf" "37","ggimage" "37","srp-protocol" "37","react-native-sentry" "37","cloo" "37","whatsapp-stickers" "37","skcameranode" "37","squirrelmail" "37","cmake-presets" "37","sqslistener" "37","intellicode" "37","baml" "37","dbms-metadata" "37","liquid-haskell" "37","git-fsck" "37","skadnetwork" "37","git-daemon" "37","flutter-ffmpeg" "37","tensorboardx" "37","flutter-downloader" "37","material-design-icons" "37","remotipart" "37","wicket-tester" "37","cockpit" "37","sizetocontent" "37","phpgrid" "37","flex-charting" "37","clojureclr" "37","slidy" "37","transmitfile" "37","slidesjs" "37","incremental-load" "37","ngcloak" "37","after-create" "37","kubernetes-hpa" "37","mail-queue" "37","fscrawler" "37","biztalk-pipelines" "37","smf-forum" "37","switchyard" "37","unapply" "37","inboxsdk" "37","xgbregressor" "37","xmlsocket" "37","fsolve" "37","pythonbrew" "37","voldemort" "37","child-fragment" "37","swiftpm" "37","semi-join" "37","confluence-macros" "37","snap-in" "37","jsr296" "37","laravel-components" "37","ccspritebatchnode" "37","fiware-keyrock" "37","unified-memory" "37","nhibernate-cascade" "37","chimp.js" "37","dbcommand" "37","python-pdfreader" "37","binomial-heap" "37","django-4.1" "37","finite-difference" "37","findwindowex" "37","imgscalr" "37","sender-id" "37","paint.net" "37","frequency-table" "37","binary-bomb" "37","xdoc" "37","csi" "37","kepserverex" "37","aws-sdk-go-v2" "37","iced-coffeescript" "37","keyhook" "37","roxy-fileman" "37","dnode" "37","rpxnow" "37","upsetplot" "37","uploadifive" "37","canopy-web-testing" "37","pudb" "37","kie-wb" "37","aviarc" "37","jfxpanel" "37","data-corruption" "37","sequence-analysis" "37","servletconfig" "37","serialscroll" "37","icicles" "37","kiba-etl" "37","fanotify" "37","ruby-block" "37","dmesg" "37","databricks-rest-api" "37","optimizer-hints" "37","ibm-cloud-code-engine" "37","dash-leaflet" "37","hyperledger-fabric-sdk-java" "37","rmongo" "37","camel-test" "37","aws-directory-services" "37","joyent" "37","fastclick.js" "37","sitebricks" "37","camel-jms" "37","django-smart-selects" "37","criteriabuilder" "37","aws-iot-analytics" "37","session-state-provider" "37","roundhouse" "37","inetd" "37","grand-theft-auto" "37","django-leaflet" "37","jfrog-mission-control" "37","angular-migration" "37","rspec-expectations" "37","aws-cloudmap" "37","angular-material-theming" "37","angular-xeditable" "37","bootstrap-wysihtml5" "37","blessed" "37","in-memory-tables" "37","jquery-query-builder" "37","svgkit" "37","navigation-compose" "37","post-update" "37","gtktextview" "37","sane" "37","nsconnection" "37","support-v4" "37","wsman" "37","corflags" "37","hotplugging" "37","correlated" "37","jquery-dropkick" "37","gud" "37","dynamic-code" "37","type-annotation" "37","inline-variable" "37","twemproxy" "37","samplegrabber" "37","ean-13" "37","wpf-positioning" "37","nsfilecoordinator" "37","pathtoolongexception" "37","enterframeevent" "37","gtkd" "37","aws-transfer-family" "37","azure-analytics" "37","correspondence-analysis" "37","episerver-6-r2" "37","erlangweb" "37","bluetooth-printing" "37","bootstrap-treeview" "37","cpu-load" "37","nclob" "37","bmi" "37","position-dodge" "37","swift-data-relationship" "37","boost-smart-ptr" "37","coursier" "37","boost-tokenizer" "37","portable-areas" "37","html-formhandler" "37","dynamicpdf" "37","grpcio" "37","simbl" "37","cra" "37","html.hiddenfor" "37","input-language" "37","internal-link" "37","infinite-carousel" "37","jquery.repeater" "37","oneway" "37","jansson" "37","typescript2.4" "37","vincent" "37","outerheight" "37","least-common-ancestor" "37","viewrendering" "37","astroquery" "37","magicalrecord-2.2" "37","facebook-graph-api-v2.3" "37","3d-texture" "37","libfreenect2" "37","libfuzzer" "37","exrm" "37","aurelia-dialog" "37","visual-testing" "37","browsable" "37","magic-string" "37","goinstant" "37","libman" "37","systemmodeler" "37","shopt" "37","output-caching" "37","jaunt-api" "37","typed-factory-facility" "37","shotgun" "37","ancs" "37","outputdebugstring" "37","7-bit" "37","mip-sdk" "37","letters-and-numbers" "37","pyfacebook" "37","uat" "37","wolkenkit" "37","nvm-windows" "37","ory" "37","pysyft" "37","jawr" "37","rdfstore" "37","asp.net-customcontrol" "37","azure-managed-database" "37","sqlalchemy-utils" "37","plug-and-play" "37","jacl" "37","notorm" "37","gumstix" "37","gumbo" "37","nodiscard" "37","vertex-ai-search" "37","open-graph-beta" "37","noreturn" "37","spsite" "37","tokio-postgres" "37","normalizing" "37","geneos" "37","scala-streams" "37","nstrackingarea" "37","j2ssh" "37","gaussian-mixture-model" "37","hmatrix" "37","c++builder-10-seattle" "37","tlabel" "37","isight" "37","dimension-reduction" "37","uikit-state-preservation" "37","bundle-layout" "37","openstruct" "37","dotnetnuke-8" "37","ragged-tensors" "37","histplot" "37","pointcuts" "37","mod-autoindex" "37","asp.net-4.6" "37","poeaa" "37","registering" "37","directcast" "37","uiprintpagerenderer" "37","exception-logging" "37","azure-private-dns-zone" "37","mkplacemark" "37","qquickview" "37","getderivedstatefromprops" "37","perfino" "37","cffunction" "37","cfdata" "37","spectrumjs" "37","mousetrap" "37","mousekeyhook" "37","charm-crypto" "37","perfecto" "37","text-generation" "37","memory-visibility" "37","char16-t" "37","angular2-google-maps" "37","react-leaflet-v4" "37","zumero" "37","httpful" "37","lstlisting" "37","odo" "37","google-cloud-transcoder" "37","access-rules" "37","resuming-training" "37","ios3.0" "37","excel4node" "37","eruby" "37","cephfs" "37","text-chunking" "37","acts-as-tenant" "37","google-cloud-dataproc-serverless" "37","persistent-data" "37","memcachedb" "37","qpalette" "37","log4jdbc" "37","stream-cipher" "37","messageid" "37","stochastic-gradient" "37","custom-operator" "37","storage-file-share" "37","google-codelab" "37","elasticsearch-spark" "37","texstudio" "37","com-interface" "37","maven-toolchains-plugin" "37","usb-hostcontroller" "37","iis-express-10" "37","begincollectionitem" "37","tracepoint" "37","avassetwriterinput" "37","tikzdevice" "37","lightmode" "37","shell-namespace-extension" "37","queueuserworkitem" "37","bfo" "37","mu-law" "37","availability-group" "37","qstatusbar" "37","qstringlist" "37","youtube-player-flutter" "37","pressable" "37","webdriver-io-v4" "37","scriptbundle" "37","mediafire" "37","emqx" "37","query-designer" "37","help-system" "37","idris2" "37","armbian" "37","automapper-10" "37","pg-jdbc" "37","maven-exec-plugin" "37","end-user" "37","weatherkit" "37","text-width" "37","spack" "37","solr-search" "37","hfile" "37","amazon-ivs" "37","amazon-forecast" "37","webbroker" "37","zerofill" "37","gitx" "37","secretsmanager" "37","usefetch" "37","powershell-sdk" "37","webob" "37","cyk" "37","arrayiterator" "37","gmailr" "37","threecsg" "37","limiting" "37","subject-alternative-name" "37","flutter-linux" "37","image-effects" "37","glibmm" "36","tensor2tensor" "36","figsize" "36","base-path" "36","react-server" "36","cisco-jtapi" "36","editview" "36","templatetag" "36","tree-nodes" "36","telosys" "36","ansi-sql-92" "36","anychart-8.2" "36","phped" "36","react-native-picker-select" "36","git-history-graph" "36","jetty-12" "36","insert-image" "36","instasharp" "36","instruction-reordering" "36","insertion-order" "36","ss" "36","insertonsubmit" "36","ssms-18" "36","edge-tpu" "36","mvcroutehandler" "36","primeng-dialog" "36","yagmail" "36","reporting-services-2016" "36","mat-icon" "36","match-types" "36","slapd" "36","telerik-charting" "36","ansible-collections" "36","backbone-stickit" "36","renderdoc" "36","rendercontrol" "36","mathlink" "36","fluid-images" "36","cleaned-data" "36","xslf" "36","release-notes" "36","flutter-datatable" "36","gravitee" "36","flutter-circularprogressindicator" "36","groovydoc" "36","vtk.js" "36","little-proxy" "36","eclipse-rse" "36","phpstorm-2018.1" "36","imagemagick-identify" "36","jsr75" "36","ladder-logic" "36","jsr305" "36","imagemagick-montage" "36","smart-mobile-studio" "36","imageshack" "36","fuzzer" "36","softirq" "36","swup" "36","rusqlite" "36","dbg" "36","kubernetes-namespace" "36","future-proof" "36","datastax-node-driver" "36","python-docker" "36","cinterop" "36","ngdoc" "36","displayformat" "36","pin-code" "36","circom" "36","semantic-logging" "36","sendbeacon" "36","biztalk-bam" "36","xero" "36","umfpack" "36","xmlencoder" "36","function-templates-overloading" "36","unify" "36","confirm-dialog" "36","first-class" "36","ng-filter" "36","apache-spark-2.2" "36","ftputil" "36","ngx-daterangepicker-material" "36","paginateddatatable" "36","makeappx" "36","constraint-kinds" "36","bitbucket-aws-code-deploy" "36","unfuddle" "36","pihole" "36","confuserex" "36","findinfiles" "36","pagerfanta" "36","facebook-php-webdriver" "36","grako" "36","ibm-cloud-kubernetes" "36","dlquery" "36","grapevine" "36","psr-1" "36","simplemde" "36","mysql-error-1067" "36","rubberduck" "36","optimistic" "36","validate-request" "36","metricsql" "36","ibm-app-connect" "36","fastlane-snapshot" "36","docker-repository" "36","cakephp-2.8" "36","optional-variables" "36","docker-tag" "36","myst" "36","rowlex" "36","django-rest-framework-gis" "36","fancyimpute" "36","aggregate-filter" "36","roberta" "36","method-declaration" "36","data-caching" "36","mysql-odbc-connector" "36","update-all" "36","cryengine" "36","react-table-v8" "36","gpu-atomics" "36","gpu-constant-memory" "36","single-dispatch" "36","single-file" "36","series-40" "36","pry-rails" "36","cross-server" "36","windows-1251" "36","upload-max-filesize" "36","react-strictmode" "36","sinch-verification" "36","pubchem" "36","django-rosetta" "36","keyref" "36","aws-code-deploy-appspec" "36","wildfly-12" "36","rowheader" "36","realm-database" "36","animationcontroller" "36","unload" "36","nestjs-testing" "36","twilio-python" "36","wsdl2code" "36","spring-cloud-zookeeper" "36","tuner" "36","input-filter" "36","nba-api" "36","workflow-engine" "36","android-tiramisu" "36","dependency-tree" "36","desktop-wallpaper" "36","android-spannable" "36","gulp-replace" "36","boost-xpressive" "36","er-diagram" "36","eraser" "36","nsarchiving" "36","spring-cloud-gcp-bigquery" "36","cornerstonejs" "36","azure-blockchain-workbench" "36","pdf2swf" "36","hotswapagent" "36","ttml" "36","application-name" "36","defunct" "36","postgres.app" "36","worker-loader" "36","internal-compiler-error" "36","android-side-navigation" "36","bootstrap-studio" "36","neo4j-embedded" "36","post-quantum-cryptography" "36","app-lab" "36","errortemplate" "36","sap-ariba" "36","botdetect" "36","android-slider" "36","coreference-resolution" "36","coveo" "36","azure-bastion" "36","android-shell" "36","app-service-environment" "36","oat++" "36","windsor-3.0" "36","libserial" "36","fabric-beta" "36","android-activitymanager" "36","pyinvoke" "36","bucardo" "36","madexcept" "36","vitepress" "36","ordered-map" "36","system.addin" "36","lucene-highlighter" "36","facebook-app-center" "36","browser-bugs" "36","code-visualization" "36","shutter" "36","net-reactor" "36","krpano" "36","audio-video-sync" "36","rapidshare" "36","browserid" "36","setuptools-scm" "36","kr-c" "36","siena" "36","2.5d" "36","asyncdata" "36","object-diagram" "36","atg-droplet" "36","minimum-size" "36","go-iris" "36","amba" "36","konga" "36","vmalloc" "36","vmdk" "36","microstream" "36","rfc3161" "36","typescript-module-resolution" "36","android-1.5-cupcake" "36","extract-error-message" "36","shader-storage-buffer" "36","viewpropertyanimator" "36","osx-tiger" "36","pynamodb" "36","knopflerfish" "36","otl" "36","pymatgen" "36","braintree-rails" "36","asynchronous-wcf-call" "36","amp-img" "36","pyo" "36","networkit" "36","code-collaborator" "36","kleene-star" "36","pyjade" "36","mobileprovision" "36","npm-version" "36","nvidia-smi" "36","android-capture" "36","scoreloop" "36","itemeditor" "36","plr" "36","android-compose-layout" "36","iso-8859-2" "36","table-plus" "36","nuxt-strapi" "36","scalardb" "36","rackattack" "36","android-drm" "36","scope-chain" "36","dot-source" "36","scoop-installer" "36","drawingbrush" "36","gwt-tablayoutpanel" "36","tabletop.js" "36","controltemplates" "36","openoffice-impress" "36","hacker-news-api" "36","r2dbc-mysql" "36","xcarchive" "36","timing-attack" "36","nushell" "36","scalatags" "36","excel-reader" "36","buster.js" "36","gen-class" "36","itextg" "36","azure-vm-templates" "36","mknod" "36","iview" "36","azure-spring-boot" "36","time-precision" "36","sqlj" "36","nopcommerce-4.0" "36","gcc11" "36","c10k" "36","iwconfig" "36","gcloud-java" "36","gdrive" "36","geektool" "36","qfont" "36","google-container-optimized-os" "36","chardet" "36","activity-streams" "36","spin.js" "36","httperf" "36","android-jetpack-compose-animation" "36","react-image-crop" "36","httpbrowsercapabilities" "36","react-async" "36","httplistenerrequest" "36","cfengine" "36","zurb-foundation-apps" "36","android-mipmap" "36","moq-3" "36","terraform-provider-openstack" "36","cssnext" "36","spray-routing" "36","motoko" "36","react-native-contacts" "36","android-managed-profile" "36","tetrahedra" "36","stripe-tax" "36","activetcl" "36","meeting-request" "36","pyudev" "36","lua-c++-connection" "36","qlocalsocket" "36","laravel-translatable" "36","ios-library" "36","liferay-7.2" "36","parsoid" "36","cxf-xjc-plugin" "36","automatic-semicolon-insertion" "36","qsqlquerymodel" "36","aria-live" "36","qt-necessitas" "36","msvcr90.dll" "36","iidentity" "36","stat-density2d" "36","tgrid" "36","zebra" "36","amazon-mobile-hub" "36","partial-functions" "36","usercake" "36","premultiplied-alpha" "36","ytplayer" "36","gnu-sed" "36","amazon-kendra" "36","parse-framework" "36","zgc" "36","git-sparse-checkout" "36","msmessage" "36","sec" "36","space-partitioning" "36","zk-grid" "36","illegalmonitorstateexcep" "36","tortoisemerge" "36","config.json" "36","stdlaunder" "36","z-order-curve" "36","tightvnc" "36","mss" "36","webmachine" "36","for-else" "36","sonarqube-5.4" "36","shields.io" "36","hermes-jms" "36","alice-fixtures" "36","zend-locale" "36","asciimath" "36","allegro-cl" "36","enable-shared-from-this" "36","parallel.foreachasync" "36","mruby" "36","strtr" "36","idx" "36","stm32f3" "36","alphabetized" "36","hdrimages" "35","clrmd" "35","mvcgrid.net" "35","dcc32" "35","grit" "35","babun" "35","dbn" "35","phpcas" "35","badi" "35","yocto-wic" "35","ckeditor5-react" "35","ckeditor5-plugin" "35","yfiles" "35","ebook-reader" "35","clsql" "35","liquibase-maven-plugin" "35","render-to-response" "35","where-object" "35","trilinos" "35","xsb" "35","git-lfs-migrate" "35","getstate" "35","phpjs" "35","gitlab-autodevops" "35","remove-method" "35","flutter-drawer" "35","gitlab-7" "35","cleartext" "35","php-pthread" "35","listlabel" "35","standardjs" "35","xtensa" "35","graph-notebook" "35","little-o" "35","phpgraphlib" "35","process-monitor" "35","debezium-connect" "35","reprex" "35","reinforced-typings" "35","lmplot" "35","ggnetwork" "35","git-fast-import" "35","react-native-screens" "35","temboo" "35","ssis-2005" "35","ffdshow" "35","loadjava" "35","baidu-map" "35","sslerrorhandler" "35","antdv" "35","dat-protocol" "35","maphilight" "35","chipset" "35","vsdoc" "35","pallet" "35","pkill" "35","day-cq" "35","filesystem-access" "35","filestreams" "35","runkit" "35","next-connect" "35","nextpeer" "35","mapdeck" "35","jstorage" "35","apache-sedona" "35","kubernetes-container" "35","apache-pivot" "35","snomed-ct" "35","uivewcontroller" "35","r-usethis" "35","mariadb-connector-c" "35","incremental-search" "35","carmen" "35","vscode-problem-matcher" "35","jsonassert" "35","lanterna" "35","displot" "35","adaptive-icon" "35","ftplugin" "35","markermanager" "35","blackfire" "35","symbol-not-found" "35","apollo-gateway" "35","ozeki" "35","firepath" "35","smartsheet-api-1.1" "35","djangocms-text-ckeditor" "35","switchery" "35","ngx-editor" "35","jsonforms" "35","alchemy-cms" "35","dlq" "35","url-action" "35","prvalue" "35","valign" "35","vendors" "35","pyad" "35","reconciliation" "35","pulumi-azure" "35","simple-xml-converter" "35","ora-00923" "35","rogue-wave" "35","r-table" "35","rocket" "35","journey" "35","jqchart" "35","mysql4" "35","vapid" "35","microsoft-expression-web" "35","mymaps" "35","mysqladministrator" "35","faker.js" "35","ag-grid-validation" "35","rmaps" "35","pv" "35","root-node" "35","validationmessage" "35","nanopi" "35","database-dump" "35","grahams-scan" "35","camunda-plugin" "35","oracle-apex21.2" "35","dnspy" "35","camping" "35","n8n" "35","microsoft.ink" "35","ibm-information-server" "35","ajaxsubmit" "35","cakephp-2.9" "35","namespace-organisation" "35","datacontracts" "35","roaming-profile" "35","unmanagedexports" "35","sitecore-speak-ui" "35","wcf-discovery" "35","vcbuild" "35","django-two-factor-auth" "35","django-hvad" "35","rector" "35","optimal" "35","createoleobject" "35","crystal-reports-2016" "35","kentico-13" "35","android-sdk-1.6" "35","block-comments" "35","jquery-mobile-panel" "35","html-tree" "35","horizontalpodautoscaler" "35","aws-signature" "35","easy-auth" "35","postgres-12" "35","jquery.panzoom" "35","pdp-11" "35","jquery-ui-widget" "35","twincat-ads-.net" "35","epydoc" "35","jumi" "35","samsung-galaxy-watch-4" "35","nsinvocationoperation" "35","sarsa" "35","samsung-touchwiz" "35","ncl" "35","work-stealing" "35","gulp-connect" "35","corresponding-records" "35","inline-view" "35","infinidb" "35","azure-devops-deploymentgroups" "35","mod-vhost-alias" "35","sandbox-solution" "35","spring-expression-language" "35","negative-integer" "35","gs1-datamatrix" "35","jquery-textext" "35","kadena" "35","application.cfm" "35","inets" "35","path-traversal" "35","sasl-scram" "35","epollet" "35","appsflyer-android-sdk" "35","patreon" "35","winobjc" "35","reuters" "35","system.web.ui.webcontrols" "35","system-views" "35","form-parameter" "35","libsox" "35","pyez" "35","objectcache" "35","tableau-cloud" "35","typed-memory-views" "35","atlaskit" "35","kivy-recycleview" "35","viewchildren" "35","microsoft-skype-bot" "35","klein-mvc" "35","abnf" "35","domain-masking" "35","object-destruction" "35","google-business-profile-api" "35","abbr" "35","fabric8-maven-plugin" "35","rfc2898" "35","rancher-rke" "35","libsmbclient" "35","netcoreapp3.1" "35","word-diff" "35","abide" "35","pyshp" "35","ucfirst" "35","ocaml-batteries" "35","pykml" "35","android-afilechooser" "35","fr3dldapbundle" "35","sfnetwork" "35","vim-macros" "35","expresso-store" "35","foundry-contour" "35","minicom" "35","mineflayer" "35","visudo" "35","viper" "35","tablefooterview" "35","viper-mode" "35","rgee" "35","taskwarrior" "35","itemspanel" "35","uibuttonbaritem" "35","associated-value" "35","asp.net-mvc-futures" "35","noweb" "35","gatsby-plugin-mdx" "35","geant4" "35","exclusion-constraint" "35","gcdasyncudpsocket" "35","nv12-nv21" "35","android-custom-drawable" "35","azure-managed-app" "35","azure-sdk-js" "35","itemcontainergenerator" "35","wxstyledtextctrl" "35","hidden-characters" "35","quotas" "35","drop-shadow" "35","drb" "35","uifontdescriptor" "35","c51" "35","gdata-python-client" "35","dtcoretext" "35","galaxy-nexus" "35","mobius" "35","pl-i" "35","azure-load-testing" "35","dia-sdk" "35","taskstackbuilder" "35","pngcrush" "35","sql-authentication" "35","cordova-chrome-app" "35","nunittestadapter" "35","drupal-entities" "35","downshift" "35","redquerybuilder" "35","bulk-import" "35","android-guava" "35","taskdef" "35","scodec" "35","uinib" "35","tabu-search" "35","gwt-highcharts" "35","diffusers" "35","gcm-network-manager" "35","non-breaking-characters" "35","hamachi" "35","c++builder-11-alexandria" "35","mpmedialibrary" "35","qradar" "35","stock-data" "35","angularjs-google-maps" "35","geom-sf" "35","terraform-provider-ibm" "35","google-content-api" "35","laravel-reverb" "35","resumablejs" "35","on-clause" "35","persistent-object-store" "35","testimonials" "35","z-wave" "35","strictnullchecks" "35","zstandard" "35","tonejs" "35","hydra-core" "35","peekmessage" "35","split-screen-multitasking" "35","everscale" "35","mpesa" "35","lookupfield" "35","st-monad" "35","mercury-editor" "35","cumulative-line-chart" "35","dunn.test" "35","resharper-plugins" "35","event-id" "35","laravel-mongodb" "35","testcontext" "35","cgbitmapcontext" "35","changenotifier" "35","csv-write-stream" "35","ete3" "35","acceptbutton" "35","excel-2008" "35","layout-anchor" "35","ternary-tree" "35","node.js-client" "35","accesscontrolservice" "35","accessibility-insights" "35","generic-relations" "35","strong-named-key" "35","laravel-service-container" "35","ternary-search-tree" "35","custom-application" "35","pester-5" "35","nmcli" "35","beans-binding" "35","shfileoperation" "35","parking" "35","panzoom" "35","compress-archive" "35","emailrelay" "35","multi-agent-reinforcement-learning" "35","web-fragment" "35","uservoice" "35","parseui" "35","flutter-graphql" "35","basler" "35","parslet" "35","solarwinds-orion" "35","maxrequestlength" "35","fn" "35","quagga" "35","lintr" "35","subactivity" "35","amazon-managed-blockchain" "35","google-groups-settings" "35","thoughtworks-go" "35","conditional-split" "35","cxml-commercexml" "35","powerschool" "35","arm9" "35","suneditor" "35","webgrease" "35","zio-test" "35","armeria" "35","mediaplayback" "35","git-server" "35","msgrcv" "35","cvblobslib" "35","qtdeclarative" "35","mscomm32" "35","beginreceive" "35","zenoss" "35","security-by-obscurity" "35","scrollableresults" "35","theano.scan" "35","struts2-namespace" "35","ide-customization" "35","pppoe" "35","url-fragment" "34","clipspy" "34","website-deployment" "34","base62" "34","repositorylookupedit" "34","deduction-guide" "34","ghc-generics" "34","triangle-count" "34","tensorflow-agents" "34","whenever-capistrano" "34","default-document" "34","default-implementation" "34","transitionend" "34","backquote" "34","stable-marriage" "34","installaware" "34","default-programs" "34","trigraphs" "34","basicnamevaluepair" "34","dbms-crypto" "34","marvin-framework" "34","tss" "34","flinkml" "34","ansi-term" "34","yarn-v3" "34","clj-http" "34","flowdocumentscrollviewer" "34","wcsf" "34","local-shared-object" "34","skype4java" "34","dc.leaflet.js" "34","flow-scope" "34","flex-mojos" "34","eclipse-databinding" "34","multipart-mixed-replace" "34","fluent-security" "34","slickedit" "34","anr" "34","clock-synchronization" "34","fedora-27" "34","remote-forms" "34","fedena" "34","fieldlist" "34","liquid-xml" "34","smartassembly" "34","background-agent" "34","jenetics" "34","basil.js" "34","vraptor" "34","semantic-ui-css" "34","const-generics" "34","kubernetes-nodeport" "34","adfs2.1" "34","xmlexception" "34","adjacency-list-model" "34","snowpipe" "34","selectivizr" "34","select-into-outfile" "34","vob" "34","future-warning" "34","seldon" "34","firefox3.5" "34","lamar" "34","smooth-streaming-player" "34","fuelphp-orm" "34","lambda-architecture" "34","sentimentr" "34","xmlroot" "34","fuzzyfinder" "34","case-expression" "34","xml-schema-collection" "34","soapcore" "34","content-based-retrieval" "34","fxruby" "34","syncfusion-blazor" "34","chatkit" "34","firemonkey-style" "34","runtime-type" "34","sailfish-os" "34","runumap" "34","datatable.select" "34","python-3.1" "34","manipulate" "34","rust-piston" "34","indexed-properties" "34","discord4j" "34","independent-set" "34","imessagefilter" "34","rxjs7" "34","binary-deserialization" "34","swiftui-asyncimage" "34","indefinite" "34","apiman" "34","unaccent" "34","django-custom-field" "34","data-linking" "34","incapsula" "34","chilkat-email" "34","vercel-ai" "34","name-binding" "34","ruby-prof" "34","window-load" "34","microc" "34","shark" "34","angularjs-ng-value" "34","crosstable" "34","microsoft.data.sqlite" "34","facebook-send-api" "34","dataiku" "34","alexa-presentation-language" "34","sitecore-rocks" "34","methodexpression" "34","read-committed-snapshot" "34","ora-06502" "34","r-library" "34","djl" "34","opml" "34","jnr" "34","aws-elemental" "34","wincvs" "34","airbnb-js-styleguide" "34","read-host" "34","facenet" "34","session-0-isolation" "34","rtm" "34","django-subquery" "34","falcor-router" "34","ora-00918" "34","fay" "34","unity3d-ui" "34","variable-selection" "34","icustomtypedescriptor" "34","go-playground" "34","angular-template-variable" "34","gradle.properties" "34","meta-raspberrypi" "34","psqlodbc" "34","interlocked-increment" "34","axe" "34","springfox-boot-starter" "34","kaspersky" "34","spring-projections" "34","input-split" "34","ttnavigator" "34","kemal" "34","influx-line-protocol" "34","post-parameter" "34","entrypointnotfoundexcept" "34","appsync-apollo-client" "34","inner-exception" "34","braced-init-list" "34","informat" "34","simple.odata.client" "34","pax-runner" "34","grunt-cli" "34","boost-unit-test-framework" "34","dynamic-splash-screen" "34","jugglingdb" "34","nsdocumentcontroller" "34","pclose" "34","android-viewflipper" "34","postmates" "34","box2dlights" "34","aws-sdk-mock" "34","env-file" "34","jquery-ui-layout" "34","spring-data-redis-reactive" "34","android-studio-plugin" "34","naudio-framework" "34","workfusion" "34","navigation-architecture" "34","spring-data-neo4j-5" "34","spring-mobile" "34","supertab" "34","nspipe" "34","ionic-zip" "34","pbxproj" "34","svn-reintegrate" "34","spring-json" "34","deveco-studio" "34","http-accept-encoding" "34","boost-accumulators" "34","devel-cover" "34","android-style-tabhost" "34","coverity-prevent" "34","pbcopy" "34","magellan" "34","acceleratorkey" "34","sgi" "34","vim-fzf" "34","revisionable" "34","wixlib" "34","wordpress-3.5" "34","lenskit" "34","r-commander" "34","jaws-wordnet" "34","vin" "34","sfdx" "34","octetstring" "34","bug-tracker" "34","coderay" "34","pypng" "34","system.drawing.graphics" "34","rfacebook" "34","bsddb" "34","android-2.0-eclair" "34","typehandler" "34","richedit-control" "34","extender" "34","knife-solo" "34","javascript-scope" "34","javax.swing.timer" "34","type-synonyms" "34","amp-stories" "34","libgomp" "34","2-3-4-tree" "34","network-driver" "34","shingles" "34","ravendb-http" "34","windows-themes" "34","forward-engineer" "34","libigl" "34","brewmp" "34","visual-effects" "34","openvidu" "34","polymer-2.0" "34","excelquery" "34","diawi" "34","c++pmr" "34","gdbinit" "34","non-renewing-subscription" "34","xcode-extension" "34","hamming-numbers" "34","regioninfo" "34","non-termination" "34","rails-assets" "34","tagged-pdf" "34","npm-ci" "34","referrer-spam" "34","high-voltage" "34","pointycastle" "34","referenceequals" "34","null-propagation-operator" "34","drupal-field-collection" "34","nupic" "34","coovachilli" "34","pluto.jl" "34","itertools-groupby" "34","gcp-iam" "34","explicit-destructor-call" "34","asp.net-mvc-apiexplorer" "34","isaserver" "34","target-audience" "34","sql-server-2016-localdb" "34","openid4java" "34","nuxt-link" "34","timestep" "34","executionengineexception" "34","tagbar" "34","dryscrape" "34","gwr" "34","asset-sync" "34","version-compatibility" "34","asp.net-placeholder" "34","asp.net-spa" "34","h2o4gpu" "34","openlayers-7" "34","copywithzone" "34","monitoring-query-language" "34","elasticsearch-6.8" "34","large-scale" "34","rest-parameters" "34","one-class-classification" "34","geometric-mean" "34","ipxe" "34","spelevaluationexception" "34","chained-select" "34","monomorphism-restriction" "34","angular-di" "34","lockscreenwidget" "34","etcpasswd" "34","responsivevoice" "34","lptstr" "34","httpresponsecache" "34","lastaccesstime" "34","custom-button" "34","hwndhost" "34","ning" "34","custom-pipeline-component" "34","test-project" "34","spotify-docker-client" "34","active-hdl" "34","color-wheel" "34","ios-lifecycle" "34","hybridauthprovider" "34","httpinvoker" "34","android-palette" "34","protobufjs" "34","mozrepl" "34","requirements-management" "34","resume-upload" "34","certifi" "34","http-toolkit" "34","duende" "34","http-content-range" "34","activeqt" "34","requirejs-define" "34","angular2-upgrade" "34","huawei-iap" "34","angular2viewencapsulation" "34","nix-shell" "34","qfuture" "34","parametrize" "34","urlread" "34","custom-sections" "34","sharpcompress" "34","d2rq" "34","urlmappings.groovy" "34","struct.pack" "34","stargate" "34","elmish-wpf" "34","global-filter" "34","avalanche" "34","flutter-pubspec" "34","quay.io" "34","media-url" "34","msscriptcontrol" "34","shelving" "34","struct-member-alignment" "34","security-scoped-bookmarks" "34","stellar" "34","lightweight-processes" "34","scrollwheel" "34","email-threading" "34","haslayout" "34","autoflush" "34","sonarjs" "34","bass.dll" "34","uxtheme" "34","hasura-docker" "34","zkemkeeper" "34","zipstream" "34","mson" "34","touchablewithoutfeedback" "34","linkmovementmethod" "34","yuidoc" "34","mtkview" "34","msvcr100.dll" "34","quadratic-probing" "34","ember-table" "34","autonomy" "34","google-play-protect" "34","bed" "34","amazon-in-app-purchase" "34","queryinterface" "34","automatic-failover" "34","webimage" "34","prepareforreuse" "34","stateless-state-machine" "34","ardalis-cleanarchitecture" "34","user-acceptance-testing" "34","bigfloat" "34","user-object" "33","jcc" "33","bankers-rounding" "33","banana" "33","marten" "33","cloudflare-r2" "33","cloudrail" "33","wct" "33","jazzy" "33","cloudflare-apps" "33","phpmqtt" "33","php-cpp" "33","react-number-format" "33","baqend" "33","defaultnetworkcredentials" "33","gina" "33","treap" "33","stacking-context" "33","transit-gateway" "33","ggspatial" "33","stamen-maps" "33","graphlookup" "33","dedicated-hosting" "33","webscarab" "33","fdb" "33","xquery-3.1" "33","graphql-go" "33","wherehas" "33","edaplayground" "33","gettickcount" "33","smartcardio" "33","clean-css" "33","xsitype" "33","why3" "33","decentralized-identity" "33","fedora16" "33","anonymous-access" "33","eclipse-orion" "33","relplot" "33","interface-design" "33","fluentwait" "33","multiple-apk" "33","v-slot" "33","jffs2" "33","privatefontcollection" "33","matlab-hg2" "33","flotr2" "33","base-tag" "33","ecies" "33","multipoint" "33","vuejs-transition" "33","yap" "33","vuejs3-composition-api" "33","printf-debugging" "33","vue-filter" "33","principalpermission" "33","jest-mock-axios" "33","field-description" "33","pg-query" "33","cmmi" "33","phimagemanager" "33","groovyws" "33","ebay-design-templates" "33","backbone-layout-manager" "33","fiftyone" "33","snap.js" "33","xml-publisher" "33","ng-bootstrap-modal" "33","apollo-link" "33","incremental" "33","nextuntil" "33","files-app" "33","config-spec" "33","apklib" "33","configuration-profile" "33","symfony-plugins" "33","labelfield" "33","cikernel" "33","apisauce" "33","pino" "33","xmlconvert" "33","language-packs" "33","adobe-flash-cs3" "33","imapi" "33","packer-builder" "33","apama" "33","manatee.trello" "33","jsf-1.1" "33","laravel-cache" "33","apache-stanbol" "33","direnv" "33","running-other-programs" "33","pinata" "33","admin-bro" "33","sage50" "33","cd-burning" "33","nginx-module" "33","sencha-touch-theming" "33","adrotator" "33","function-interposition" "33","safari-push-notifications" "33","jsr168" "33","distro" "33","discrete-optimization" "33","plai" "33","sendy" "33","platform-sdk" "33","ng-multiselect-dropdown" "33","marble" "33","free-variable" "33","disco" "33","soaphttpclientprotocol" "33","ngrx-selectors" "33","fslab" "33","advising-functions" "33","adhoc-polymorphism" "33","cakephp-3.8" "33","django-webpack-loader" "33","ajaxmin" "33","unreal-umg" "33","rollup-plugin-postcss" "33","jpopup" "33","wcf-data-services-client" "33","rowdetails" "33","rollover-effect" "33","angular-new-router" "33","djgpp" "33","djvu" "33","mysql-connector-c" "33","dnlib" "33","fastsearch" "33","root.plist" "33","rpx" "33","wcf-behaviour" "33","sipp" "33","ruby-jmeter" "33","mysql-loadfile" "33","ora-12154" "33","rr" "33","akka-grpc" "33","windows-mobile-gps" "33","vector-icons" "33","aws-api-gateway-v2" "33","unix-text-processing" "33","aws-rest-api" "33","red5pro" "33","ps4" "33","agentset" "33","avm2" "33","aws-chatbot" "33","ibp-vscode-extension" "33","docc" "33","recordreader" "33","doccano" "33","datadude" "33","wash-out" "33","ibm-sterling" "33","unparseable" "33","jhat" "33","canonical-quickly" "33","document-view" "33","angular-material-15" "33","microsoft.identity.web" "33","oracle-apex-20.1" "33","pybliometrics" "33","ropemacs" "33","windowsbuilder" "33","optim" "33","urdf" "33","microsoft-appstudio" "33","jhbuild" "33","servicepoint" "33","covariogram" "33","nsbrowser" "33","epipe" "33","pose-detection" "33","ncr" "33","epicor" "33","superscrollorama" "33","android-scripting" "33","entryset" "33","boilerplatejs" "33","android-vitals" "33","enterprise-web-library" "33","svn-propset" "33","ionic2-select" "33","kaazing" "33","aranchor" "33","sap-query" "33","nrules" "33","sanctuary" "33","gulp-clean-css" "33","openbd" "33","ttx-fonttools" "33","swift5.7" "33","twincat-hmi" "33","inner-product" "33","html-treebuilder" "33","nsprogress" "33","wso2-cloud" "33","devanagari" "33","boost-pool" "33","nativescript-firebase" "33","pchar" "33","boost-property-map" "33","gsmcomm" "33","kdf" "33","sbt-release" "33","gs-installable-triggers" "33","jquery-dirtyforms" "33","blazored" "33","mongojack" "33","sbt-android-plugin" "33","dynamics-nav-2013" "33","postico" "33","aztec-barcode" "33","bootstrap-file-upload" "33","dynamic-attributes" "33","gtm-oauth2" "33","azure-autoscaling-block" "33","dynamics-nav-2016" "33","bootstrap-file-input" "33","wordpress-theme-astra" "33","html-title" "33","spring-security-6" "33","turnkeylinux.org" "33","azure-adf" "33","buckminster" "33","brat" "33","osgearth" "33","raster-graphics" "33","donut-caching" "33","org-table" "33","orange-api" "33","lwm2m" "33","ubuntu-touch" "33","over-clause" "33","extensible-storage-engine" "33","google-calendar-recurring-events" "33","windowsversion" "33","abstractuser" "33","learn-ruby-on-rails" "33","google-buzz" "33","abrecordref" "33","os.execl" "33","tabbed-interface" "33","wkb" "33","system-analysis" "33","androguard" "33","system-font" "33","magic-mirror" "33","fragmentstateadapter" "33","objective-c-nullability" "33","cocos2d-python" "33","machinist" "33","sidekiq-monitor" "33","1password" "33","system.commandline" "33","system.array" "33",".net-attributes" "33","rdbms-agnostic" "33","atompub" "33","3scale" "33","shape-recognition" "33","visifire" "33","videoquality" "33","pyreverse" "33","obr" "33","foundry-data-connection" "33","foundry-python-transform" "33","foxit-reader" "33","mixamo" "33","codeigniter-form-validation" "33","rb-appscript" "33","continued-fractions" "33","tizen-tv" "33","openvdb" "33","azure-oms" "33","polish-notation" "33","mleap" "33","hl7-cda" "33","scrabble" "33","c++builder-xe4" "33","cordovawebview" "33","sqldbtype" "33","business-layer" "33","xamarin.windows" "33","tmb" "33","bull.js" "33","cordova-nativestorage" "33","dramatiq" "33","control-array" "33","non-printable" "33","c#-record-type" "33","mobfox" "33","gcc3" "33","cachegrind" "33","tbl" "33","convertto-json" "33","excel-template" "33","gumby-framework" "33","exoplayer-media-item" "33","nullish-coalescing" "33","scalaxb" "33","device-management" "33","coolstorage" "33","sql2o" "33","ragdoll" "33","asp.net-core-testhost" "33","cachefactory" "33","uialertviewcontroller" "33","c4.5" "33","hocr" "33","numactl" "33","scaldi" "33","uiswipeactionsconfiguration" "33","openidm" "33","vfio" "33","holder.js" "33","tinymce-rails" "33","commitizen" "33","cstdint" "33","string-table" "33","colgroup" "33","oms" "33","cstringio" "33","collaborative-editing" "33","teststand" "33","perspectives" "33","move-uploaded-file" "33","generic-derivation" "33","nl-classifier" "33","ogg-theora" "33","lr1" "33","nimble" "33","elasticsearch-shield" "33","pest" "33","hug" "33","protect-from-forgery" "33","color-thief" "33","react-bootstrap4-modal" "33","qi" "33","laravel-route" "33","qnames" "33","commonj" "33","mesos-chronos" "33","angular.json" "33","offline-storage" "33","cfoutput" "33","mootools-more" "33","reactive-mongo-java" "33","ios13.3" "33","angular-config" "33","loopback-address" "33","gentics-mesh" "33","comp-3" "33","cubical-type-theory" "33","qcamera" "33","oft" "33","chargebee" "33","common-service-locator" "33","hugo-theme" "33","angular-chartist.js" "33","resolutions" "33","ipyvuetify" "33","alias-method" "33","bfd" "33","statistical-sampling" "33","tfs-2018" "33","mdbg" "33","tigergraph" "33","msbuild-15" "33","tibco-topic" "33","themedata" "33","secure-transport" "33","seam-conversation" "33","startup-error" "33","webmatrix-3" "33","amazon-gateway" "33","google-gsuite" "33","stddeque" "33","zabbix-custom-reports" "33","automerge" "33","hatch" "33","powershellget" "33","zero-initialization" "33","gmsplace" "33","confd" "33","tf2onnx" "33","mdac" "33","gmaven" "33","scroll-snap-points" "33","archiverjs" "33","concreteclass" "33","amazon-dynamodb-data-modeling" "33","ppx" "33","cvsnt" "33","mrtg" "33","autoplot" "33","webcontent" "33","glom" "33","asenumerable" "33","flutter-qrcode" "33","beast-websockets" "33","heremap-navigation" "33","d3heatmap" "33","touchdb" "33","concurrentmodificationexception" "33","componentlistener" "33","google-merchant-center" "33","compodoc" "33","dartdoc" "33","partial-mocks" "33","web3dart" "33","amazon-kinesis-agent" "33","arelle" "33","ashot" "33","multicastdelegate" "33","autossh" "33","weblog" "33","traceability" "33","flutter-table" "32","bandit-python" "32","backtrack-linux" "32","transitiondrawable" "32","editplus" "32","editpad" "32","mvchtmlstring" "32","staleobjectstate" "32","mvapich2" "32","php-code-coverage" "32","edeliver" "32","cloudberry" "32","getwritabledatabase" "32","phpize" "32","multiviews" "32","principal-components" "32","xsp4" "32","remix-ide" "32","flite" "32","flutter-add-to-app" "32","badparcelableexception" "32","live-sass-compiler" "32","multipolygons" "32","ts-node-dev" "32","tsdx" "32","yahoo-kafka-manager" "32","load-factor" "32","flow-framework" "32","react-pdf-viewer" "32","whoops" "32","file-link" "32","click-counting" "32","sitefinity-8" "32","ckreference" "32","debug-build" "32","graphql-flutter" "32","grgit" "32","siteorigin" "32","tempdir" "32","telecom-manager" "32","apache-beam-internals" "32","ansible-filter" "32","wddx" "32","dci" "32","client-templates" "32","declval" "32","graphql-python" "32","dbproj" "32","manageiq" "32","firefox-5" "32","pico-8" "32","p4java" "32","firebird-psql" "32","runpy" "32","casbin" "32","rum" "32","flamerobin" "32","soap-extension" "32","padre" "32","fingerprintjs2" "32","vorpal.js" "32","aes-ni" "32","catransform3drotate" "32","find-all-references" "32","ngrx-reducers" "32","uniroot" "32","uninstallstring" "32","separating-axis-theorem" "32","sentinelsat" "32","xerces2-j" "32","ads-api" "32","xdt" "32","cdata-drivers" "32","ngboilerplate" "32","semantic-kernel" "32","dbdatareader" "32","semaphore-ci" "32","semgrep" "32","swift-pythonkit" "32","child-actions" "32","fuel" "32","full-text-catalog" "32","importdata" "32","pixbuf" "32","jsr107" "32","checkvalidity" "32","constraintset" "32","laravel-backpack-5" "32","chronic" "32","imageresizer-diskcache" "32","jtemplate" "32","container-managed" "32","xpand" "32","json-web-signature" "32","symfony-eventdispatcher" "32","pubxml" "32","optimistic-ui" "32","variable-fonts" "32","caprover" "32","walmart-electrode" "32","vds" "32","recursionerror" "32","fast-endpoints" "32","dockeroperator" "32","ora-01427" "32","grails-config" "32","serilog-exceptions" "32","django-userena" "32","microsoft.ml" "32","data-access-object" "32","wiki-engine" "32","servicetestcase" "32","session-state-server" "32","dkpro-core" "32","angular-scenario" "32","dkms" "32","windeployqt" "32","pthread-barriers" "32","vb4android" "32","routelink" "32","pushbots" "32","pushd" "32","psapi" "32","upn" "32","myhdl" "32","iaccessible" "32","kendo-gantt" "32","datagridviewcomboboxcolumn" "32","microsoft-graph-booking" "32","windows-server-container" "32","valums-file-uploader" "32","docplexcloud" "32","ora-00600" "32","serverless-framework-step-functions" "32","gpytorch" "32","mysqlupgrade" "32","sequelize-auto" "32","pvclust" "32","inertial-navigation" "32","pseudo-streaming" "32","document-store" "32","carchive" "32","aws-appstream" "32","annotatedtimeline" "32","updown" "32","updatexml" "32","csharpscript" "32","keyguardlock" "32","documentum-dql" "32","uriencoding" "32","pspell" "32","windows-phone-7.8" "32","mysql-group-replication" "32","kentico-api" "32","inputconnection" "32","crashloopbackoff" "32","opencv3.2" "32","postgrex" "32","opcode-cache" "32","wrangler" "32","errbit" "32","infobip-api" "32","tun-tap" "32","tuple-relational-calculus" "32","jruby-java-interop" "32","delete-method" "32","bluedragon" "32","apple-vpp" "32","surveillance" "32","pdf-reactor" "32","boost-icl" "32","module-export" "32","nsepy" "32","salesforce-developer" "32","nsenumerator" "32","twisted.client" "32","bloc-test" "32","navgraph" "32","cpio" "32","twisted.conch" "32","nsapplication-delegate" "32","android-text-color" "32","boost-format" "32","nestjs-microservice" "32","invantive-control" "32","onnx-coreml" "32","word-spacing" "32","apple-m7" "32","jquery-transit" "32","groupwise" "32","openform" "32","dwoo" "32","android-scrollable-tabs" "32","nsattributedstringkey" "32","ueye" "32","out-gridview" "32","viewwithtag" "32","orchestra" "32","rgeo-shapefile" "32","table-footer" "32","abcpdf9" "32","vision-pro" "32","foscommentbundle" "32","migratordotnet" "32","rcc" "32","extended-choice-parameter" "32","legacy-app" "32","koin-scope" "32","windows-virtual-desktop" "32","syndicationfeed" "32","pyqtdeploy" "32","richtextarea" "32","extaudiofile" "32","lumen-5.3" "32","java-pair-rdd" "32","range-checking" "32","android-appshortcut" "32","browser-state" "32","typetoken" "32","pygears" "32","system.memory" "32","shinyalert" "32","1wire" "32","fabric8-kubernetes-client" "32","lunarvim" "32","shinytree" "32","3dcamera" "32","networkstatsmanager" "32","output-clause" "32","oam" "32","typolink" "32","kontakt.io" "32","newsequentialid" "32","javafx-webview" "32","viewmodelproviders" "32","visual-odometry" "32","async-profiler" "32","frameset-iframe" "32","codemirror-6" "32","wordpress-database" "32","google-business" "32","rewind" "32","razorpdf" "32","objectaid" "32","android-assetmanager" "32","facebook-actionscript-api" "32","gae-python27" "32","c++builder-xe6" "32","android-connectionservice" "32","hashalgorithm" "32","dreamspark" "32","numpy-stl" "32","nuke-build" "32","experience-editor" "32","scikit-multilearn" "32","asp.net-minimal-apis" "32","refactoring-databases" "32","nullability" "32","uikitformac" "32","nosuchfieldexception" "32","drupal-path-aliases" "32","azure-iot-suite" "32","devicepixelratio" "32","opengl-1.x" "32","openstack-keystone" "32","scnmaterial" "32","wx.textctrl" "32","exclude-constraint" "32","vgam" "32","iso9660" "32","sql-maven-plugin" "32","executiontimeout" "32","version-detection" "32","gedit-plugin" "32","scala-native" "32","uitableviewdiffabledatasource" "32","gcc-pedantic" "32","xcode4.1" "32","android-flavordimension" "32","notistack" "32","digit-separator" "32","qvalidator" "32","drawtobitmap" "32","dgml" "32","digital-assets-links" "32","uib" "32","drawinrect" "32","redhat-datavirt" "32","screen-grab" "32","uicollectionviewdelegateflowlayout" "32","numpy-dtype" "32","iscrollview" "32","dialing" "32","digital-compass" "32","redpanda" "32","mockk-verify" "32","duckduckgo" "32","activeview" "32","spreadsheet-excel-writer" "32","communicator" "32","community-server" "32","react-dropdown-tree-select" "32","google-cloud-http-load-balancer" "32","proxy-protocol" "32","monticello" "32","react-leaflet-draw" "32","speakerphone" "32","ioutils" "32","curve-25519" "32","activation-context-api" "32","escript" "32","e-ink" "32","combining-marks" "32","cuml" "32","google-compute-api" "32","combinatory-logic" "32","android-monkey" "32","peverify" "32","angular-arrays" "32","log-viewer" "32","test-first" "32","android-jetpack-compose-button" "32","ltk" "32","elixir-jason" "32","resource-adapter" "32","odometer" "32","zposition" "32","commandfield" "32","hypercube" "32","oidc-provider" "32","geopositioning" "32","geoplot" "32","angular-controlvalueaccessor" "32","angular2-inputs" "32","angular2-custom-pipes" "32","resource-monitor" "32","texinfo" "32","angular14upgrade" "32","terraform-state" "32","angulardraganddroplists" "32","prolog-metainterpreter" "32","memory-mapped-io" "32","perl-packager" "32","log-files" "32","monocle-scala" "32","logbook" "32","android-room-prepackageddatabase" "32","hwid" "32","storybook-addon-specifications" "32","commerce.js" "32","spider-chart" "32","android-jsinterface" "32","odbc-sql-server-driver" "32","geonear" "32","moniker" "32","requires" "32","qdomdocument" "32","stringbyevaluatingjavascr" "32","getcaretpos" "32","lazy-static" "32","sunrpc" "32","bazel-python" "32","webaddress" "32","iiif" "32","git-subrepo" "32","has-one-through" "32","hbm2java" "32","line-api" "32","berkeley-db-xml" "32","gldrawpixels" "32","heap-fragmentation" "32","quality-gate" "32","qscrollbar" "32","sorting-network" "32","flycapture" "32","flutter-scrollbar" "32","flutter-secure-storage" "32","webforms-routing" "32","licenses.licx" "32","gloox" "32","multihomed" "32","webkit2" "32","font-rendering" "32","glr" "32","pareto-optimality" "32","parrot" "32","compile-time-type-checking" "32","parse4cn1" "32","mtl-file" "32","tquery" "32","mtlbuffer" "32","amazon-fire-os" "32","argon" "32","transferable" "32","tps" "32","tileserver-gl" "32","subgurim-maps" "32","max-age" "32","automapper-9" "32","measureoverride" "32","scringo" "32","zend-loader" "32","uvloop" "32","securitycenter" "32","linux-security-module" "32","scrutor" "32","vaadin21" "32","darksky" "32","z-notation" "32","zephir" "32","zgrep" "32","searchfiltercollection" "32","if-none-match" "32","maven-invoker-plugin" "32","touchesended" "32","std-byte" "32","powerbuilder.net" "32","seafile-server" "31","defensive-copy" "31","eclipse-tptp" "31","graphcms" "31","deepequals" "31","basedon" "31","cloudsight" "31","matlabpool" "31","floatbuffer" "31","jboss-web" "31","flutter-clippath" "31","phpbrew" "31","instancecontextmode" "31","griddler" "31","grapheme" "31","eccodes" "31","ts-mockito" "31","graphene2" "31","yii-validation" "31","echo-server" "31","php-amqp" "31","multiparameter" "31","clockpicker" "31","flickable" "31","telerik-combobox" "31","repeating-linear-gradient" "31","groupme" "31","flutter-exception" "31","local-security-policy" "31","graphql.net" "31","trustedconnection" "31","sst" "31","relaxed-atomics" "31","gige-sdk" "31","phonegap-facebook-plugin" "31","getsockopt" "31","process-group" "31","fen" "31","edgedb" "31","eclipse-hawkbit" "31","react-native-keychain" "31","backbone-boilerplate" "31","jenv" "31","fluentautomation" "31","product-key" "31","liteide" "31","filenet-cpe" "31","phantom-wallet" "31","cloudera-cdp" "31","profile-provider" "31","telescope.nvim" "31","react-native-notifications" "31","react-native-nfc-manager" "31","livekit" "31","trinidad-gem" "31","sketching" "31","terminal-server" "31","fuser" "31","unchecked-conversion" "31","pikepdf" "31","xdv" "31","smartgwt-pro" "31","undeploy" "31","next-api" "31","chip-8" "31","ditto" "31","in-app-purchase-receipt" "31","celllist" "31","ccm" "31","flatfilereader" "31","unirx" "31","sentencepiece" "31","filtered-lookup" "31","cbutton" "31","x-facebook-platform" "31","contactus" "31","adobe-javascript" "31","fxg" "31","xpress-optimizer" "31","senti-wordnet" "31","python-server-pages" "31","findname" "31","fstar" "31","margin-left" "31","socketmobile" "31","finereader" "31","adobe-director" "31","binomial-theorem" "31","appcfg" "31","frontend-maven-plugin" "31","social-network-friendship" "31","blackduck" "31","apache-spark-1.4" "31","xpathdocument" "31","jsfunit" "31","bi-temporal" "31","firebase-assistant" "31","bixolon-printer" "31","jtcalendar" "31","soaplib" "31","xirsys" "31","pivot-without-aggregate" "31","checklist-model" "31","vshost.exe" "31","soap1.2" "31","jscoverage" "31","falco" "31","sitecore-azure" "31","sharepointadmin" "31","wcf-proxy" "31","sisense" "31","react-widgets" "31","fastcgi-mono-server" "31","microsoft-data-sqlclient" "31","grammar-kit" "31","gpy" "31","mysql-error-2013" "31","microsoft-cpp-unit-test" "31","gprbuild" "31","simplerepository" "31","react-virtuoso" "31","method-modifier" "31","ora-04091" "31","fastapiusers" "31","fastparse" "31","kissxml" "31","share-plus" "31","meteor-useraccounts" "31","gradientdrawable" "31","sharepoint-feature" "31","failed-to-load-viewstate" "31","aws-iam-identity-center" "31","agm-map" "31","css-houdini" "31","mydac" "31","css-import" "31","serverpod" "31","facebook-payments" "31","rlwrap" "31","push.js" "31","w3-css" "31","rubymotion-promotion" "31","django-runserver" "31","calendar-control" "31","dltk" "31","datakey" "31","mysql-dependent-subquery" "31","updateview" "31","validation-controls" "31","aio-mysql" "31","mysql-error-1025" "31","vuzix" "31","rkobjectmapping" "31","iconvertible" "31","pyaudioanalysis" "31","ruby-ffi" "31","camera-matrix" "31","windows-live-writer" "31","service-node-port-range" "31","angular-router-params" "31","watch-window" "31","ajax-forms" "31","awsdeploy" "31","cakephp3" "31","canonical-form" "31","average-precision" "31","creative-cloud" "31","aws-permissions" "31","ibm-jvm" "31","ajaxpro" "31","near-real-time" "31","saripaar" "31","jqwik" "31","ttphotoviewcontroller" "31","aws-security-hub" "31","jquery-delegate" "31","jwi" "31","apple-pencil" "31","cosm" "31","svg-android" "31","jqte" "31","juniper-network-connect" "31","sardine" "31","grunt-connect-proxy" "31","spring-ide" "31","nearley" "31","spring-integration-ip" "31","junitparams" "31","tv4" "31","gruff" "31","android-sound" "31","spring-security-cas" "31","jquery-ui-plugins" "31","information-gain" "31","cpd" "31","jquery-1.3.2" "31","android-things-console" "31","application-resource" "31","onscrollchanged" "31","inputscope" "31","boost-ptr-container" "31","boost-unordered" "31","cornice" "31","gulp-notify" "31","twilio-javascript" "31","nshttpcookiestorage" "31","kantu" "31","application-close" "31","spring-cloud-skipper" "31","nerdctl" "31","twofish" "31","password-autofill" "31","inputformatter" "31","input-history" "31","writealltext" "31","jruby-rack" "31","posh-ssh" "31","mod-proxy-html" "31","aqtime" "31","path-manipulation" "31","netwire" "31","oboe.js" "31","analytics-engine" "31","pynsist" "31","brooklyn" "31","video-ads" "31","least-privilege" "31","min3d" "31","oslo" "31","vix" "31","microsoft-oauth" "31","vifm" "31","3cx" "31","microsoft-runtime-library" "31","osmium" "31",".ico" "31","magic-constants" "31","google-analytics-data-api" "31","visibilitychange" "31","aura.js" "31","wit-ai" "31","rfc5322" "31","middleman-4" "31","viewresult" "31","short-circuit-evaluation" "31","system-monitoring" "31","nzsql" "31","shopify-javascript-buy-sdk" "31","rdiscount" "31","rbokeh" "31","bufferedstream" "31","set-include-path" "31","mirage" "31","kotlinx.coroutines.flow" "31","netscape" "31","libjson" "31","f#-async" "31","oracle-xml-publisher" "31","visual-web-gui" "31","pyhdf" "31","sysobjects" "31","ordered-test" "31","objectpool" "31","rhythmbox" "31",".net-core-publishsinglefile" "31","rhtml" "31","windsor-facilities" "31","express-rate-limit" "31","javascript-audio-api" "31","jar-with-dependencies" "31","azure-oauth" "31","radhtmlchart" "31","jak" "31","holoviz-panel" "31","aspwizard" "31","azure-sql-edge" "31","togaf" "31","jahia" "31","sccm-2007" "31","horizontal-accordion" "31","r7rs" "31","sql-calc-found-rows" "31","qwikjs" "31","uicontrolstate" "31","num-lock" "31","mkmaprect" "31","quicklaunch" "31","normalize-css" "31","xamarin.mobile" "31","non-maximum-suppression" "31","digital-analog-converter" "31","tclientsocket" "31","device-name" "31","devise-jwt" "31","isinrole" "31","devise-recoverable" "31","sql-revoke" "31","hierarchyviewer" "31","openrouteservice" "31","titled-border" "31","uiscene" "31","tinygo" "31","openiso8583.net" "31","scratch-file" "31","redisinsights" "31","baasbox" "31","tail-call" "31","hibernate-generic-dao" "31","controller-factory" "31","open-mobile-api" "31","android-os-handler" "31","colortransform" "31","protocol-buffers-3" "31","qpolygon" "31","resgen" "31","ejabberd-auth" "31","zsi" "31","cfdirectory" "31","lrs" "31","zsh-alias" "31","layoutmargins" "31","cewp" "31","residemenu" "31","android-obfuscation" "31","laspy" "31","http-status-code-411" "31","collator" "31","escrow" "31","com0com" "31","streamline" "31","resharper-6.1" "31","odftoolkit" "31","nifty-gui" "31","textsum" "31","memory-editing" "31","qcolor" "31","es5-compatiblity" "31","react-monaco-editor" "31","ios-targets" "31","mplab-x" "31","geneva-framework" "31","elcimagepickercontroller" "31","reachability-swift" "31","october-partial" "31","custom-paging" "31","android-multi-module" "31","persona" "31","pgbackrest" "31","ipp-protocol" "31","cgpdfcontext" "31","memberpress" "31","android-open-accessory" "31","pytmx" "31","mpf" "31","strictfp" "31","ios6.0" "31","ios-universal-framework" "31","reactivekit" "31","sp-msforeachdb" "31","zxing-js" "31","ios-web-app" "31","cgit" "31","google-data" "31","react-intersection-observer" "31","peek-pop" "31","e-token" "31","columnspan" "31","commission-junction" "31","qtwebview" "31","powerpoint-web-addins" "31","webforms-view-engine" "31","sony-lifelog-api" "31","user-mode-linux" "31","textutils" "31","zalgo" "31","energyplus" "31","end-to-end-encryption" "31","hawkular" "31","query-variables" "31","cwrsync" "31","sdo" "31","sort-object" "31","healthvault" "31","powerbuilder-conversion" "31","usb-hid" "31","cview" "31","gksudo" "31","bigcommerce-stencil-cli" "31","passenger-nginx" "31","has-scope" "31","fontawesome-4.4.0" "31","header-row" "31","sttp" "31","google-suggest" "31","emptydatatext" "31","mediarouter" "31","haskell-language-server" "31","structopt" "31","ms-project-server-2016" "31","composite-literals" "31","here-routing" "31","basis" "31","webclient.uploaddata" "31","heroku-pipelines" "31","iepngfix" "31","google-java-format" "31","torsocks" "31","heterogeneous-services" "31","flutter-scaffold" "31","vaadin22" "31","elysiajs" "31","mayanedms" "31","linguaplone" "31","linguijs" "31","thunderbird-webextensions" "31","multihead-attention" "31","linktext" "30","bart" "30","floating-point-comparison" "30","deep-diff" "30","ebay-lms" "30","react-simple-maps" "30","skia4delphi" "30","teradata-aster" "30","backbone-local-storage" "30","antlr2" "30","x-robots-tag" "30","phassetcollection" "30","vue-quill-editor" "30","loadmodule" "30","webspeed" "30","load-order" "30","multiton" "30","antora" "30","jemmy" "30","yii2-widget" "30","skaudionode" "30","tensorflow-quantum" "30","instance-method" "30","git-hash" "30","multiscaleimage" "30","vuejs-datepicker" "30","tri-state-logic" "30","intel-atom" "30","graphene-sqlalchemy" "30","fdopen" "30","phonegap-plugin-push" "30","graphical-interaction" "30","antv" "30","relative-locators" "30","ferret" "30","flowpanel" "30","vsprops" "30","tsfresh" "30","flowfile" "30","eclipse-microprofile-config" "30","efl" "30","efi" "30","grasp" "30","tsconfig.json" "30","flotr" "30","stackify" "30","slamdata" "30","privoxy" "30","reify" "30","fetched-property" "30","interactjs" "30","sql-server-linux" "30","liquidfun" "30","file-generation" "30","dcommit" "30","tropo" "30","clistbox" "30","gigaspaces" "30","slimv" "30","weak-events" "30","php-ml" "30","ssl-handshake" "30","xpathnodeiterator" "30","python-beautifultable" "30","kube-controller-manager" "30","piccolo" "30","senchatouch-2.4" "30","soft-hyphen" "30","c-ares" "30","ccw" "30","app-engine-patch" "30","safehandle" "30","sendgrid-api-v2" "30","vroom" "30","snoopy" "30","python-onvif" "30","swiftui-toolbar" "30","vote-up-buttons" "30","datazen-server" "30","fsharp.data.sqlclient" "30","causal-inference" "30","circular-permutations" "30","biojava" "30","jsmooth" "30","finite-state-automaton" "30","pagepiling.js" "30","mapael" "30","imaskjs" "30","manifest.cache" "30","flash-player-11" "30","unity2.0" "30","pagy" "30","land-of-lisp" "30","manchester-syntax" "30","filterattribute" "30","lanczos" "30","lager" "30","jsonfield" "30","inbound-security-rule" "30","blacklight" "30","firefox-driver" "30","data-serialization" "30","nextion" "30","configsource" "30","biztalk-rule-engine" "30","kubernetes-rook" "30","fileopener2" "30","apache-spark-3.0" "30","blackberry-push" "30","chrome-dev-editor" "30","uivibrancyeffect" "30","kubernetes-cluster" "30","keystonejs6" "30","angular-ngmodelchange" "30","fastapi-middleware" "30","docbook-xsl" "30","red-black-tree-insertion" "30","avmetadataitem" "30","keywindow" "30","microblink" "30","alassetlibrary" "30","animate-on-scroll" "30","vendor-branch" "30","server-tags" "30","ibm-ifs" "30","sitecore-exm" "30","read-committed" "30","servicecollection" "30","rndis" "30","opnet" "30","nana" "30","alexa-sdk-nodejs" "30","cantera" "30","namedpipeserverstream" "30","aws-app-runner" "30","variadic-tuple-types" "30","windows-credential-provider" "30","django-push-notifications" "30","vuex-orm" "30","vuforia-cloud-recognition" "30","cameracapturetask" "30","recordtype" "30","vultr" "30","windows-media-encoder" "30","joomla-content-editor" "30","react-with-styles" "30","fast-esp" "30","row-major-order" "30","wcf-wshttpbinding" "30","aiopg" "30","ora-12560" "30","californium" "30","faces-flow" "30","aim" "30","mysql-error-1044" "30","rsyntaxtextarea" "30","document-provider" "30","updatable-views" "30","google-truth" "30","fastroute" "30","sipjs" "30","calendarcontract" "30","django-suit" "30","airpods" "30","hyperledger-iroha" "30","akka-kafka" "30","faultcontract" "30","read-unread" "30","real-datatype" "30","fatwire" "30","karabiner" "30","gulp-task" "30","k8s-rolebinding" "30","twitter-bootstrap-4-beta" "30","apple-documentation" "30","pcap-ng" "30","bluenrg" "30","spring-security-test" "30","grunt-ts" "30","spring-social-google" "30","countplot" "30","corewlan" "30","invalid-pointer" "30","spring-batch-stream" "30","kartograph" "30","twitter-api-v1" "30","spring-cloud-connectors" "30","desktop-sharing" "30","enrich-my-library" "30","android-sql" "30","inputmethodmanager" "30","boxen" "30","episerver-8" "30","azure-app-api" "30","azure-china" "30","twilio-conference" "30","android-textview-autosize" "30","dynamic-sizing" "30","spring-gem" "30","sass-maps" "30","nsanimationcontext" "30","boinc" "30","delphi-units" "30","pomegranate" "30","mongoid5" "30","eaglcontext" "30","applepay-web" "30","application-client" "30","neoeloquent" "30","io-buffering" "30","appsflyer-ios-sdk" "30","couchdb-lucene" "30","swift-composable-architecture" "30","blender-2.50" "30","sap-conversational-ai" "30","android-studio-electric-eel" "30","juddi" "30","onexception" "30","http-1.0" "30","entityspaces" "30","postman-mocks" "30","nsfontmanager" "30","positive-lookahead" "30","twitter-bootstrap-wizard" "30","power-analysis" "30","workflow-manager-1.x" "30","neos-server" "30","nbuilder" "30","organizational-chart" "30","objectstatemanager" "30","systemmenu" "30","netbeans-10" "30","browser-api" "30","system-integration" "30","libqxt" "30","javaapns" "30","bubble-popup" "30","domino-appdev-pack" "30","godbolt" "30","java-bridge-method" "30","javabuilders" "30","form-processing" "30","sigils" "30","breezingforms" "30","virtual-file" "30","coldfusion-2021" "30","orphaned-objects" "30","formsflow" "30","syncml" "30","coldfire" "30","pyfirmata" "30","midi-interface" "30","pyftpdlib" "30","256color" "30","browserstack-app-automate" "30","minimum-cut" "30","ui5-webcomponents" "30","browser-scrollbars" "30","siesta" "30","gold-parser" "30",".net-core-1.1" "30","minifiedjs" "30","rhq" "30","sfml.net" "30","vivagraphjs" "30","oshi" "30","777" "30","rhino-etl" "30","ott" "30","lumia" "30","kotlin-delegate" "30","virtualstore" "30","pypika" "30","vivaldi" "30","knppaginatorbundle" "30","abap-adt" "30","setf" "30","sfauthenticationsession" "30","rich-client-platform" "30","pytest-aiohttp" "30","cocos2d-iphone-3" "30","hiqpdf" "30","xamarin.forms.carouselview" "30","asp-net-mvc-1" "30","scrapy-playwright" "30","dot-plot" "30","scrapy-selenium" "30","registration-free-com" "30","control-c" "30","hlint" "30","gcc10" "30","astoria" "30","tnsping" "30","nox" "30","mkcircle" "30","tippecanoe" "30","cakeemail" "30","radtextbox" "30","c5.0" "30","azure-fluent-api" "30","gatsby-remark-image" "30","p-np" "30","expect.pm" "30","openid-selector" "30","android-compose-button" "30","itemselector" "30","pluggable-database" "30","tar.gz" "30","png-24" "30","toisostring" "30","opengl-es-3.1" "30","android-cards" "30","norton" "30","redpitaya" "30","byteman" "30","no-match" "30","burrows-wheeler-transform" "30","doxygen-addtogroup" "30","assertraises" "30","gcutil" "30","drupal-field-api" "30","scntext" "30","xcelsius" "30","openstacksdk" "30","android-fragmentscenario" "30","openscript" "30","mkstemp" "30","point-in-time" "30","node-libcurl" "30","spout" "30","layouttransform" "30","mef2" "30","iosurface" "30","ios-vision" "30","nlm" "30","metaobject" "30","moryx" "30","project-hosting" "30","nodemanager" "30","activex-exe" "30","http-status-code-409" "30","pecs" "30","custom-eventlog" "30","launch-template" "30","dual-table" "30","mono-embedding" "30","provisioned-iops" "30","elasticsearch-ruby" "30","responsive-emails" "30","esri-javascript-api" "30","angular-jest" "30","locationmatch" "30","mpic++" "30","etags" "30","logging-application-block" "30","angular-dragula" "30","mousearea" "30","elasticity" "30","commandbox" "30","qandroidjniobject" "30","hyperic" "30","terraform0.11" "30","actionbarsherlock-map" "30","resource-editor" "30","command-history" "30","resonance-audio" "30","strconv" "30","chardev" "30","pywt" "30","genericsetup" "30","longest-prefix" "30","node-firebird" "30","irssi" "30","getresponsestream" "30","mozilla-sops" "30","nhunspell" "30","httpinterceptor" "30","angular2-compiler" "30","omniauth-twitter" "30","requests-oauthlib" "30","android-livedata-transformations" "30","reactfx" "30","streamwriter.write" "30","zk-snark" "30","quarkus-extension" "30","secure-context" "30","vaadin-spring-boot" "30","git-track" "30","soy-templates" "30","structured-exception" "30","art-runtime" "30","uwp-navigation" "30","msisdn" "30","ietf-restconf" "30","zones" "30","securitydomain" "30","glium" "30","hdcp" "30","zend-servicemanager" "30","webargs" "30","topaz-signatures" "30","web-animations-api" "30","practical-common-lisp" "30","best-buy-api" "30","qsystemtrayicon" "30","pragma-pack" "30","stryker" "30","ident" "30","sundials" "30","starman" "30","solr7" "30","concurrency-runtime" "30","sunpkcs11" "30","liipfunctionaltestbundle" "30","pandorabots" "30","beginthread" "30","scriban" "30","passive-event-listeners" "30","mule-module-jpa" "30","arcgis-online" "30","amazon-cloudhsm" "30","soundchannel" "30","sui" "30","ido-mode" "30","stickyrecycleview" "30","msde" "30","liferay-7.3" "30","zegocloud" "30","flutter-razorpay" "30","qt-resource" "30","zef" "30","sucker-punch" "30","ie7.js" "30","tilt-sensor" "30","completion-service" "30","theme-ui" "30","amazon-javascript-sdk" "30","msbuild-wpp" "30","fm-radio" "30","amazon-msk" "30","autosummary" "29","wifstream" "29","clair" "29","tsdoc" "29","debian-bookworm" "29","fibplus" "29","flutter-3.0" "29","edge-function" "29","skfuzzy" "29","whatwg-streams-api" "29","localsystem" "29","defadvice" "29","liveview" "29","teaser" "29","progid" "29","felogin" "29","git-grep" "29","bankid" "29","remotes" "29","maui-shell" "29","phaser" "29","flexicious" "29","livelock" "29","mutable-reference" "29","trustwallet" "29","jbase" "29","ecpg" "29","phfetchoptions" "29","intake" "29","github-actions-reusable-workflows" "29","tera" "29","processmodel" "29","jchartfx" "29","xstream-js" "29","clpb" "29","gitbucket" "29","deep-dream" "29","teachable-machine" "29","base58" "29","floating-labels" "29","client-hints" "29","x-tag" "29","deepar" "29","wicket-8" "29","mvvm-foundation" "29","wide-column-store" "29","xsom" "29","ffplay" "29","annox" "29","claude" "29","ssms-addin" "29","loadui" "29","jboss-messaging" "29","photo-picker" "29","babelfish" "29","jboss-forge" "29","vssettings" "29","ssrf" "29","clipped" "29","react-responsive-carousel" "29","smacss" "29","phpeclipse" "29","groupon" "29","giter8" "29","ssrs-subscription" "29","apache-ace" "29","blaze-html" "29","swish" "29","pace" "29","rush" "29","apache-spark-sql-repartition" "29","bi-tool" "29","frequency-domain" "29","blackberry-maps" "29","bitmex" "29","vsdbcmd" "29","bitly" "29","bitcoinlib" "29","discoverability" "29","voxels" "29","manifoldcf" "29","xml.modify" "29","front-end-optimization" "29","rxjs-subscriptions" "29","sockaddr-in" "29","vobject" "29","apigee127" "29","mariadb-10.2" "29","binary-indexed-tree" "29","laratrust" "29","s5" "29","implementation-defined-behavior" "29","implication" "29","sablecc" "29","xetex" "29","function-constructor" "29","python-netifaces" "29","safenet" "29","unichar" "29","xpointer" "29","functions-framework" "29","select-insert" "29","include-once" "29","python-decouple" "29","xdp-pdf" "29","uivideoeditorcontroller" "29","smartedit" "29","smartercsv" "29","category-abstractions" "29","ngrx-component-store" "29","jsonpath-ng" "29","chinese-remainder-theorem" "29","castcompanionlibrary" "29","pkpass" "29","datetimeformatinfo" "29","circleimage" "29","fire-sharp" "29","piwiktracker" "29","cegui" "29","fiware-sth-comet" "29","fixer.io" "29","flartoolkit" "29","jstatd" "29","ng2-datepicker" "29","flascc" "29","flatfilesource" "29","fileupdate" "29","smtps" "29","chatfuel" "29","datechooser" "29","p-lang" "29","aioredis" "29","will-change" "29","gradle-wrapper" "29","ora-12170" "29","windows-live-messenger" "29","jpedal" "29","r-mosaic" "29","mfrc522" "29","pssh" "29","robotc" "29","django-model-utils" "29","shared-state" "29","route-parameters" "29","databricks-dbx" "29","ruby-3.1" "29","angular-json" "29","metatype" "29","rs256" "29","crouton-os" "29","ibm-ilog-opl" "29","critical-css" "29","avsc" "29","jgss" "29","serenity" "29","jpegoptim" "29","sinaweibo" "29","graph-api-explorer" "29","jmxtrans" "29","robotics-studio" "29","servercontrol" "29","unsafe-perform-io" "29","rtaudio" "29","waitone" "29","windows-server-2003-r2" "29","sinopia" "29","sequel-gem" "29","microsoft-dynamics-webapi" "29","pthread-exit" "29","farpoint-spread" "29","documentum-dfs" "29","purify" "29","jpamodelgen" "29","vanity" "29","cal-heatmap" "29","rebus-azureservicebus" "29","method-interception" "29","wagtail-apiv2" "29","winbgi" "29","ora-00900" "29","ruby-paranoia" "29","angular-tour-of-heroes" "29","sharepoint-branding" "29","ora-00905" "29","upstream" "29","mygeneration" "29","dmi" "29","sharepoint-deployment" "29","do-catch" "29","error-recovery" "29","ttlauncherview" "29","azure-application-settings" "29","b-plus-tree" "29","apptentive" "29","azure-application-insights-profiler" "29","android-vertical-seekbar" "29","pootle" "29","box-view-api" "29","boost-uuid" "29","input-type-range" "29","gulp-nunjucks-render" "29","surface-pro" "29","e1071" "29","nearprotocol-validator" "29","openehr" "29","apple-live-photos" "29","nest-nested-object" "29","modelr" "29","mongodb-hadoop" "29","dynamic-data-list" "29","nsdragginginfo" "29","paystack" "29","bottomappbar" "29","mongoid6" "29","boost-compute" "29","pcap4j" "29","applitools" "29","cosmosdbtrigger" "29","dynamic-linq-core" "29","wp-enqueue-scripts" "29","simple.odata" "29","aws-sdk-rust" "29","module-augmentation" "29","wso2-appm" "29","jquery-tags-input" "29","spring-environment" "29","android-work-profile" "29","mongodb-charts" "29","sveltekit-adapter-node" "29","grpcurl" "29","onkeylistener" "29","ttr" "29","gui-toolkit" "29","mod-evasive" "29","nelmiocorsbundle" "29","kdevelop4" "29","nscolorpanel" "29","jrails" "29","epos" "29","aramex" "29","jqzoom" "29","deployr" "29","gogo-shell" "29","syncservices" "29","ubuntu-20.10" "29","wnck" "29","object-expected" "29","ubuntu-8.04" "29","lfe" "29","pygad" "29","lib.web.mvc" "29","shadertoy" "29","javaspaces" "29","facebook-customer-chat" "29","2d-3d-conversion" "29","net-ftp" "29","pykinect" "29","visiblox" "29","macfuse" "29","othello" "29","rhel9" "29",".net-core-configuration" "29","googleads-mobile-unity" "29","sfcalendar" "29","atomicboolean" "29","javaplot" "29","ugc" "29","macromedia" "29","amember" "29","exprtk" "29","t4-toolbox" "29","macro-recorder" "29","or-condition" "29","virtex" "29","pyicu" "29","ming" "29","asyncresttemplate" "29","rdo" "29","mitk" "29","netapi32" "29","winrun4j" "29","br-automation-studio" "29","microsoft-graph-security" "29","reward-system" "29","rawrepresentable" "29","rinsim" "29","formal-semantics" "29","libraw" "29","osmbonuspack" "29","newsapi" "29",".net-standard-1.5" "29","r-inla" "29","visual-studio-app-center-test" "29","shopify-app-bridge" "29","visual-studio-installer" "29","signer" "29","ova" "29","vmmap" "29","winverifytrust" "29","python-2.3" "29","setenvif" "29","netflix-metaflow" "29","forever-monitor" "29","auth0-connection" "29","bsondocument" "29","amslidemenu" "29","shoelace" "29","woocommerce-checkout-fields" "29","pypubsub" "29","setitimer" "29","knockout-3.2" "29","issuu" "29","openmediavault" "29","development-process" "29","sqlkorma" "29","hobo" "29","xcode11.1" "29","tadotable" "29","pnp-core-sdk" "29","quicktype" "29","nopcommerce-3.80" "29","notificationservices" "29","gaelyk" "29","scatter-matrix" "29","tactionmanager" "29","reflog" "29","c++builder-xe3" "29","policy-injection" "29","gcloud-compute" "29","tac" "29","nor" "29","mobile-broadband-api" "29","gwt-dev-mode" "29","aspxcombobox" "29","sqloledb" "29","taskaffinity" "29","dotdotdot" "29","nonclient-area" "29","azure-java-tools" "29","c++builder-2009" "29","nutch2" "29","cache-dependency" "29","moai" "29","npyscreen" "29","azure-pack" "29","jackhenry-jxchange" "29","npruntime" "29","npm-cli" "29","sqlcedatareader" "29","gcc4.4" "29","redwoodjs" "29","regsub" "29","xcode8-beta2" "29","direct-composition" "29","hipi" "29","galsim" "29","exchange-transport-agents" "29","context-param" "29","openxls" "29","hip" "29","rails-administrate" "29","scopt" "29","sqlapi++" "29","excon" "29","gundb" "29","nsviewrepresentable" "29","scope-resolution-operator" "29","sqlalchemy-access" "29","openmrs" "29","openvg" "29","springsource-dm-server" "29","pointer-address" "29","openmmlab" "29","development-mode" "29","j8583" "29","activityresultcontracts" "29","get-method" "29","color-key" "29","column-sum" "29","ldap-client" "29","commaide" "29","laravel-helper" "29","latent-semantic-analysis" "29","lcid" "29","genexus-gam" "29","genstrings" "29","event-processor-host" "29","node-notifier" "29","event-hooking" "29","octobercms-widgets" "29","mem-fun" "29","eli5" "29","qmetatype" "29","stratio" "29","euclidean-algorithm" "29","loginstatus" "29","qlcdnumber" "29","perl-io" "29","etetoolkit" "29","ios11.3" "29","perl5.8" "29","ios13.2" "29","lockdown" "29","qgraphicswidget" "29","qfileinfo" "29","message-channel" "29","stm32l152" "29","stm32h743" "29","spring2.x" "29","httr2" "29","resend.com" "29","message-forwarding" "29","elasticsearch-php" "29","qcalendarwidget" "29","elasticsearch.js" "29","qaxobject" "29","restier" "29","nlog-configuration" "29","requires-clause" "29","elastic-appsearch" "29","sp-msforeachtable" "29","pywhois" "29","tetgen" "29","spf13vim" "29","propositional-calculus" "29","activerecord-relation" "29","protobuf-net.grpc" "29","angular-foundation" "29","ip2location" "29","motorengine" "29","text-compression" "29","ctabctrl" "29","hygieia" "29","actian" "29","motodev-studio" "29","cfeclipse" "29","duplicity-backup" "29","spinbox" "29","toolbars" "29","angular-component-life-cycle" "29","spiceworks" "29","isapi-extension" "29","cts-search" "29","angular-auxiliary-routes" "29","ironpython-studio" "29","tonic" "29","trackback" "29","pg-dumpall" "29","linkedmdb" "29","tracking-pixel" "29","compgen" "29","batch-request" "29","parboiled" "29","betareg" "29","weatherdata" "29","beatbox" "29","parsehub" "29","zero-extension" "29","parse-ios-sdk" "29","userstyles" "29","gnu-global" "29","sharpshell" "29","focus-engine" "29","batarang" "29","endeca-workbench" "29","stitch" "29","partial-methods" "29","web-manifest" "29","git-mirror" "29","transactiontoolargeexception" "29","idbconnection" "29","beeswarm" "29","stimulus-reflex" "29","iisreset" "29","flutter-renderflex-error" "29","uv4l" "29","starburst" "29","start-page" "29","iis-modules" "29","fogbugz-api" "29","emotion-js" "29","zend-file" "29","usd" "29","paper-dialog" "29","beginthreadex" "29","embarrassingly-parallel" "29","bcryptjs" "29","qt-events" "29","tiles-game" "29","multi-catch" "29","cyclone" "29","qt-connection" "29","google-openidconnect" "29","array-reverse" "29","dart-test" "29","google-music" "29","ilm" "29","cwp" "29","cygpath" "29","mraid" "29","google-toolbox-for-mac" "29","cutycapt" "29","space-leak" "29","thumbor" "29","maven-lifecycle" "29","msxml3" "29","google-healthcare-api" "29","spacevim" "29","quantopian" "29","three-way-merge" "29","msdropdown" "29","powershell-studio" "28","flexlm" "28","ansible-lint" "28","location-based" "28","multi-targeting" "28","reliable-message-delivery" "28","github-codeowners" "28","primesense" "28","clappr" "28","telepresence" "28","prism-2" "28","primefaces-gmap" "28","slack-bot" "28","skydns" "28","y2k" "28","reparsepoint" "28","multi-model-forms" "28","jep" "28","federated-storage-engine" "28","intel-composer" "28","sqsh" "28","wijmo5" "28","debugpy" "28","ff4j" "28","eclipse-gemini" "28","jbehave-plugin" "28","defaultmutabletreenode" "28","ghostscriptsharp" "28","photobucket" "28","cleave" "28","stack-machine" "28","deepspeed" "28","ballerina-http" "28","gimple" "28","matrixcursor" "28","sse3" "28","vue-jest" "28","transient-failure" "28","figma-plugin" "28","websockify" "28","cmac" "28","apache-aurora" "28","yocto-kirkstone" "28","ghcup" "28","stack-allocation" "28","weld2" "28","php-pdftk" "28","yii2-module" "28","git-http-backend" "28","mat-list" "28","installshield-2013" "28","react-native-picker" "28","decoration" "28","phpcrawl" "28","web-sys" "28","jenkins-jira-trigger" "28","cncontactpicker" "28","stack-dump" "28","python-bybit" "28","python-bob" "28","pkcs#10" "28","catransformlayer" "28","vmware-sdk" "28","piexif" "28","jsonpointer" "28","xeround" "28","marathontesting" "28","dbfunctions" "28","smt-lib" "28","pandas-rolling" "28","label-studio" "28","lambda-metafactory" "28","implicit-parameters" "28","symfony-voter" "28","softaculous" "28","nginx-unit" "28","safe-navigation-operator" "28","imodelbinder" "28","language-history" "28","iml" "28","cdktf" "28","pandas-settingwithcopy-warning" "28","findancestor" "28","pine-editor" "28","pagerjs" "28","pagerequestmanager" "28","firebird-4.0" "28","bits-service" "28","selecteditemchanged" "28","selenium-docker" "28","nextjs-api-router" "28","biomod2" "28","apollo-boost" "28","bindata" "28","adobe-embed-api" "28","cartocss" "28","disk.frame" "28","vscode-git" "28","pythonqt" "28","fuzz-testing" "28","rust-result" "28","pkgcloud" "28","picturegallery" "28","sxssf" "28","vram" "28","python-markdown" "28","function-points" "28","case-conversion" "28","jsr354" "28","frm" "28","catalyst-optimizer" "28","rust-decl-macros" "28","jsr82" "28","plaidml" "28","markerspiderfier" "28","chgrp" "28","vpath" "28","docklayoutpanel" "28","universal-link" "28","window.closed" "28","angularjs-ng-switch" "28","angularjs-ng-template" "28","grails-3.0.9" "28","doctrine-dbal" "28","wallpapermanager" "28","docker-watchtower" "28","named-instance" "28","crfsuite" "28","credit-card-track-data" "28","rspec-sidekiq" "28","angular-seo" "28","nape" "28","django-upgrade" "28","ora-01400" "28","create-ref" "28","ora-12514" "28","createparams" "28","iap-hosted-content" "28","jpa-annotations" "28","ora-00937" "28","callermembername" "28","canvaskit" "28","avcapturephotooutput" "28","pybossa" "28","iceweasel" "28","jigoshop" "28","recordstore" "28","carbon-copy" "28","crow" "28","crostini" "28","documentum-dfc" "28","wildfly-16" "28","vapi" "28","datagridrowheader" "28","rebex" "28","canjs-view" "28","myrrix" "28","pscl" "28","rtvs" "28","facebook-recommendations" "28","unroll" "28","google-vault-api" "28","pspice" "28","room" "28","jmail" "28","sesam" "28","unusernotification" "28","serial-processing" "28","document-layout-analysis" "28","polymorphic-functions" "28","opencore" "28","tweener" "28","sign-in-with-google" "28","easyrdf" "28","kafka-node" "28","bottlenose" "28","bootstrap-lightbox" "28","information-visualization" "28","pbiviz" "28","boost-beast-websocket" "28","openafs" "28","tx-mask" "28","countable" "28","ionic-cloud" "28","molehill" "28","mongomock" "28","nrefactory" "28","boolean-indexing" "28","grunt-contrib-qunit" "28","sutime" "28","writer-monad" "28","wpengine" "28","mongodate" "28","in-memory-data-grid" "28","svn-client" "28","spring-ai" "28","needle.js" "28","twitter-r" "28","nsassert" "28","tying-the-knot" "28","wtx" "28","wvd" "28","twgl.js" "28","angelscript" "28","worklight-mtww" "28","jquery-1.6" "28","sweeper" "28","application-variables" "28","e-notices" "28","navcontroller" "28","nearlyfreespeech" "28","html.textbox" "28","app-store-connect-api" "28","boxsdk" "28","twitter-widget" "28","libpurple" "28","visual-c++-2008-express" "28","konacha" "28","android-api-30" "28","shrinkresources" "28","type-equivalence" "28","oracle-type" "28","liblas" "28","macrobenchmark" "28","dojox.gfx" "28","libsigc++" "28","visualhg" "28","ezapi" "28","oauth-ruby" "28","outputformat" "28","goertzel-algorithm" "28","minicart" "28","system.io.pipelines" "28","macbookpro" "28","outgoing-mail" "28","riverplot" "28","jarbundler" "28","rfduino" "28","amp-mustache" "28","coderush-xpress" "28","java-gstreamer" "28","leftalign" "28","shady-dom" "28",".net-1.0" "28","signalr-client" "28","jaudiotagger" "28","amp-form" "28","attributedstring" "28","viewflow" "28","orsserialport" "28","frameworkelementfactory" "28","system-setting" "28","typescript-conditional-types" "28","raknet" "28","rcppeigen" "28","extraction-operator" "28","klout" "28","pyramid-arima" "28","codevisionavr" "28","jarjar" "28","express-vhost" "28","revit-2015" "28","amiga" "28","jamvm" "28","b2g" "28","iweb" "28","schema.yml" "28","drupal-fivestar" "28","token-exchange" "28","nsurlcomponents" "28","tkinter-scrolledtext" "28","scan-build" "28","exchange-basicauth" "28","dscl" "28","nptl" "28","ixmldomdocument" "28","uipath-api" "28","expired-cookies" "28","explicit-implementation" "28","experience-manager" "28","bzip" "28","isnan" "28","nui" "28","scoped" "28","expo-build" "28","cairo-lang" "28","np.argsort" "28","referenceproperty" "28","scoped-lock" "28","azure-rtos" "28","itween" "28","sceditor" "28","plc4x" "28","gwt-material-design" "28","coq-extraction" "28","taffy" "28","gendarme" "28","polymer-1.x" "28","opera-dragonfly" "28","gwt-hosted-mode" "28","controlcollection" "28","gwt-2.7" "28","openvx" "28","tab-size" "28","point-sprites" "28","xcglogger" "28","dotnetinstaller" "28","podsecuritypolicy" "28","opengis" "28","asp.net-core-cli" "28","mls" "28","r2rml" "28","android-credential-manager" "28","hackintosh" "28","radupload" "28","qwizardpage" "28","raid" "28","openjpa-maven-plugin" "28","hamiltonian-path" "28","drawingcache" "28","rails-flash" "28","pm2-logrotate" "28","diff3" "28","cfreadstream" "28","resharper-sdk" "28","evaluatejavascript" "28","qpointer" "28","https-proxy-agent" "28","pffacebookutils" "28","morph-x" "28","omake" "28","http-status-code-412" "28","mosel" "28","laravel-http-client" "28","spid" "28","laravel-livewire-wiremodel" "28","chai-enzyme" "28","mousemotionevent" "28","protocol-relative" "28","metalanguage" "28","hubspot-cms" "28","android-notification.mediastyle" "28","project-setup" "28","angularjs-fileupload" "28","angular-cli-ghpages" "28","action-menu" "28","dukescript" "28","duplicate-content" "28","textspan" "28","text-services-framework" "28","ipcs" "28","nimbus-ios" "28","tomcat7-maven-plugin" "28","custom-compare" "28","eintr" "28","columnmappings" "28","io-socket" "28","test-and-set" "28","google-cloud-deploy" "28","terraform-remote-state" "28","leak-sanitizer" "28","performance-measuring" "28","zuora" "28","google-cloud-tools" "28","google-fitness-api" "28","logdna" "28","react-bootstrap-nav" "28","ellipsize" "28","node-horseman" "28","persistent-memory" "28","lookml" "28","lowcode" "28","query-timeout" "28","arrangeoverride" "28","gmcs" "28","struts2-spring-plugin" "28","d3fc" "28","tidyverts" "28","google-local-search" "28","sublimecodeintel" "28","searchable-plugin" "28","avatars" "28","bignumber.js" "28","emboss" "28","qtwebchannel" "28","endorsed" "28","google-surveys" "28","linq-to-xsd" "28","eme" "28","vaadin12" "28","throbber" "28","limit-choices-to" "28","qtremoteobjects" "28","maven-extension" "28","seckeyref" "28","ihaskell" "28","billingclient" "28","flutter-responsive-layout" "28","sonicmq" "28","benchmark.js" "28","amazon-mobile-analytics" "28","zipapp" "28","webcola" "28","totalview" "28","soti" "28","web-clips" "28","threebox" "28","webhttp" "28","liferay-7.4" "28","scripting.dictionary" "28","solandra" "28","tracemalloc" "28","url-helper" "28","zeplin" "28","heapalloc" "28","auto-sklearn" "28","bgfx" "28","tilestache" "28","trailing-whitespace" "28","alt.js" "28","suitecloud" "28","imagelibrary" "28","header-bidding" "28","webkit-perspective" "28","quarkus-hibernate-reactive" "28","tfs-security" "28","mdtool" "28","parchment" "28","sharpbox" "28","git-send-email" "28","userappdatapath" "28","illuminate" "28","flutter-hotreload" "28","conditional-variable" "27","skus" "27","yardstick" "27","insight" "27","jbossmq" "27","debuggerdisplay" "27","sitemap-generator-gem" "27","reactotron" "27","git-cvs" "27","dda" "27","smallcaps" "27","editline" "27","gist-index" "27","vue-slot" "27","fetchmail" "27","cliptobounds" "27","graphql-spqr-spring-boot-starter" "27","jfif" "27","yasson" "27","jbig2" "27","yandex-tank" "27","masonite" "27","slab" "27","clojure-core.typed" "27","ggsurvfit" "27","clist" "27","php-closures" "27","loadbalancer" "27","reparenting" "27","cloveretl" "27","groovydsl" "27","webservicehost" "27","whirlpool" "27","edamam-api" "27","pgraphics" "27","terminal-color" "27","dbt-cloud" "27","list-unsubscribe" "27","eclipse-fp" "27","litecoin" "27","intents-extension" "27","bankers-algorithm" "27","remoteexception" "27","remote-file-inclusion" "27","greendao3" "27","git-history-rewrite" "27","php-resque" "27","tell-dont-ask" "27","ebtables" "27","list-definition" "27","grouped-list" "27","phplint" "27","greenlock" "27","truevault" "27","xsl-choose" "27","mat-slider" "27","webwork" "27","xsl-stylesheet" "27","repeatbutton" "27","yagni" "27","printer-properties" "27","bar3d" "27","jseparator" "27","laravel-dusk2" "27","appengine-maven-plugin" "27","constant-time" "27","ui-toolkit" "27","afjsonrequestoperation" "27","vs-code-settings" "27","content-experiments" "27","connected-services" "27","packages.config" "27","umbraco4" "27","finite-group-theory" "27","birt-deapi" "27","plan-9" "27","sygic" "27","directory-walk" "27","pageloadstrategy" "27","unbounce" "27","nextjs-storybook" "27","carekit" "27","aplpy" "27","jsunit" "27","flash-list" "27","adobe-media-server" "27","directory-server" "27","content-query-web-part" "27","swing-highlighter" "27","runscope" "27","pythoncard" "27","python-bigquery" "27","json-table" "27","s3-lifecycle-policy" "27","smart-device-framework" "27","cbitmap" "27","django-constraints" "27","datalife-engine" "27","adsutil.vbs" "27","datatip" "27","datalistitem" "27","impressionist" "27","maintainscrollpositionon" "27","social-graph" "27","app42" "27","pixel-shading" "27","langgraph" "27","xml-1.1" "27","cctray" "27","social-auth-app-django" "27","contentdialog" "27","sage-line-50" "27","mapstraction" "27","sage-crm" "27","ngx-spinner" "27","data-interchange" "27","kendo-sortable" "27","serverless-webpack-plugin" "27","rt.jar" "27","document-set" "27","server-application" "27","cardio" "27","pushstreamcontent" "27","alamofire5" "27","calligraphy" "27","mysql-error-1068" "27","update-by-query" "27","animatorset" "27","djnativeswing" "27","update-attribute" "27","go-toolchain" "27","jinja2-cli" "27","aws-appsync-ios" "27","windows-phone-voip" "27","vectorstore" "27","windows-phone-silverlight" "27","pubdate" "27","angular-language-service" "27","fat-binaries" "27","rtsp-server" "27","simpletype" "27","dojo-dnd" "27","grails-filters" "27","rowmapper" "27","ibm-data-replication" "27","facial-landmark-alignment" "27","django-excel" "27","unminify" "27","cross-process" "27","water-jug-problem" "27","ibm-graph" "27","data.tree" "27","rngcryptoserviceprovider" "27","watir-classic" "27","universal-hashing" "27","credssp" "27","cancelanimationframe" "27","win32con" "27","wildfly-15" "27","ibm-streams" "27","session-set-save-handler" "27","django-graphql-jwt" "27","named-captures" "27","kind-projector" "27","database-caching" "27","http4k" "27","word-size" "27","growlnotify" "27","app-transfer" "27","postgres-crosstab" "27","android-wheel" "27","azure-cosmosdb-cassandra-api" "27","twitter-hbc" "27","mongoose-middleware" "27","iodbc" "27","delphi-4" "27","swiftbond" "27","delphi-2005" "27","wsat" "27","tungsten-replicator" "27","htmldoc" "27","apriltags" "27","swift-class" "27","ion-menu" "27","postasync" "27","postgresql-bdr" "27","svnlook" "27","nsrect" "27","appsmith" "27","bluetooth-sco" "27","on-location-changed" "27","nspersistentcontainer" "27","deftype" "27","wunderlist" "27","ionic-plugins" "27","swift-custom-framework" "27","intero" "27","poset" "27","turbopower" "27","wtsapi32" "27","boost-intrusive" "27","spring-cloud-config-client" "27","tx-indexed-search" "27","supplementary" "27","jupyter-extensions" "27","spring-js" "27","navigationwindow" "27","inext" "27","designview" "27","mojo-useragent" "27","wsgiserver" "27","httpapi" "27","modulefile" "27","earley-parser" "27","natty" "27","pattern-guards" "27","dependent-destroy" "27","deluge" "27","samsung-gear" "27","spring-boot-starter-oauth2-client" "27","application.xml" "27","modx-chunks" "27","boonex-dolphin" "27","keda-scaledjob" "27","deploymentitem" "27","blog-engine" "27","pound" "27","kaleido" "27","jquery-upload-file-plugin" "27","applicationwindow" "27","bounds-checker" "27","saturation-arithmetic" "27","earthdistance" "27","nscountedset" "27","jquery-rails" "27","jwebunit" "27","negative-zero" "27","infoblox" "27","gtkwave" "27","ringojs" "27","sysbench" "27","virtual-tour" "27","winit" "27","javafx-1" "27","video-reactjs" "27","random-data" "27","setalarmclock" "27","lvgl" "27","atlassian-connect" "27","network-load-balancer" "27","visual-studio-code-server" "27","asymptote" "27","codepro" "27","god-object" "27","rars-simulator" "27",".net-sdk" "27","extension-modules" "27","oauth2resttemplate" "27","netflix-archaius" "27","revoscaler" "27","wiremock-record" "27","luvit" "27","javolution" "27","async-components" "27","pyq" "27","libnodave" "27","rcrawler" "27","java-18" "27","minko" "27","build-environment" "27","dolphin-browser" "27","dolby" "27","browser-close" "27","system-restore" "27","aasa" "27","libmodbus" "27","audiojs" "27","fourier-descriptors" "27","atlcom" "27","pylearn" "27","java-native-library" "27","extconf.rb" "27","accept.js" "27","code-statistics" "27","outlook-form" "27","build-pipeline-plugin" "27","sfdatagrid" "27","build-process-template" "27","google-admin-audit-api" "27","magento-rules" "27","wkinterfaceimage" "27","javascript-inheritance" "27","asp.net-core-logging" "27","jackson-dataformat-avro" "27","toeplitz" "27","redux-router" "27","radlistbox" "27","gdm" "27","tablesort" "27","redux-offline" "27","gears" "27","nth-element" "27","regexbuddy" "27","exponentjs" "27","gcc12" "27","cache-locality" "27","sqldmo" "27","uikeyinput" "27","dpkg-buildpackage" "27","assertthat" "27","tls-psk" "27","copy-data" "27","hapi.js-lab" "27","azure-management-groups" "27","drupal-permissions" "27","iusertype" "27","geiser" "27","exploratory" "27","npm-pack" "27","xcode6-beta5" "27","xcode6.3.1" "27","time-select" "27","c++-experimental" "27","gamesparks" "27","nonsequential" "27","uioutput" "27","vertex-cover" "27","android-fragment-manager" "27","drools-kie-workbench" "27","opengl-extensions" "27","mixed-programming" "27","itemtemplateselector" "27","mobile-robot-toolkit" "27","scaleanimation" "27","tailscale" "27","cordic" "27","nunit-2.5.9" "27","bypass" "27","dictionary-attack" "27","dse" "27","titanium-web-proxy" "27","scene7" "27","sql-navigator" "27","nomachine" "27","redis-stack-server" "27","vestal-versions" "27","askbot" "27","highline" "27","modal-popup" "27","mockup-tool" "27","scep" "27","ompr" "27","angularjs-limitto" "27","more-itertools" "27","lsyncd" "27","eventsetter" "27","cgimagesource" "27","iphone-keypad" "27","angular17-ssr" "27","olsmultiplelinearregression" "27","event-flow" "27","react.rb" "27","coledatetime" "27","cupertinotabbar" "27","qrect" "27","ip-blocking" "27","iowait" "27","react-daterange-picker" "27","react-flexbox-grid" "27","nist" "27","changetype" "27","property-graph" "27","pythran" "27","q-municate" "27","customproperty" "27","testdroid" "27","pywinusb" "27","office-web-components" "27","memoise" "27","project-explorer" "27","qa-c" "27","odatacontroller" "27","test.check" "27","react-fragment" "27","long-lines" "27","logtalk" "27","google-cloud-pubsublite" "27","nntool" "27","google-cloud-talent-solution" "27","large-file-support" "27","off-heap" "27","nocount" "27","androidpublisher" "27","react-key-index" "27","color-channel" "27","meraki-api" "27","mercadopagosdk" "27","android-koin" "27","performbatchupdates" "27","pelops" "27","petgraph" "27","activity-result-api" "27","humanizer" "27","stream-operators" "27","requests-mock" "27","elasticlayout" "27","resolv" "27","percy" "27","requires-expression" "27","responsecache" "27","resource-timing-api" "27","spray-test" "27","electron-react" "27","stellargraph" "27","embedded-flashplayer" "27","bifunctor" "27","powershell-6.0" "27","powershell-7" "27","user-warning" "27","component-services" "27","billiards" "27","parsedown" "27","stealjs" "27","queue.js" "27","quake" "27","paserver" "27","zipf" "27","subobject" "27","cygwin-64" "27","parsimonious" "27","arcamera" "27","prado" "27","avassetdownloadtask" "27","qubit" "27","seaweedfs" "27","qsqlrelationaltablemodel" "27","compilationunit" "27","sublimemerge" "27","sectionindexer" "27","compc" "27","auto-compile" "27","sonarqube5.1.2" "27","ember-bootstrap" "27","maxby" "27","urlrewriting.net" "27","google-logging" "27","queryselectall" "27","struts2-tiles-plugin" "27","tikv" "27","stl-decomposition" "27","emitmapper" "27","alphabetic" "27","custom-selectors" "27","linq-to-sharepoint" "27","sdl-net" "27","thephpleague-fractal" "27","tfhpple" "27","mdp" "27","beginread" "27","gmail-promo-tab" "27","lingpipe" "27","sourcekit" "27","bazel-rules-nodejs" "27","multi-friend-selector" "27","webhid" "27","structured-programming" "27","preforking" "27","space-filling-curve" "27","top-level-await" "27","maven-clean-plugin" "27","scully" "27","gnome-keyring-daemon" "27","spark-redis" "27","encrypting-file-system" "27","embind" "27","qtranslator" "27","qtime" "27","scrypto" "27","autoformat" "27","identity-map" "27","endpointbehavior" "27","toolkitscriptmanager" "27","custom-ui" "26","debugbreak" "26","flowise" "26","gremlinjs" "26","remote-management" "26","interactivepopgesture" "26","deeppavlov" "26","dcu" "26","ansible-handlers" "26","wideimage" "26","cloud-automation-manager" "26","insight.database" "26","litmus" "26","react-native-google-mobile-ads" "26","phpfog" "26","massivejs" "26","phpdbg" "26","mathematical-typesetting" "26","defaultview" "26","dcraw" "26","fluent-docker" "26","travelport-api" "26","matchedgeometryeffect" "26","xwalkview" "26","class-factory" "26","ansible-api" "26","php-mysqlidb" "26","jbullet" "26","jd-gui" "26","princomp" "26","skopt" "26","edge-side-includes" "26","local-security-authority" "26","ssdt-2019" "26","gghighlight" "26","maturin" "26","prime-ui" "26","webproject" "26","fhs" "26","graphql-federation" "26","ssconvert" "26","fgarch" "26","photosui" "26","ffmpeg-wasm" "26","base-sdk" "26","ecos" "26","photo-tagging" "26","flutter-datetime-picker" "26","react-select-search" "26","yii2-urlmanager" "26","xspec" "26","anti-piracy" "26","tstream" "26","rendertron" "26","intellij-datagrip" "26","ggmosaic" "26","cm-synergy" "26","dbtype" "26","feathers-service" "26","grooveshark" "26","backdrop" "26","xscale" "26","gff" "26","flutter-channel" "26","vstest.console" "26","groovy-sql" "26","flutter-change-notifier-provider" "26","staledataexception" "26","barryvdh" "26","instagram-reels" "26","vue2-dropzone" "26","sitetemplate" "26","python-dragonfly" "26","laravel-backup" "26","fillfactor" "26","freezegun" "26","datatable-buttons" "26","swiftui-windowgroup" "26","container-data-type" "26","checkov" "26","fuslogvw" "26","datetime-generation" "26","kubernetes-metrics" "26","xforms-betterform" "26","chirpy" "26","dispatchsemaphore" "26","swiftui-sharelink" "26","jsonreststore" "26","laravel-exceptions" "26","jsdelivr" "26","in-call" "26","bindinghandlers" "26","kxml2" "26","xname" "26","displayattribute" "26","owasp-dependency-check" "26","blackberry-dynamics" "26","symfonyux" "26","bizdays" "26","content-expiration" "26","flapdoodle-embed-mongo" "26","fivetran" "26","childcontrol" "26","pythonnet" "26","pythonplotter" "26","pitr" "26","xml-conduit" "26","appendfile" "26","unicode-range" "26","maplist" "26","adbwireless" "26","phpundercontrol" "26","segment-analytics" "26","ng-required" "26","uitextposition" "26","ng2-nvd3" "26","dbcp" "26","vodapay-miniprogram" "26","appcontainer" "26","safecracker" "26","s390x" "26","s2" "26","afhttpsessionmanager" "26","cef4delphi" "26","filesavepicker" "26","soft-input-panel" "26","filepattern" "26","markdownsharp" "26","ryujit" "26","sails-skipper" "26","software-product-lines" "26","sails-orientdb" "26","rusoto" "26","runat" "26","cascalog" "26","fbflipper" "26","css-expressions" "26","pushover" "26","gpu.js" "26","r-server" "26","ups-api" "26","vcd" "26","vax" "26","push-diffusion" "26","fast-app-switching" "26","roauth" "26","rowstate" "26","pull-queue" "26","roomdb" "26","mysql-error-1066" "26","aiosmtpd" "26","simple-realtime-server" "26","dmx-ssas" "26","sharepoint-timer-job" "26","wcat" "26","goreleaser" "26","meteor-galaxy" "26","router-os" "26","hyperledger-besu" "26","vbide" "26","publickeytoken" "26","fastutil" "26","sessionend" "26","route-model-binding" "26","ptxas" "26","unwind" "26","database-installation" "26","go-structtag" "26","micronaut-kafka" "26","django-wkhtmltopdf" "26","django-voting" "26","avplayerview" "26","unmarked-package" "26","ichat" "26","famous-engine" "26","reactxp" "26","iconic" "26","mglmapview" "26","servicem8" "26","metroframework" "26","algorithm-animation" "26","ibm-case-manager" "26","vvv-wordpress" "26","service-factory" "26","icq" "26","site-column" "26","crtdbg.h" "26","windows-sandbox" "26","databricks-asset-bundle" "26","unity3d-mecanim" "26","record-locking" "26","icu4c" "26","database-tuning-advisor" "26","doit" "26","mysql-udf" "26","recommenderlab" "26","data-aware" "26","servlet-2.5" "26","wab" "26","mybatis-sql" "26","rebus-rabbitmq" "26","idataobject" "26","animatedcontainer" "26","aws-cloudshell" "26","fantasyland" "26","rocks" "26","windows-10-iot-enterprise" "26","pdfmerger" "26","svn-administraton" "26","axd" "26","cptbarplot" "26","ioremap" "26","cqengine" "26","nestjs-i18n" "26","pdblp" "26","cpropertysheet" "26","simplebutton" "26","svgo" "26","ent" "26","posterous" "26","springdoc-ui" "26","invalid-url" "26","modified-date" "26","nested-includes" "26","defold" "26","mongo-dart" "26","android-studio-3.1.4" "26","svg-transforms" "26","grpc-js" "26","entity-linking" "26","cperl-mode" "26","workflow-definition-language" "26","oneplusthree" "26","arangodb-php" "26","jquery-webcam-plugin" "26","blend-mode" "26","jquery-week-calendar" "26","entity-system" "26","bleno" "26","kaizala" "26","gulp-autoprefixer" "26","grunt-babel" "26","ongr" "26","horizontalfieldmanager" "26","horizontallistview" "26","neo4j-aura" "26","svncommit" "26","android-trafficstats" "26","polyvariadic" "26","spring-insight" "26","openai-assistants-api" "26","apple-m2" "26","nsproxy" "26","count-unique" "26","appium-inspector" "26","error-messages-for" "26","tvm" "26","nsolid" "26","nsimagerep" "26","superfeedr" "26","jquery-jscroll" "26","jtwig" "26","bootstrap-timepicker" "26","inheriting-constructors" "26","posthog" "26","ponylang" "26","patch-package" "26","crawlera" "26","create-guten-block" "26","bosh-deployer" "26","azure-devops-server-2022" "26","delegating-constructor" "26","html-tag-summary" "26","patternsyntaxexception" "26","rhino-servicebus" "26","oauth2orize" "26","viro-react" "26","libselinux" "26","rhino-security" "26","overlayfs" "26","os-detection" "26","ordbms" "26","sfdc-metadata-api" "26","ucs" "26","short-filenames" "26","exrin" "26","visio2013" "26","rfb-protocol" "26","oraoledb" "26","sysdig" "26","jasonette" "26","virtualbox-guest-additions" "26","new-psdrive" "26","object-layout" "26","visual-c++-runtime" "26","setup-wizard" "26","sidekiq-cron" "26","rational-rose" "26","system.messaging" "26","ocpp" "26","rapidsql" "26","buildmaster" "26","javax.json" "26","ravendb5" "26","typescript-utility" "26","right-justified" "26","broadband" "26","r-formula" "26","new-object" "26","sysinfo" "26","magic-mouse" "26","magicknet" "26","google-chrome-flags" "26","minidumpwritedump" "26","kosaraju-algorithm" "26","lwuit-list" "26","authenticity" "26","for-xml-explicit" "26","pymodm" "26","aadhaar" "26","amplify-auth-cognito" "26","fortran-coarrays" "26","atlassian-python-api" "26","midori" "26","amp-ad" "26","missing-cookies" "26","macwire" "26","asus" "26","cohen-kappa" "26","3-way-merge" "26","framemaker" "26","atlantis" "26","cocoa-scripting" "26","coinpayments-api" "26","magpie" "26","targetnullvalue" "26","screenrc" "26","hangfire-autofac" "26","xcode9beta6" "26","convertfrom-json" "26","scitools" "26","ui-patterns" "26","controlparameter" "26","android-gradle-2.0" "26","tavern" "26","timex" "26","non-virtual-interface" "26","scncamera" "26","tabletop-simulator" "26","tcanvas" "26","mock-location" "26","excel-solver" "26","xcode-previews" "26","expandometaclass" "26","tcp-port" "26","timecop" "26","asp.net-core-authenticationhandler" "26","hibernate3-maven-plugin" "26","polymer-designer-tool" "26","node-vm2" "26","taiga" "26","haskeline" "26","polkit" "26","quickdraw" "26","gem-fury" "26","uibuilder" "26","openturns" "26","redux-orm" "26","busy-cursor" "26","cache2k" "26","gce-persistent-disk" "26","sqlboiler" "26","rabbitmqadmin" "26","r2d3" "26","hadoop-2.7.2" "26","ca2000" "26","iso-8859-15" "26","redirect-uri-mismatch" "26","opentaps" "26","gcmtaskservice" "26","sql-server-2014-localdb" "26","assemblyversionattribute" "26","device-discovery" "26","corda-flow" "26","gang-of-four" "26","copy-local" "26","expression-blend-3" "26","itsdangerous" "26","hammer" "26","diplib" "26","rack-mini-profiler" "26","copy-webpack-plugin" "26","iteritems" "26","itil" "26","drawingml" "26","python-xmlschema" "26","s-plus" "26","terraform-provider-github" "26","google-cloud-shell-editor" "26","hugsql" "26","android-jacoco" "26","google-dataplex" "26","react-native-community" "26","google-gauges" "26","lockout" "26","android-jetpack-compose-gesture" "26","esky" "26","eslint-plugin-react-hooks" "26","logmein" "26","strong-soap" "26","collective-intelligence" "26","esplorer" "26","persistence-manager" "26","nodejs-express-server" "26","node-media-server" "26","resolve-url-loader" "26","merlin" "26","georgian" "26","resharper-10.0" "26","react-aria" "26","httpcontext.cache" "26","streamlink" "26","melonjs" "26","httpplatformhandler" "26","geotrellis" "26","memory-pressure" "26","od" "26","spfield" "26","angularjs-config" "26","elasticsearch-mongo-river" "26","mpi-rma" "26","geoalchemy" "26","getmodulefilename" "26","change-detector-ref" "26","accordionpane" "26","getdibits" "26","splitchunksplugin" "26","monocross" "26","columndefinition" "26","mormot" "26","mongrel-cluster" "26","activity-state" "26","laravel-modules" "26","mousecapture" "26","cfbundledisplayname" "26","custom-datetimepicker" "26","commercial-application" "26","tomtom-android-sdk" "26","durable-subscription" "26","eglfs" "26","spc" "26","activityunittestcase" "26","mosh" "26","zend-controller-plugin" "26","spark-redshift" "26","hfs" "26","berksfile" "26","webidl" "26","tfs-2005" "26","toolstripstatuslabel" "26","hbbtv" "26","hbase-client" "26","statmodels" "26","alice" "26","subcomponent" "26","likely-unlikely" "26","flutter-get" "26","sonar-plugin" "26","flutter-patrol" "26","time4j" "26","dart-server" "26","mtrace" "26","msmqintegrationbinding" "26","qtbluetooth" "26","iks" "26","maven-scm-plugin" "26","danfojs" "26","styled-system" "26","pannellum" "26","web-ar" "26","helpndoc" "26","help-viewer" "26","amazon-device-messaging" "26","elvis-operator" "26","cypress-file-upload" "26","amazon-certificate-manager" "26","confidentiality" "26","scriptish" "26","webaii" "26","multi-instance-deployment" "26","qsys" "26","email-delivery" "26","forestadmin" "26","hdmi-cec" "26","amazon-guardduty" "26","mbcalendarkit" "26","force-touch" "26","webdriver-w3c-spec" "26","ifc-open-shell" "26","beaker-notebook" "26","dart-ui" "26","globalize2" "26","all-delete-orphan" "26","global-functions" "26","ihtmldocument" "26","email-processing" "26","better-errors-gem" "26","batch-choice" "26","secondary-live-tile" "26","link-time-optimization" "26","zope3" "26","v8js" "26","amazon-gamelift" "25","skimr" "25","sliding-doors" "25","fieldcollapsing" "25","sliver-grid" "25","jerkson" "25","apache-camel-cdi" "25","primeng-tree" "25","clickhouse-go" "25","trusted-sites" "25","class-reference" "25","edmgen" "25","decouple" "25","phonebook" "25","preview-feature" "25","xrc" "25","remote-administration" "25","squeezebox" "25","balsamiq" "25","primary-constructor" "25","citrus-pay" "25","private-class" "25","jetty-10" "25","stagexl" "25","dcpu-16" "25","editcap" "25","wfs" "25","yapf" "25","client-side-data" "25","greybox" "25","temporaries" "25","llvm-cov" "25","loading-animation" "25","vuesax" "25","tensorflow-gradient" "25","program-structure" "25","git-crypt" "25","flutter-custompaint" "25","react-native-voice" "25","web-widget" "25","graph-sharp" "25","widescreen" "25","clojure.test" "25","jetbrains-gateway" "25","multi-release-jar" "25","printform" "25","ansible-runner" "25","interchange" "25","bitnami-kafka" "25","python-pulsar" "25","cassandra-lucene-index" "25","bitstuffing" "25","bitwise-not" "25","owin-security" "25","fit-framework" "25","jsartoolkit" "25","blastula" "25","imageloader" "25","mappers" "25","syncano" "25","jsduck" "25","semisupervised-learning" "25","symfony-cache" "25","mark-and-sweep" "25","chiseltest" "25","cdonts" "25","chromatic" "25","adobe-sign" "25","add-references-dialog" "25","symmetric-difference" "25","python-cloudant" "25","voice-control" "25","saddle" "25","smartos" "25","l20n" "25","jsoneditor" "25","chrome-ux-report" "25","smartmatch" "25","incr-tcl" "25","chrome-webrequest" "25","sentinel1" "25","incremental-compiler" "25","disp" "25","rup" "25","case-folding" "25","play2-mini" "25","flashcatalyst" "25","paddle" "25","pipedream" "25","carto-mobile" "25","adjustable" "25","pagersnaphelper" "25","find-sec-bugs" "25","xendesktop" "25","selenium-fitnesse-bridge" "25","adts" "25","snpe" "25","mapkit-js" "25","content-repository" "25","dbgeng" "25","configurationelement" "25","recursiveiterator" "25","gost3410" "25","watson-assistant-solutions" "25","servicenow-client-scripts" "25","root-finding" "25","session-cache" "25","vulcanize" "25","roottools" "25","sessioncontext" "25","docview" "25","rose-db-object" "25","database-driven" "25","document-storage" "25","ropes" "25","vue-validator" "25","jini" "25","angular-webpack" "25","serilog-filter" "25","angulartics2" "25","jms-queue" "25","react-swipeable-views" "25","data-harvest" "25","service-worker-config" "25","grails-3.3.x" "25","roomplan" "25","oracle-cursor" "25","csi-driver" "25","canjs-routing" "25","cross-page-posting" "25","val" "25","hyperloop" "25","akka-monitoring" "25","wildfly-17" "25","facepy" "25","ibm-db2" "25","icallbackeventhandler" "25","pt-online-schema-change" "25","wikitude-sdk" "25","publishsubject" "25","validate.js" "25","docker-copy" "25","dn" "25","windows-application-packaging" "25","shareware" "25","pydal" "25","validateset" "25","ruby-debug-ide" "25","kentico-11" "25","vec" "25","fastlane-pilot" "25","window-decoration" "25","crystal-reports-viewer" "25","sharepoint-discussion-board" "25","facebook-tabs" "25","pryr" "25","variable-width" "25","windows-1255" "25","validation-layers" "25","fat16" "25","cakephp-debug-kit" "25","icingaweb2" "25","ajax-push" "25","ajaxify" "25","single-user" "25","unnotificationattachment" "25","pybigquery" "25","aws-java-sdk-dynamodb" "25","meteor-cordova" "25","microsoft-documentation" "25","windows-media-center" "25","android-tools-namespace" "25","pdfsharpcore" "25","karaf-maven-plugin" "25","moltin" "25","paypal-soap" "25","infosphere-spl" "25","bluecloth" "25","appscale" "25","nested-exceptions" "25","mongodb-3.6" "25","mod-proxy-ajp" "25","azure-agent" "25","jrepl" "25","sap-analytics-cloud" "25","aqua-data-studio" "25","opencalais" "25","guid-partition-table" "25","injection-tokens" "25","swagger-jsdocs" "25","julia-studio" "25","hpx" "25","one-simulator" "25","enumerate-devices" "25","arangodb-foxx" "25","appjar" "25","horizontal-alignment" "25","opencl.net" "25","depot" "25","onfocuschangelistener" "25","gsheets" "25","axios-retry" "25","init-parameters" "25","enterprise-architecture" "25","invalid-object-name" "25","design-documents" "25","postman-collection" "25","sbt-0.13" "25","corestore" "25","openerp-6" "25","nscfstring" "25","android-view-invalidate" "25","demosaicing" "25","mog" "25","easyb" "25","spring-boot-data-geode" "25","passport.socketio" "25","tvos13" "25","kdbg" "25","cpu-hazard" "25","epmd" "25","bluetoothadapter" "25","jquery-select2-3" "25","equal-range" "25","ttabsheet" "25","postgresql-simple" "25","azure-blockchain-service" "25","boxable" "25","worklight-geolocation" "25","bounding-volume" "25","setstring" "25","google-auth-library-nodejs" "25","signalr-service" "25","freegeoip" "25","video-on-demand" "25","codesense" "25","settings-bundle" "25","objectset" "25","netlify-form" "25","2d-context-api" "25","network-state" "25","winelib" "25","astronomer" "25","video-gallery" "25","domain-data-modelling" "25","btahl7" "25","forest-plots" "25","amber-smalltalk" "25","google-anthos-service-mesh" "25","sieve-of-atkin" "25","windows-socket-api" "25","java-20" "25","sfauthorizationpluginview" "25","extjs-chart" "25","brother-print-sdk" "25","mission-control" "25",".net-spark" "25","libexif" "25","originlab" "25","revolute-joints" "25","mime4j" "25","table-index" "25","madcap" "25","ubl" "25","lumenworks" "25","knitr-spin" "25","osmar" "25","lwt" "25","outlook-2019" "25","google-chrome-webview" "25","view-templates" "25","google-bi-engine" "25","android-apt" "25","nxc" "25","android-1.6-donut" "25","ktrain" "25","abstract-action" "25","cocoapods-1.0.1" "25","pydatalog" "25","otlp-grpc" "25","gon" "25","go-back-n" "25","good-dynamics" "25","view-model-pattern" "25","object-notation" "25","framebusting" "25","wkinterfacegroup" "25","libtomcrypt" "25","wknavigationdelegate" "25","visual-studio-dbpro" "25","pyevolve" "25","pydeck" "25","build-target" "25","facebook-as3-api" "25","neuron-simulator" "25","visual-build-professional" "25","hidden-features" "25","android-compose-card" "25","scatterplot3d" "25","redis-search" "25","model-based-testing" "25","gwt-2.8" "25","pokemon-go" "25","context-sensitive-help" "25","drmaa" "25","hibernate-5" "25","scottplot" "25","podfile-lock" "25","sql-server-collation" "25","cordova-5.0.0" "25","dfd" "25","novaclient" "25","dfdl" "25","dfinity" "25","opengts" "25","tca" "25","directional-light" "25","openinventor" "25","high-resolution-clock" "25","plovr" "25","mockstatic" "25","xamarin.droid" "25","openjms" "25","qwindow" "25","tarantool-cartridge" "25","nothrow" "25","time-trial" "25","gambas" "25","exi" "25","hoodie" "25","isspace" "25","dtsearch" "25","toad-data-point" "25","hamlc" "25","jamon" "25","xcode13.2" "25","refine.js" "25","nth-root" "25","refspec" "25","reference-binding" "25","node-supervisor" "25","hit-highlighting" "25","mkdirection" "25","aster" "25","nsurlrequestcachepolicy" "25","scikit-survival" "25","handle-leak" "25","xcode7.1beta" "25","schema.rb" "25","dpll" "25","regexp-grammars" "25","tizen-web-simulator" "25","tadodataset" "25","jakarta-ee-security-api" "25","vfr-reader" "25","regex-recursion" "25","redocly" "25","devspace" "25","npm-cache" "25","contiki-process" "25","express-cassandra" "25","httprouter" "25","cssnano" "25","launchdagent" "25","qqmlengine" "25","tone-generator" "25","nhprof" "25","node-rsa" "25","lua-busted" "25","layouttransition" "25","angular2-decorators" "25","strerror" "25","elm-architecture" "25","stringcomparer" "25","react-color" "25","laravel-vite" "25","text-normalization" "25","cula" "25","elevatezoom" "25","stripplot" "25","text-decoding" "25","currentitem" "25","reswift" "25","strrchr" "25","z-score" "25","log4net-filter" "25","nite" "25","ekcalendar" "25","ios-stickers" "25","ztree" "25","ios13.4" "25","node-apn" "25","ios18" "25","google-goggles" "25","node-api" "25","elasticsearch-scripting" "25","google-cloud-healthcare" "25","getcontent" "25","google-cloud-internal-load-balancer" "25","nnapi" "25","nmssh" "25","ohm" "25","certificate-transparency" "25","moonapns" "25","mptcp" "25","mozjpeg" "25","memory-reallocation" "25","httpwatch" "25","pytorch3d" "25","memory-table" "25","proxy-object" "25","stp" "25","odp" "25","http-upload" "25","lds" "25","mongosh" "25","odoo-mobile" "25","erubis" "25","http-status-code-100" "25","pyzo" "25","centos-web-panel" "25","esb-toolkit-2.0" "25","link-local" "25","google-qpx-express-api" "25","autonumeric.js" "25","hcard" "25","utf-7" "25","toolstripcontrolhost" "25","qualys" "25","tracking.js" "25","headertext" "25","compiler-version" "25","trains" "25","encrypted-shared-preference" "25","user-administration" "25","lightfm" "25","auto-registration" "25","msvc14" "25","heterogeneous-array" "25","parenscript" "25","font-smoothing" "25","headerdoc" "25","folium-plugins" "25","bean-managed-transactions" "25","msdasql" "25","hawkbit" "25","archos" "25","amazon-linux-2023" "25","quantitative" "25","linear-types" "25","quartz.net-3.0" "25","arrow-python" "25","maven-mojo" "25","zip.js" "25","google-language-api" "25","amazon-memory-db" "25","bigtop" "25","zend-feed" "25","artisan-serve" "25","multi-mapping" "25","zmodem" "25","stargate-oss" "25","webfocus" "25","arrayref" "25","maven-docker-plugin" "25","mcollective" "25","amazon-fps" "25","computation-graph" "25","ti-dsp" "25","ember-1" "25","zend-dom-query" "25","amazon-s3-access-points" "25","linqtocsv" "25","maven-source-plugin" "25","linq-extensions" "25","embedded-cassandra" "25","ijkplayer" "25","shift-reduce" "25","sharpkml" "25","arquicklook" "25","seekbar-thumb" "25","gmgridview" "25","flutter-list-tile" "25","scrooge" "25","qsignalmapper" "25","google-nexus" "25","max-allowed-packet" "25","webistrano" "25","gnu-common-lisp" "25","parameter-splatting" "24","clickbank" "24","github-container-registry" "24","treemaps" "24","clbeaconregion" "24","xspf" "24","fcl" "24","debezium-server" "24","tensorflow-c++" "24","remote-development" "24","efcore.bulkextensions" "24","transmogrifier" "24","telegraf-output-plugins" "24","gratia" "24","trax" "24","telprompt" "24","webradio" "24","standard-evaluation" "24","websocket-rails" "24","transifex" "24","edward" "24","transmission-daemon" "24","balana" "24","apache-hop" "24","babel-plugin-react-intl" "24","clucene" "24","jdbi3-core" "24","marytts" "24","gretl" "24","file-inclusion" "24","mvcrecaptcha" "24","backout" "24","clash" "24","private-functions" "24","skel" "24","math.round" "24","yandex-metrika" "24","jboss-amq" "24","fiddler-dev" "24","mat-error" "24","phonenumberutils" "24","marpa" "24","balancing-groups" "24","vueify" "24","jdownloader" "24","class-cluster" "24","pg-partman" "24","fluentcassandra" "24","float32" "24","eclipse-collections" "24","yacas" "24","slickr" "24","v-tooltip" "24","multiple-regression" "24","reluctant-quantifiers" "24","multiple-schema" "24","vue-data-tables" "24","prezi" "24","feedback-loop" "24","clrprofiler" "24","weakeventmanager" "24","matchit" "24","jceks" "24","dbobject" "24","yarv" "24","rembg" "24","vsts-sync-migrator" "24","adobe-form" "24","python4delphi" "24","indexed-image" "24","lacontext" "24","jsonb-array-elements" "24","ng-sortable" "24","checkinstall" "24","swi-prolog-for-sharing" "24","flash-ide" "24","jsontemplate" "24","json-api-response-converter" "24","json-annotation" "24","cci" "24","ccscene" "24","sejda" "24","safe-stack" "24","contenttemplateselector" "24","python-config" "24","xml-column" "24","discounts" "24","unary-function" "24","immutant" "24","datefinder" "24","xmlbeans-maven-plugin" "24","immutability-helper" "24","sencha-command" "24","imgix" "24","sn.exe" "24","runtime-configuration" "24","carp" "24","page-fragments" "24","laravel-auditing" "24","selenium-hub" "24","datascript" "24","firebase-app-hosting" "24","vsct" "24","smile" "24","apollo-link-state" "24","fsutil" "24","xp-mode" "24","ng-annotate" "24","nhaml" "24","p4a" "24","swift-string" "24","jsr179" "24","symbol-tables" "24","mappedby" "24","oxwall" "24","conform" "24","fsc" "24","contentflow" "24","maml" "24","pivot-grid" "24","jsbundling-rails" "24","overrun" "24","apache-plc4x" "24","jscompress" "24","rxjs-dom" "24","jspresso" "24","dbaas" "24","jstreer" "24","fritzbox" "24","symfony7" "24","ng-component-outlet" "24","page-directives" "24","casadi" "24","grafana-tempo" "24","unsafe-eval" "24","mysql-shell" "24","angular-timer" "24","shared-drive" "24","roxy" "24","vaultsharp" "24","shared-file" "24","ptp" "24","pyclips" "24","serial-monitor" "24","mysql-error-1267" "24","rs" "24","icefaces-2" "24","rsolr" "24","veracrypt" "24","verity" "24","uri-fragment" "24","sharedservices" "24","wcf-interoperability" "24","i18n-node" "24","wagtail-search" "24","n900" "24","icicle-diagram" "24","gradle-android-test-plugi" "24","hypersql" "24","windows-performance-analyzer" "24","sharepoint-2003" "24","jline3" "24","aglio" "24","read.fwf" "24","governance-registry" "24","meta-where" "24","animejs" "24","kendo-contextmenu" "24","crnk" "24","rebasing" "24","way2sms" "24","aws-lambda-go" "24","simulink-library" "24","single-spa-react" "24","fast-refresh" "24","mybatis-plus" "24","uptime-monitoring" "24","routeattribute" "24","puma-dev" "24","upvar" "24","database-diagramming" "24","rtai" "24","id3lib" "24","naming-containers" "24","windows-principal" "24","windmill" "24","awesomeprint" "24","candy" "24","ruby-cocoa" "24","kissmetrics" "24","fastagi" "24","microcoding" "24","r-rook-package" "24","wildwebdeveloper" "24","joomfish" "24","vwo" "24","awql" "24","r-rio" "24","serilog-sinks-elasticsearch" "24","mysql-error-1136" "24","simple-spring-memcached" "24","mfslidemenu" "24","oracle-agile-plm" "24","swiftdate" "24","sap-bsp" "24","jquery-datatables-rails" "24","turn-by-turn" "24","sas-visual-analytics" "24","one-trust" "24","grovepi+" "24","jquery-xml" "24","iojs" "24","sas-stored-process" "24","ioports" "24","azure-elastic-sharding" "24","boolean-search" "24","opencart-events" "24","nscompoundpredicate" "24","apple-search-ads" "24","deskband" "24","superpower" "24","grpc-kotlin" "24","twitter-util" "24","dynamic-keyword" "24","applicationpage" "24","deployjava" "24","nspathcontrol" "24","nsfontpanel" "24","neo4jrestclient" "24","openal-soft" "24","pbuilder" "24","popmotion" "24","spring-cloud-azure" "24","epiphany" "24","katacoda" "24","bootrun" "24","html-reports-jenkins" "24","html-to-text" "24","julia-gpu" "24","jwebbrowser" "24","html.renderpartial" "24","createentityadapter" "24","wrds-compusat" "24","html5builder" "24","dynamics-nav-2009" "24","enyim.caching" "24","infinite-sequence" "24","eric-ide" "24","android-swipe" "24","eris" "24","gui-design" "24","inview" "24","gui-test-framework" "24","grunt-shell" "24","html-manipulation" "24","guix" "24","infinispan-8" "24","word-style" "24","peak-detection" "24","kango-framework" "24","brackets-shell" "24","modelmetadataprovider" "24","passwordvault" "24","positional-operator" "24","pdftables" "24","pdftex" "24","worklight-analytics" "24","invokeandwait" "24","amdatu" "24","coin-or" "24","ubuntu-16.10" "24","windows-xp-sp2" "24","rim-4.5" "24","libasound" "24","outliner" "24","ocaml-toplevel" "24","rhino-commons" "24","abline" "24","cocoapods-1.1.1" "24","gomega" "24","organizational-unit" "24","pydictionary" "24","forge2d" "24","showtext" "24","ripemd" "24","visual-studio-publish" "24","learnpress" "24","pysqlcipher" "24","sidewaffle" "24","pydantic-settings" "24","amplify-flutter" "24","tablayout" "24","oryx" "24","macro-rules" "24","oauth2-server" "24","razor-3" "24","fabletools" "24","vlc.dotnet" "24","pyfakefs" "24","pytest-dependency" "24","oaf" "24","google-ads-data-hub" "24","jasidepanels" "24","mindbody" "24","lemoon" "24","leshan" "24","lwuit-button" "24","new-webserviceproxy" "24","setthreadaffinitymask" "24","code-search" "24","fabric-digits" "24","systemmanagement" "24",".net-gadgeteer" "24","system-on-chip" "24","pynetdicom" "24","miller" "24","videocore" "24","extglob" "24","foswiki" "24","revoke-token" "24","pylibmc" "24","atag" "24","network-framework" "24","vinyl" "24","revmobads" "24","vim-quickfix" "24","atom-beautify" "24","winsql" "24","build-rules" "24","vimpulse" "24","mailbox" "24","rajawalivr" "24","occasionallyconnected" "24","viemu" "24","systemfit" "24","google-chrome-theme" "24","librsync" "24","winhelp" "24","oci-python-sdk" "24","viewcontext" "24","syslistview32" "24","winsock-lsp" "24","raspberry-pi5" "24",".net-core-logging" "24","c#-7.1" "24","task-switching" "24","di-containers" "24","time-travel" "24","openkm" "24","taskset" "24","coocox" "24","cordova-win10" "24","galleriffic" "24","cookiebot" "24","cactus" "24","aspchart" "24","excelize" "24","mklocalsearchrequest" "24","executeprocesstask" "24","openimageio" "24","bulk-mail" "24","reek" "24","hibernate-query" "24","mockoon" "24","hash-location-strategy" "24","tcollection" "24","asterisk-java" "24","numeric-conversion" "24","copula" "24","asp.net-4.8" "24","geckoboard" "24","asternet" "24","dpm" "24","dr.racket" "24","gwt-widgets" "24","guppy" "24","copyleaks-api" "24","mkcert" "24","bwu-datagrid" "24","plinqo" "24","continuity" "24","bwplot" "24","ui-guidelines" "24","raco" "24","isinteger" "24","xamgrid" "24","tipkit" "24","taleo-connect-client" "24","tokyo-tyrant" "24","android-controls" "24","pocketmine" "24","modbus-tk" "24","sqlite2" "24","x-callback-url" "24","quickgrid" "24","non-uniform-distribution" "24","spring-starter" "24","tkplot" "24","node-static" "24","isosurface" "24","nordic-semi" "24","dtreeviz" "24","azure-service-hooks" "24","android-droidtext" "24","spyware" "24","x64dbg" "24","uilocalizedcollation" "24","expo-updates" "24","sproutcore-views" "24","targettype" "24","acquisition" "24","logz.io" "24","ewmh" "24","curry" "24","acts-as-ferret" "24","custom-contextmenu" "24","logicblox" "24","qchar" "24","gen-fsm" "24","nipype" "24","ios11.4" "24","getpicture" "24","android-percent-library" "24","nis" "24","hubl" "24","percentile-cont" "24","es2022" "24","resulttransformer" "24","react-native-background-fetch" "24","cfadmin" "24","hugo-content-organization" "24","google-email-migration" "24","google-email-audit-api" "24","genomics" "24","test-more" "24","testkit" "24","hyde" "24","terraform-provider-cloudflare" "24","android-overscoll" "24","prost" "24","stream-compaction" "24","resharper-4.5" "24","latin-square" "24","evernote-app-notebook" "24","activitydesigner" "24","lazydatamodel" "24","iphone-64bit" "24","speed-dial" "24","membershipuser" "24","androidjunitrunner" "24","special-variables" "24","css-to-pdf" "24","odoo.sh" "24","generative-programming" "24","httpclienthandler" "24","qgroundcontrol" "24","cfsearch" "24","meego-harmattan" "24","get-it" "24","duckling" "24","iplots" "24","angular-dart-routing" "24","angular-data" "24","zend-app-bootstrap" "24","mturk" "24","gnu-sort" "24","auto-populating" "24","gmsgroundoverlay" "24","msxml4" "24","beat-detection" "24","automapper-8" "24","forem" "24","preon" "24","cwac-endless" "24","structure-packing" "24","arrowdb" "24","emitter" "24","enide" "24","haste" "24","ms-access-web-app" "24","embedded-server" "24","scriptdom" "24","cut-and-paste" "24","quadruple-precision" "24","haskell-spock" "24","scriptprocessor" "24","parsel" "24","script-src" "24","qtquick3d" "24","lichess" "24","google-maps-advanced-marker-element" "24","iinterceptor" "24","flutter-timer" "24","sophoslabs-intelix" "24","empty-class" "24","pgm-protocol" "24","thunderbird-lightning" "24","line-continuation" "24","powermockrunner" "24","stayontop" "24","image-charts" "24","dalex" "24","iis-metabase" "24","maven-embedder" "24","theta360" "24","arcball" "24","webgl-earth" "24","imagegrab" "24","thawte" "24","vaadin-elements" "24","bcrypt.net" "24","dart-native-extension" "24","toothpick-di" "24","bgtaskscheduler" "24","component-based" "24","toolz" "24","mediaprojection" "24","utplsql" "24","heavy-computation" "24","std-source-location" "24","fmpp" "24","lime-haxe" "24","user-guide" "23","ssis-data-types" "23","anthill" "23","mwe" "23","gridx" "23","bacnet4j" "23","xsl-variable" "23","websphere-traditional" "23","trello-powerup" "23","feast" "23","fftpack" "23","tensorflow-model-analysis" "23","photoshop-cs5" "23","groupprincipal" "23","declaration-files" "23","git-diff-tree" "23","term-query" "23","clarity-lang" "23","dbus-python" "23","babeltrace" "23","bash-on-windows" "23","primeicons" "23","yiic" "23","jeet-grid" "23","fbwebdialogs" "23","github-archive" "23","groupdocs" "23","phirehose" "23","phantomcss" "23","graphics3d" "23","vue-cli-5" "23","figcaption" "23","tensorrt-python" "23","yii2-active-records" "23","yii2-api" "23","tensorly" "23","fedora-26" "23","list-separator" "23","apache-camel-mail" "23","eclipse-iot" "23","fluentscheduler" "23","truss" "23","defaulted-functions" "23","react-native-splash-screen" "23","apache-arrow-flight" "23","remote-login" "23","react-native-turbomodule" "23","relaxng-compact" "23","phpfastcache" "23","wdio-v4" "23","flowpane" "23","ansi-common-lisp" "23","cloudkit-environments" "23","mashery" "23","staf" "23","sitefinity-feather" "23","multiparty" "23","intellij-idea2017" "23","defaulttreemodel" "23","eclipse-templates" "23","git-cherry" "23","mxbean" "23","webpartpage" "23","apache-dolphinscheduler" "23","tsserver" "23","web-to-winforms" "23","anzograph" "23","clj-time" "23","yandex-mapkit" "23","tsr" "23","barracuda" "23","jflap" "23","aegis" "23","xmlstreamwriter" "23","nhibernate-caches" "23","physical-design" "23","xmlsec1" "23","xmlseclibs" "23","adtf" "23","python-crfsuite" "23","vod" "23","xnamespace" "23","ngtemplateoutlet" "23","snmpsharpnet" "23","kubernetesexecutor" "23","cbc-mac" "23","xor-linkedlist" "23","pkcs" "23","pythonocc" "23","python-fractions" "23","russian-doll-caching" "23","jsr250" "23","sneakers" "23","rxtest" "23","ad-hoc-network" "23","django-crontab" "23","symbolic-references" "23","distributed-algorithm" "23","rustfmt" "23","fillable" "23","adobe-pdfservices" "23","flatfiledestination" "23","flask-principal" "23","ungetc" "23","apk-signing" "23","apigen" "23","flex4.7" "23","api-documentation" "23","bingbot" "23","adobe-scout" "23","pagedjs" "23","padr" "23","padleft" "23","x-http-method-override" "23","ump" "23","dbd-pg" "23","apex-data-loader" "23","umbraco-mvc" "23","manhattan" "23","flanneld" "23","fixed-size-types" "23","datetime-select" "23","packagecompiler.jl" "23","adobe-dtm" "23","apache-karaf-feature" "23","sembast" "23","datetime-local" "23","jsl" "23","dbdeploy" "23","laplacianofgaussian" "23","immediate-mode" "23","circleci-orb" "23","json5" "23","lablgtk" "23","c-cda" "23","jsonapi-serialize" "23","pig-udf" "23","makecode" "23","safe-browsing-api" "23","mailslot" "23","mainscreen" "23","send-port" "23","mainactor" "23","pstack" "23","animatetransform" "23","rqt" "23","kenlm" "23","rpostgres" "23","vaadin-valo-theme" "23","watson-text-to-speech" "23","wbxml" "23","carbon-fields" "23","rolling-updates" "23","aleph" "23","mysqlcommand" "23","django-project-architect" "23","vapix" "23","unstructured-data" "23","documentpaginator" "23","keyedcollection" "23","i18n-js" "23","documentsdirectory" "23","service-application" "23","django-database-functions" "23","django-drf-renderer" "23","ruffle" "23","windows-media-services" "23","upc" "23","data-governance" "23","hypotenuse" "23","icomoon" "23","icns" "23","vectorwise" "23","rtts" "23","akka-camel" "23","windows-key" "23","grails-constraints" "23","rtlcss" "23","shared-cache" "23","database-scripts" "23","simple-mvvm" "23","dockerfile-maven-plugin" "23","ical-dotnet" "23","optaweb-employee-rostering" "23","unity-ecs" "23","docker-ee" "23","django-hosts" "23","django-geoposition" "23","row-key" "23","native-android" "23","cruisecontrol.rb" "23","angularjs-timeout" "23","creole" "23","rnmapbox-maps" "23","sipdroid" "23","canutils" "23","metering" "23","jimfs" "23","ora-24247" "23","routing-slip" "23","oracle-streams" "23","criteo" "23","data-containers" "23","keyset-pagination" "23","metaweblog" "23","dllplugin" "23","angular-ng" "23","j-interop" "23","vcg" "23","aws-identitypools" "23","cronet" "23","nconf" "23","azure-file-copy" "23","internal-representation" "23","tx" "23","delphi.net" "23","save-dialog" "23","bootstrap-notify" "23","bootstrap-duallistbox" "23","spring-cloud-circuitbreaker" "23","internal-app-sharing" "23","jquery-mobile-pageshow" "23","peano-numbers" "23","bonobo-etl" "23","delay-load" "23","nested-stack" "23","gstreamer-0.10" "23","wrangle" "23","apxs2" "23","samsung-browser" "23","wsapi" "23","postgres-plpython" "23","nsshadow" "23","initwithcontentsofurl" "23","kadira" "23","gtd" "23","ws4py" "23","bluetoothlescanner" "23","kappa" "23","nested-groups" "23","nested-types" "23","kanji" "23","twitter-flight" "23","similarity-search" "23","nbitcoin" "23","k8s-cluster-role" "23","bluetooth-mesh" "23","spring-cloud-stream-binder-kinesis" "23","twitter-button" "23","workling" "23","nscolorwell" "23","information-architecture" "23","mongodb-java-3.3.0" "23","patternfly" "23","bpp" "23","enumerators" "23","cpuset" "23","wordpress-media" "23","app-preview" "23","spring-boot-chaos-monkey" "23","application-structure" "23","android-slices" "23","openbox" "23","hpack" "23","open-esb" "23","entity-framework-extended" "23","gulp-usemin" "23","nes" "23","ionic-keyboard" "23","infoview" "23","jquery-ui-contextmenu" "23","spring-pulsar" "23","applicationsettingsbase" "23","deployit" "23","modern.ie" "23","boomerang" "23","swift6" "23","spring-lemon" "23","super-columns" "23","swampy" "23","ndc" "23","ndbunit" "23","nsmanagedobjectid" "23","inherited-constructors" "23","easyapache-4" "23","navigator-ios" "23","pytest-markers" "23","802.11p" "23","kohana-db" "23","microstation" "23","visreg" "23","brisk" "23","javaquery" "23","java-heap" "23","wintersmith" "23","ubuntu-23.10" "23","buildsrc" "23","javaoptions" "23","u3d" "23","code-complete" "23","build-management" "23","network-efficiency" "23","neuraxle" "23","audio-device" "23","range-tree" "23","rakudo-star" "23","aaa-security-protocol" "23","vmrun" "23","vizard" "23","jaseci" "23","foundry-functions" "23","typespec" "23","vk-sdk" "23","typescript-never" "23","richfaces-modal" "23","virtus" "23","nxhtml" "23","objectlistview-python" "23","nwb" "23","windres" "23","out-of-band" "23",".net-standard-1.4" "23","liberty-maven-plugin" "23","origami" "23","knockback.js" "23","objcmongodb" "23","domoticz" "23","side-channel-attacks" "23","facebook-graph-api-v2.8" "23","returnn" "23","shadermaterial" "23","audio-route" "23","shippable-ci" "23","syntax-rules" "23","minmax-heap" "23","google-chat-api" "23","lucidchart" "23","visual-studio-liveshare" "23","sidetiq" "23","pygst" "23","typeorm-activerecord" "23","magnification-api" "23","mailaddress" "23","vistime" "23","bsp-tree" "23","bsdmake" "23","network.framework" "23","gomail" "23","ubersvn" "23","auth0-delegated-admin" "23","syslog4j" "23","visual-studio-power-tools" "23","tablednd" "23","contextswitchdeadlock" "23","asprintf" "23","mockito-scala" "23","mobileserviceclient" "23","taglib-ruby" "23","c5" "23","xcode8-beta4" "23","mmc3" "23","android-bootstrap" "23","toloka" "23","ui-scroll" "23","continuous-aggregates" "23","asmjit" "23","iui" "23","quickcontactbadge" "23","explicit-object-parameter" "23","npmignore" "23","driving-distance" "23","openshift-4" "23","bundletool" "23","xcplayground" "23","tachyons-css" "23","refined" "23","aspect-fit" "23","azure-promptflow" "23","rails.vim" "23","x-content-type-options" "23","xcode13.3" "23","drupal-form-submission" "23","expo-linking" "23","radius-protocol" "23","node-sqlserver" "23","quilt" "23","azure-webhooks" "23","asp.net-mvc-helpers" "23","gconf" "23","asp.net-mvc-layout" "23","scaleform" "23","dictvectorizer" "23","exfat" "23","scratchbox" "23","xact-abort" "23","nuxt.config.js" "23","target-link-libraries" "23","notification-icons" "23","scrapy-middleware" "23","tanuki" "23","mobilefirst-qa" "23","wxerlang" "23","sql-server-data-project" "23","executefetchrequest" "23","sql-server-config-manager" "23","tcheckbox" "23","android-cts" "23","tcomb" "23","azure-relay" "23","vertxoptions" "23","pligg" "23","operadriver" "23","iso-7816-4" "23","model-glue" "23","gatk" "23","nonfactors-mvc-grid" "23","expansion-tile" "23","tailwind-variants" "23","scala-placeholder-syntax" "23","rabbitmq-management" "23","dtn" "23","propertybag" "23","layar" "23","active-users" "23","angular-gettext" "23","njs" "23","ipu" "23","geom-histogram" "23","pelles-c" "23","angular-eslint" "23","csvtoarray" "23","activation-codes" "23","cfbundledocumenttypes" "23","angular-carousel" "23","omnipascal" "23","duffs-device" "23","geojsonio" "23","proximityapi" "23","monkey-testing" "23","mosaic-decisions" "23","cuda-arrays" "23","acid-state" "23","oma" "23","eid" "23","mosml" "23","spintax" "23","oledbparameter" "23","tomcat-dbcp" "23","egress" "23","acrcloud" "23","hygraph" "23","node-pty" "23","eventhub" "23","react-children" "23","etcdctl" "23","http-status-code-408" "23","lowdb" "23","http-status-code-308" "23","mesa-abm" "23","pestphp" "23","luafilesystem" "23","react-gtm-module" "23","stomp.py" "23","responders" "23","ewam" "23","resemblejs" "23","mendel-os" "23","qrunnable" "23","meekro" "23","excel-2000" "23","megabyte" "23","huawei-location-kit" "23","meltano" "23","qlibrary" "23","communityengine" "23","genius-api" "23","project-layout" "23","zugferd" "23","generic-associated-types" "23","qpid-proton" "23","ios-app-signing" "23","periodic-processing" "23","pfimageview" "23","spock-reports" "23","google-cloud-registry" "23","genstage" "23","oftype" "23","google-cloud-launcher" "23","promoted-builds" "23","msodbcsql17" "23","cxjs" "23","touchgfx" "23","auv3" "23","static-compilation" "23","msagl" "23","paraccel" "23","email-formats" "23","glmulti" "23","email-spec" "23","web-access" "23","qtwebsockets" "23","idm" "23","pp-perl-par-packager" "23","thruway" "23","measurement-studio" "23","bcbsn" "23","through2" "23","google-spark-operator" "23","glui" "23","powerform" "23","mdd" "23","structured-references" "23","pandas-timeindex" "23","artificial-life" "23","pandastable" "23","mediastreamtrack" "23","zendesk-sdk" "23","heroku-connect" "23","beforeinstallprompt" "23","bayesian-deep-learning" "23","autofield" "23","powerbi-datagateway" "23","scribe-workbench" "23","gmsautocomplete" "23","conditional-expressions" "23","ashmem" "23","weboperationcontext" "23","sunburnt" "23","space-tree" "23","msdeployserviceagent" "23","hex-file" "23","custom-scope" "23","multicol" "23","qtpy" "23","solar2d" "23","arcadedb" "23","imagehash" "23","fnv" "23","zero-width-space" "23","compiler-generated" "23","stdapply" "23","utl-http" "23","parameterized-constructor" "23","mule-sdk" "23","qsharedmemory" "23","embedded-osgi" "23","parcelfiledescriptor" "23","parentid" "23","usenet" "23","qsplashscreen" "23","authorize.net-webhooks" "23","max-execution-timeout" "23","bigcouch" "23","qt5.10" "23","compatibility-level" "23","font-scaling" "23","armasm" "23","parted" "23","archimate" "22","stalled" "22","jcryption" "22","group-object" "22","react-particles-js" "22","inserthtml" "22","stacks-blockchain" "22","yoothemes" "22","matter-iot-standard" "22","clojars" "22","react-native-image-crop-picker" "22","dbisam" "22","travel-time" "22","webusercontrols" "22","mutual-information" "22","maskformatter" "22","marp" "22","stanford-nlp-server" "22","php-gtk" "22","material-design-3" "22","telligent" "22","filebuf" "22","jbatch" "22","cloudkit-sharing" "22","apache-bahir" "22","trello.net" "22","ggtitle" "22","stack-based" "22","instana" "22","template-metal" "22","cloud66" "22","install-requires" "22","websync" "22","fdmemtable" "22","program-transformation" "22","flow-diagram" "22","gritter" "22","lli" "22","xsjs" "22","multistage" "22","ecommerce-sales" "22","replication-factor" "22","ebxml" "22","github-search" "22","teleport" "22","classtag" "22","sly" "22","flutter-camera" "22","release-apk" "22","yellow-screen-of-death" "22","ecslidingviewcontroller-2" "22","live-unit-tests" "22","fluent-entity-framework" "22","linuxthreads" "22","livecoding" "22","multiple-join-rows" "22","multivariate-partition" "22","jetbrains-hub" "22","eclipse-dtp" "22","yapdatabase" "22","backbone.validation.js" "22","relx" "22","trivially-copyable" "22","eclipse-ecf" "22","proficy" "22","print-style" "22","reposurgeon" "22","ansible-container" "22","sktransition" "22","antd-mobile" "22","pack-expansion" "22","impredicativetypes" "22","bioservices" "22","aframe-networked" "22","dispatch-table" "22","kubernetes-gateway-api" "22","ngit" "22","piracy-protection" "22","appgroups" "22","umzug" "22","flashair" "22","xhtml-1.1" "22","manticore-search" "22","chrome-for-testing" "22","chrome-remote-desktop" "22","swiftui-transition" "22","manual-retain-release" "22","page-inspector" "22","binding-expressions" "22","swiftyuserdefaults" "22","jsondecodeerror" "22","swig-typemap" "22","pagertitlestrip" "22","symfony-guard" "22","swing-app-framework" "22","chuck" "22","check-framework" "22","unisharp-file-manager" "22","freemind" "22","runtime-packages" "22","flatbutton" "22","riverpod-annotation" "22","swiz" "22","incremental-linking" "22","file-type-associations" "22","xmlhttprequest-states" "22","impact-analysis" "22","img2pdf" "22","ng-deep" "22","symstore" "22","django-anymail" "22","python-gearman" "22","smart-tags" "22","symfony-cli" "22","circusd" "22","image-resolution" "22","software-protection" "22","apache-pinot" "22","jsbarcode" "22","ngx-image-cropper" "22","uitextchecker" "22","social-likes" "22","xmltocsv" "22","jsajaxfileuploader" "22","js2-mode" "22","fittextjs" "22","g2o" "22","connect-timeout" "22","manage-nuget-packages" "22","map-matching" "22","vogels" "22","ngx-socket-io" "22","fixed-length-file" "22","bitmovin-player" "22","rust-itertools" "22","selenium-jupiter" "22","vs-color-theme-editor" "22","cinch" "22","data-uri-scheme" "22","ngx-treeview" "22","v-navigation-drawer" "22","js-routes" "22","socketpair" "22","cayley" "22","jpa-1.0" "22","facepile" "22","ruby-build" "22","sessiontracking" "22","cson" "22","pvm" "22","roda" "22","ora-01858" "22","joomla-community-builder" "22","cron4j" "22","iasyncoperation" "22","vyper" "22","cross-env" "22","keras-cv" "22","oracle12.1" "22","optionsettype" "22","database-create" "22","vanilla-extract" "22","rowexpansion" "22","ajaxuploader" "22","r-qgraph" "22","jpa-buddy" "22","narray" "22","data-jpa-test" "22","kendo-ui-vue" "22","reaper" "22","ruby-install" "22","vanishing-point" "22","django-rest-framework-filters" "22","keyring" "22","service-not-available" "22","pscx" "22","django-shop" "22","watchapp" "22","microsoft-graph-excel" "22","django-prefetch-related" "22","psr-12" "22","jinterface" "22","rule-of-five" "22","microsoft-contracts" "22","windowsondevices" "22","microsoft-cdn" "22","sequence-sql" "22","algol" "22","icepush" "22","dlt" "22","vector-space" "22","unstated" "22","cameraoverlayview" "22","aws-iam-authenticator" "22","jol" "22","ahead-of-time-compile" "22","micronaut-test" "22","wildfly-13" "22","gradle-tooling-api" "22","keyboardfocusmanager" "22","shapley" "22","site-definition" "22","jonas" "22","micr" "22","mysql-error-1142" "22","database-programming" "22","infernojs" "22","nqp" "22","enterprise-miner" "22","gulp-compass" "22","htmldecode" "22","cp1250" "22","nsanimation" "22","ttthumbsviewcontroller" "22","onestepcheckout" "22","deployment-diagram" "22","k8ssandra" "22","sigprocmask" "22","hotpatching" "22","tup" "22","entityobject" "22","writeonly" "22","swift-array" "22","destructure" "22","hot-rod" "22","simhash" "22","svn-trunk" "22","crawlee" "22","monadfix" "22","simplebar" "22","twaindotnet" "22","swift-keyboard" "22","swashbuckle.examples" "22","boost-system" "22","saspy" "22","blazorinputfile" "22","corecursion" "22","boost.test" "22","julia-pkg" "22","sat4j" "22","epiceditor" "22","equational-reasoning" "22","nsis-mui" "22","jquery-mobile-select" "22","epicor10" "22","jquery-mobile-themeroller" "22","popper" "22","delivery-pipeline" "22","moloquent" "22","html-to-image" "22","open-atrium" "22","grunt-plugins" "22","pbm" "22","open-banking" "22","ionic-devapp" "22","wsrp" "22","jquery-1.10" "22","samsung-gear-s2" "22","postgres15" "22","svelte-5" "22","nested-controls" "22","in-memory-cache" "22","wso2-es" "22","postgis-raster" "22","spring-batch-integration" "22","bluetooth-profile" "22","appliance" "22","dynamic-invoke" "22","application-end" "22","opal" "22","html-react-parser" "22","internet-options" "22","pdk" "22","apply-visitor" "22","block-storage" "22","invoice-ninja" "22","htmlextensions" "22","karma-chrome-launcher" "22","iorderedenumerable" "22","p-dropdown" "22","modified-preorder-tree-t" "22","internet-computer" "22","ion-slide-box" "22","opencv3.3" "22","opendiff" "22","kahadb" "22","spring-auto-restdocs" "22","ion-toggle" "22","net.pipe" "22","dynamic-rebinding" "22","rbindlist" "22","outlook.application" "22","ucrop" "22","async-workflow" "22","externalizing" "22","abstractmethoderror" "22","37-signals" "22","codefixprovider" "22","udp-data-transfer" "22","lwuit-textfield" "22","microsoft-partner-center" "22","rise" "22","minimum-requirements" "22","pyrus" "22","output-directory" "22","observation" "22","rewire" "22","facebook-java-sdk" "22","libsoup" "22","range-types" "22","leave-one-out" "22","view-transitions-api" "22","pydruid" "22","library-interposition" "22","pyspin" "22","wkhtmltopdf-binary" "22","goldbach-conjecture" "22","orbitdb" "22","ubiquity" "22","ameritrade" "22","amdp" "22","cognex" "22","system-profiler" "22","rdebug" "22","rapidsvn" "22","amd-gcn" "22","jasmin-sms" "22","java-deployment-toolkit" "22","wookmark" "22","octicons" "22","setwindowpos" "22","setwindowlong" "22","atomic-swap" "22","knockout-binding-handlers" "22","netbeans-13" "22","bridj" "22","javascriptexecutor" "22","tabledit" "22","bteq" "22","system.web.routing" "22","oauth2resourceserver" "22","type-mapping" "22","neupy" "22","browser-width" "22","audiobufferlist" "22","systimestamp" "22","type-resolution" "22","rapier" "22","leptos" "22","leon" "22","freeboard" "22","reverse-debugging" "22","osmand" "22","mailman-gem" "22","mimemultipart" "22","extranet" "22","asx" "22","vmargs" "22","wmctrl" "22","freak" "22","quokka.js" "22","qvector3d" "22","convexity-defects" "22","c++26" "22","rails-authorization" "22","nuxt-bridge" "22","byte-code-enhancement" "22","dtruss" "22","dreamweaver-templates" "22","xcode6.1.1" "22","cactiverecord" "22","dropify" "22","device-instance-id" "22","cordova-4" "22","dilation" "22","gamequery" "22","hama" "22","rabbitvcs" "22","toast-ui-editor" "22","cordova-sqlite-storage" "22","toast-ui-image-editor" "22","cordova-plugin-firebasex" "22","mload" "22","cordova-plugin-advanced-http" "22","dsx" "22","iso-image" "22","nuance" "22","jack-compiler" "22","drupal-contact-form" "22","sql-data-tools" "22","drupal-database" "22","cabal-new" "22","redux-form-validators" "22","numeric-ranges" "22","radiance-flamingo" "22","iwyu" "22","mlton" "22","openvpn-connect" "22","devexpress-blazor" "22","scalatest-maven-plugin" "22","histogram-equalization" "22","sql-manager" "22","redux-api-middleware" "22","android-enterprise-features" "22","xcuielement" "22","azure-static-web-app-routing" "22","aspnet-development-server" "22","drupal-views-relationship" "22","scopeguard" "22","conversational-ai" "22","registerclass" "22","contextual-binding" "22","tdom" "22","openshift-php-cartidges" "22","bullet-chart" "22","tinkerpop-frames" "22","rails-spring" "22","tinyalsa" "22","azure-sql-reporting" "22","pnrp" "22","harvard-architecture" "22","expo-permissions" "22","plistbuddy" "22","tabris-js" "22","xcode-debugger" "22","table-per-subclass" "22","timed-events" "22","dronekit-android" "22","mockrestserviceserver" "22","controlleras" "22","qinputdialog" "22","http-request2" "22","angular-http-auth" "22","http-pipelining" "22","irfanview" "22","moonmail" "22","generate-scripts" "22","odfpy" "22","mono-service" "22","angularjs-1.7" "22","irp" "22","angular2-seed" "22","laravel-schema-builder" "22","node-native-addon" "22","genero" "22","qftp" "22","compare-contrast" "22","ondoubleclick" "22","qfontmetrics" "22","qdoublespinbox" "22","oeis" "22","qdial" "22","reactify" "22","qcodo" "22","electron-rebuild" "22","ninject-conventions" "22","reactive-cocoa-5" "22","qbuttongroup" "22","genicam" "22","commitlint" "22","ol3-google-maps" "22","testserver" "22","okular" "22","elasticsearch-sql" "22","terraform-enterprise" "22","geoapi" "22","og-meta" "22","ios-statusbar" "22","android-print-manager" "22","android-kenburnsview" "22","pettingzoo" "22","storyshots" "22","evenly" "22","google-cloud-intellij" "22","storm-orm" "22","strict-transport-security" "22","curl-commandline" "22","persistence-ignorance" "22","spree-paypal-express" "22","cequel" "22","zotonic" "22","perl5.10" "22","iphelper" "22","cert" "22","memgraph" "22","spin-rdf" "22","cucumber-spring" "22","actuator" "22","iphone-sdk-3.1.3" "22","google-filament" "22","lpwstr" "22","speech-recognition-api" "22","lpstr" "22","chartfx" "22","iphone-xs-max" "22","spawn-fcgi" "22","cgi-application" "22","chart.jsv3" "22","provider-model" "22","iprogress" "22","prolog-directive-dynamic" "22","euler-path" "22","eto" "22","iraf" "22","action-hook" "22","protobuf-3" "22","activation-record" "22","font-awesome-6" "22","concrete-inheritance" "22","parsey-mcparseface" "22","prefix-notation" "22","thinkphp" "22","utest" "22","sdiff" "22","line-through" "22","maven-dependency-check-plugin" "22","ember-engines" "22","cypress-testing-library" "22","google-routes-api" "22","usocket" "22","iloggerfactory" "22","als" "22","scribunto" "22","trackpy" "22","solidcolorbrush" "22","conditional-execution" "22","autogpt" "22","lightgraphs" "22","tfs-query" "22","cypress-configuration" "22","lifx" "22","hdl-coder" "22","spark-ec2" "22","spark-connect" "22","tfignore" "22","arduino-mkr1000" "22","auto-lock" "22","ardalis-specification" "22","custom-scheme-url" "22","style-dictionary" "22","encrypted-core-data-sql" "22","webpack-externals" "22","cypress-each" "22","suo" "22","parse4j" "22","linktable" "22","partial-response" "22","mcimagemanager" "22","zii-widgets" "22","sonar-gerrit" "22","utl-mail" "22","somee" "22","igor" "22","email-signature" "22","zikula" "22","prerenderview" "22","maven-replacer-plugin" "22","qt-design-studio" "22","google-patent-search" "22","flvplayer" "22","partiallinktext" "22","image-graphviz" "22","limited-user" "22","limit-per-group" "22","beanstalk-svn" "22","automic" "22","arithmetic-overflow" "22","flutter-swiper" "22","traccar" "22","tortoisehg-2.0" "22","zipwith" "22","arb" "22","binance-chain" "22","gitstack" "22","mtj" "22","glumpy" "22","google-maps-android-api-3" "22","identicon" "22","pandastream" "22","cyrus" "22","preact-signal" "22","maven-gpg-plugin" "22","mediastreamsegmenter" "21","multiple-indirection" "21","jbox" "21","staging-table" "21","react-slate" "21","cloud-platform" "21","client-dependency" "21","skyve" "21","maruku" "21","multiple-occurrence" "21","clientscriptmanager" "21","teamcenter" "21","teamcity-10" "21","multipath" "21","teamcity-5.1" "21","clientcache" "21","react-native-fbsdk-next" "21","class-helpers" "21","client-applications" "21","xtrf" "21","flutteramplify" "21","deepnote" "21","sli" "21","slicehost" "21","vsomeip" "21","fedcm" "21","cloudflare-argo" "21","php-ide" "21","click-framework" "21","ddrmenu" "21","react-native-state" "21","weceem" "21","intel-python" "21","ef-bulkinsert" "21","product-management" "21","bandit" "21","cloth-simulation" "21","edgeengine" "21","tensorflow-ssd" "21","skip-take" "21","instapaper" "21","report-studio" "21","primepush" "21","fcmp" "21","groupname" "21","graph-modelling-language" "21","graphqlclient" "21","yii-rest" "21","fieldeditor" "21","jdepend" "21","yii-xupload" "21","sklightnode" "21","deck.js" "21","photoshop-cs4" "21","square-flow" "21","react-paginate" "21","webshot" "21","photutils" "21","jenkins-pipeline-unit" "21","yii2-grid" "21","installshield-2014" "21","gringo" "21","whois-ruby" "21","principalsearcher" "21","matlab-java" "21","github-token" "21","ycbcr" "21","localityofreference" "21","repoze.who" "21","skeleton-ui" "21","github-actions-artifacts" "21","musixmatch" "21","git-branch-sculpting" "21","affiliates" "21","data-studio-custom-visuals" "21","dirty-checking" "21","xpdo" "21","app-hub" "21","pace.js" "21","bit-cast" "21","bit64" "21","bindonce" "21","pahocpp" "21","palm-api" "21","pandarallel" "21","unified-diff" "21","unescapestring" "21","underscore-java" "21","selectmanymenu" "21","umdh" "21","umbrella" "21","sencha-cmd5" "21","sendgrid-ruby" "21","mapzen" "21","s3-rewrite-rules" "21","void-t" "21","rxjs-lettable-operators" "21","social-gaming" "21","vpc-peering" "21","sobipro" "21","vsewss" "21","rust-compiler-plugin" "21","catalystserverless" "21","ngx-build-plus" "21","ng-modal" "21","ccscrolllayer" "21","cddvd" "21","cdi-unit" "21","nexus-6p" "21","flask-cli" "21","flash-v3-components" "21","find-util" "21","flash-8" "21","smjobbless" "21","jsnetworkx" "21","jsnlog" "21","chronicle-bytes" "21","smart-http" "21","pkzip" "21","playcanvas" "21","chef-template" "21","chatscript" "21","python-jose" "21","swizzle" "21","diskpart" "21","distributed-tensorflow" "21","ovi" "21","distributed-apps" "21","python-arango" "21","index-sequence" "21","blackberry-widgets" "21","xlsx-populate" "21","swiftui-datepicker" "21","blackfin" "21","laravel-guard" "21","kysely" "21","xml-encryption" "21","xmemcached" "21","ims-db" "21","image-text" "21","imebra" "21","imovie" "21","fsxaml" "21","python-tenacity" "21","python-siphon" "21","python-schedule" "21","lab-management" "21","rpl" "21","service-control-manager" "21","watson-openscale" "21","angularjs-ui-utils" "21","ice-protocol" "21","ibm-wdt" "21","ibm-iam" "21","cryptico" "21","rockmongo" "21","record-rules" "21","windows-arm64" "21","credible-interval" "21","serviceinsight" "21","document-versioning" "21","windows-media-server" "21","watchos-simulator" "21","pushpad" "21","dashlet" "21","avs" "21","service-name" "21","pycallgraph" "21","jobeet" "21","sequential-workflow" "21","readyroll" "21","mysql-error-2006" "21","gpa" "21","gperf" "21","keyczar" "21","keydb" "21","angular-workspace-configuration" "21","mysql-logic" "21","unsafe-inline" "21","jparsec" "21","wcf-sessions" "21","mysql-routines" "21","unordered-multiset" "21","unordered-multimap" "21","dockable" "21","keyword-extraction" "21","simplecursortreeadapter" "21","docker-cmd" "21","microsoft365r" "21","rsocket-js" "21","nacos" "21","oracleexception" "21","angular-transfer-state" "21","jfuzzylogic" "21","aws-datastore" "21","nailgun" "21","universal-storyboard" "21","react-syntax-highlighter" "21","microblogging" "21","operationqueue" "21","aws-global-accelerator" "21","name-matching" "21","jprobe" "21","fastexport" "21","optimathsat" "21","fastfile" "21","docsplit" "21","oracle11gr1" "21","routing-controllers" "21","nanoid" "21","jpegtran" "21","ajaxhelper" "21","pstree" "21","dmo" "21","calloutview" "21","jpacontainer" "21","realproxy" "21","realstudio" "21","psyco" "21","pth" "21","callr" "21","django-sekizai" "21","call-user-func-array" "21","war-filedeployment" "21","django-scheduler" "21","kendo-observable" "21","upcase" "21","validationexception" "21","mysqldumpslow" "21","justboil.me" "21","pcloud" "21","neomutt" "21","supabase-realtime" "21","saturn-framework" "21","pcdata" "21","bootstrap-themes" "21","android-studio-3.6.1" "21","salesforce-mobile-sdk" "21","app-shortcut" "21","border-container" "21","applehealth" "21","ionic-webview" "21","moltenvk" "21","oov" "21","blockcypher" "21","appservice" "21","hp-performance-center" "21","openargs" "21","sve" "21","swar" "21","eoserror" "21","dynamic-mapping" "21","crc64" "21","envsubst" "21","deno-deploy" "21","ttcn" "21","houndify" "21","password-prompt" "21","couchdbkit" "21","svg-animationelements" "21","gulp-mocha" "21","ion-grid" "21","path-provider" "21","powerapps-component-framework" "21","workato" "21","jreddit" "21","negroni" "21","entitymanagerfactory" "21","apply-async" "21","svelte-native" "21","supersocket.net" "21","path-combine" "21","navigationbaritems" "21","wwsapi" "21","boost-json" "21","nrf-connect" "21","mongodb-authentication" "21","online-machine-learning" "21","wsdl2objc" "21","dynamic-chart-series" "21","dynamic-expression" "21","android-webview-javascript" "21","interwoven" "21","onready" "21","applescript-numbers" "21","bless" "21","sap-enterprise-portal" "21","erlang-driver" "21","supabase-py" "21","gstreamer-sharp" "21","k8s-cronjobber" "21","inky" "21","errata" "21","kallithea" "21","ws4j" "21","type-ahead" "21","module-build" "21","jqpivot" "21","formalchemy" "21","rdio" "21","nwebsec" "21","auth0-js" "21","outlook-graph-api" "21","system.linq.dynamic" "21","microsoft-todo" "21","sic" "21","lua-scripting-library" "21","knx" "21","ludwig" "21","javascript-interop" "21","formsy-react" "21","visual-c++-2019" "21","lumx" "21","kotlin-sealed" "21","java-audio" "21","typescript-2.5" "21","fpml" "21","raml-1.0" "21","kloxo" "21","ocrmypdf" "21","klaviyo" "21","kotlin-inline-class" "21","atsam3x" "21","viewusercontrol" "21","overheating" "21","jaxb2-annotate-plugin" "21","2-3-tree" "21","code-view" "21","typeface.js" "21","3d-mapping" "21","koloda" "21","obs-studio" "21","video-library" "21","netgraph" "21","kotlin-coroutine-channel" "21","type-extension" "21","system.err" "21","py-redis" "21","setsid" "21","2-satisfiability" "21","javax.activation" "21","korge" "21","systemml" "21","buf" "21","browsefragment" "21","o365rwsclient" "21","raspbian-stretch" "21","btreemap" "21","outlook-2007-addin" "21","mixed-authentication" "21","extjs7-classic" "21","libxlsxwriter" "21","madlib" "21","oriento" "21","magick-r-package" "21","dolibarr" "21","amber-framework" "21","neutrino" "21","object-address" "21","net-tcp" "21","t9" "21","bryntum-scheduler" "21","microsoft-graph-groups" "21","winstone" "21","orchid" "21","lenny" "21","wmdc" "21","goimports" "21","braze" "21","libdl" "21","objectbox-android" "21","vllm" "21","winmail.dat" "21","wordpress-capabilities" "21","winrs" "21","atomic-long" "21","wnet" "21","miranda" "21","macos-app-extension" "21","buildbox" "21","magento-go" "21","scgi" "21","nolio" "21","dotnet-core-pack" "21","gemstone" "21","expert-advisor" "21","xamlwriter" "21","hidden-fields" "21","rack-rewrite" "21","novocaine" "21","expanded" "21","sql-server-authentication" "21","hoptoad" "21","android-hardware-keyboard" "21","dry-rb" "21","tinyml" "21","non-well-formed" "21","redirecttoroute" "21","numericstepper" "21","directory-security" "21","redirection-wordpress-plugin" "21","dhclient" "21","diagrams.net" "21","wysiwym" "21","moa" "21","openonload" "21","istio-prometheus" "21","ispconfig-3" "21","nunit-2.6" "21","x25519" "21","mobile-analytics" "21","plugin.media.crossmedia" "21","reddit-access-token" "21","time-to-first-byte" "21","plumbum" "21","scratchcard" "21","screen-positioning" "21","to-be-continuous" "21","d-star" "21","toco" "21","reflex-dom" "21","gcore" "21","hadoop-lzo" "21","controlling" "21","nstablerowview" "21","nszombies" "21","doxia" "21","dpdk-pmd" "21","mkmf" "21","asp.net-mvc-templates" "21","scngeometry" "21","opentofu" "21","drupal-files" "21","harmony" "21","dribbble-api" "21","opensmpp" "21","gdal-python-bindings" "21","export-to-html" "21","sproutcore-2" "21","hapi-swagger" "21","nsuuid" "21","scntechnique" "21","expo-dev-client" "21","gedmo-loggable" "21","controlbox" "21","token-name-resolution" "21","gelly" "21","vfs-stream" "21","ivars" "21","xcode8-beta3" "21","node-centrality" "21","moonscript" "21","android-messaging" "21","location-updates" "21","monkeyc" "21","escalation" "21","layout-parser" "21","omeka" "21","pytumblr" "21","split-function" "21","google-cloud-spanner-emulator" "21","hwclock" "21","ldapauth" "21","spec2" "21","nodereference" "21","provider-hosted" "21","huawei-ads" "21","spring-2.5" "21","google-cloud-metrics" "21","okteto" "21","movefileex" "21","resharper-5.1" "21","movidius" "21","streamingresponsebody" "21","qlocale" "21","angular-google-chart" "21","duosecurity" "21","comdlg32" "21","angular-directive-link" "21","acf-gutenberg" "21","resumable" "21","ejb-timer" "21","perception" "21","ctp4" "21","accpac" "21","ironscheme" "21","qmovie" "21","perfetto" "21","getcustomattributes" "21","irrklang" "21","angular2-toaster" "21","performance.now" "21","ctr-mode" "21","restartmanager" "21","qopenglfunctions" "21","actuate" "21","elasticsearch-performance" "21","iphone-sdk-4.3" "21","nickel" "21","memmap" "21","cuda-graphs" "21","qglviewer" "21","string-iteration" "21","currency-pipe" "21","text2image" "21","odoo-accounting" "21","http-message-converter" "21","coldspring" "21","column-major-order" "21","esptool" "21","column-defaults" "21","ios-standalone-mode" "21","linq.compiledquery" "21","msgfmt" "21","zfc-rbac" "21","google-input-tools" "21","powergrep" "21","lifecycleexception" "21","powerpack" "21","bayessearchcv" "21","powerbi-filters" "21","google-nearby-messages" "21","encoding-json-go" "21","bedtools" "21","zfit" "21","msmq-transaction" "21","lightweight-stream-api" "21","parallel.invoke" "21","empirical-distribution" "21","alignof" "21","particle-photon" "21","parallelstream" "21","parse-recdescent" "21","linux-kernel-headers" "21","partialviews" "21","thomson-reuters-eikon" "21","web-ext" "21","compiler-services" "21","user-defined-fields" "21","hbasestorage" "21","bfcache" "21","concrete-syntax-tree" "21","compiler-development" "21","embedded-object" "21","hdfql" "21","giza++" "21","gkpeerpickercontroller" "21","emacs-speedbar" "21","forecastr" "21","arm-mpu" "21","stimulus-rails" "21","thinky" "21","webauthenticator" "21","security-trimming" "21","struts2-rest-plugin" "21","concurrent-ruby" "21","heroicons" "21","haskell-hedgehog" "21","flutter-mockito" "21","secondary-sort" "21","componentkit" "21","componentmodel" "21","maximum-profit-problem" "21","headerfooter" "21","spark-shuffle" "21","usn" "21","uss" "21","mcs" "21","ijvm" "21","touchswipe" "21","zencoder" "21","artemiscloud" "21","flyte" "21","fongo" "21","sonarqube6.3" "21","sharp-repository" "21","computed-values" "21","z3-fixedpoint" "21","compute-capability" "21","weblogic14c" "21","identity-provider" "21","sonicwall" "21","sublayout" "21","behance-api" "21","fms3" "21","multcompview" "21","shiboken2" "21","identityserver2" "21","maven-webstart-plugin" "21","zcml" "21","gmavenplus" "20","trusted-vs-untrusted" "20","terminal.app" "20","cloud-connect" "20","xrmservicetoolkit" "20","decltype-auto" "20","backdraftjs" "20","apache-arrow-datafusion" "20","ckqueryoperation" "20","dead-reckoning" "20","close-button" "20","stanza.io" "20","ggboxplot" "20","clean-url" "20","clang-query" "20","balena" "20","bale-messenger" "20","tensorflowsharp" "20","ckmodifyrecordsoperation" "20","anti-bot" "20","ckfinder3" "20","ggeffects" "20","classformaterror" "20","floris" "20","wepay" "20","ckerror" "20","cluster-mode" "20","debug-print" "20","bareword" "20","floating-ui" "20","flutter-easy-localization" "20","ecdhe" "20","vue-styleguidist" "20","clozure-cl" "20","flink-checkpoint" "20","decentraland" "20","vue-suspense" "20","class-decorator" "20","tembeddedwb" "20","installshield-2016" "20","react-native-unimodules" "20","file-diffs" "20","materials" "20","squib" "20","teltonika" "20","deferred-result" "20","my.resources" "20","pharo-5" "20","figlet" "20","reitit" "20","jbehave-maven-plugin" "20","website-payment-pro" "20","phpstorm-2016.1" "20","jcycle" "20","liveid" "20","graphiti" "20","replit-database" "20","instaparse" "20","squad" "20","repeatable-read" "20","slick-pg" "20","react-native-fast-image" "20","math-mode" "20","jfeinstein" "20","few-shot-learning" "20","jetty-httpclient" "20","php-safe-mode" "20","ssbo" "20","intellij-12" "20","jboss-wildfly-11" "20","jett" "20","filebrowse" "20","jetspeed2" "20","smallcheck" "20","inserter" "20","intellij-17" "20","default-namespace" "20","graphql-yoga" "20","renesas-rx" "20","rendr" "20","jest-mock-extended" "20","file-globs" "20","file-connection" "20","react-native-safe-area-view" "20","ffmpegkit" "20","multi-model-database" "20","react-quilljs" "20","filehash" "20","loadvars" "20","jayrock" "20","process-elevation" "20","photran" "20","react-router-bootstrap" "20","react-qr-code" "20","grimport" "20","cbmc" "20","function-reference" "20","ccmenu" "20","dataparallel" "20","function-call-operator" "20","data-presentation" "20","fullcontact" "20","datarowcollection" "20","file-system-storage" "20","flask-oidc" "20","symbian3" "20","firebase-util" "20","fiware-knowage" "20","adobe-dps" "20","jsbn" "20","js-joda" "20","swiftui-navigationpath" "20","swiftui-swipeactions" "20","fresnel" "20","chrome-canary" "20","json-spirit" "20","choices.js" "20","content-model" "20","sx" "20","chef-windows" "20","chef-vault" "20","chatops" "20","adf-task-flow" "20","rivescript" "20","funscript" "20","cashfree" "20","runhaskell" "20","running-object-table" "20","fusefabric" "20","python-gnupgp" "20","rust-criterion" "20","python-ast" "20","rust-pin" "20","voluptuous" "20","indexed-views" "20","appboy" "20","sacct" "20","safetynet-api" "20","lance" "20","sage-one" "20","self-supervised-learning" "20","uiviewcontentmode" "20","unbuffered-queries" "20","select-for-xml" "20","seldon-core" "20","blackhole" "20","unified-automation-sdk" "20","unikernel" "20","unionfs" "20","pagoda-box" "20","pagingtoolbar" "20","binary-string" "20","api-eveonline" "20","overtone" "20","bing-news-search-api" "20","blackberry-os6" "20","bitmap-index" "20","apartment-state" "20","biwavelet" "20","apache-vysper" "20","p7b" "20","apache-syncope" "20","p5.play" "20","smtpjs" "20","dispy" "20","xing" "20","playbin2" "20","xeus-cling" "20","smartsheet-java-sdk-v2" "20","picard" "20","pingback" "20","xlw" "20","smarty-plugins" "20","dbgeography" "20","xna-math-library" "20","divmod" "20","platform.sh" "20","rubycas" "20","csplitterwnd" "20","simple-machines-forum" "20","micronaut-security" "20","django-jenkins" "20","csqldataprovider" "20","angular-material-paginator" "20","universal-ctags" "20","micrium" "20","django-translated-fields" "20","r-labelled" "20","grails-5" "20","icap" "20","mget" "20","punjab" "20","kendospreadsheet" "20","aws-route-table" "20","camtasia" "20","dockerrun.aws.json" "20","fastify-multipart" "20","avr32" "20","row-removal" "20","wayfinder" "20","naniar" "20","window.parent" "20","ora-00054" "20","crewai" "20","inet-aton" "20","rowdefinition" "20","akismet" "20","route-constraint" "20","ag-charts" "20","vcal" "20","ora-01422" "20","napalm" "20","django-multiwidget" "20","django-webtest" "20","sinatra-assetpack" "20","aws-load-balancer-controller" "20","rml-rdf" "20","watson-knowledge-catalog" "20","gpc" "20","crystal-reports-formulas" "20","unspecified" "20","joda-money" "20","dataflex" "20","sharepoint-webservice" "20","vector-clock" "20","pybinding" "20","factual" "20","icx" "20","documentgroup" "20","pybricks-micropython" "20","data-controls" "20","wcf-serialization" "20","crypto-obfuscator" "20","realm-cocoa" "20","keypreview" "20","pweave" "20","wcf-streaming" "20","urho3d" "20","readeventlog" "20","unqualified-name" "20","dns-over-https" "20","facesservlet" "20","keter" "20","mytoolkit" "20","docvariable" "20","angular-ui-tinymce" "20","agm-core" "20","gradle-custom-plugin" "20","dataformwebpart" "20","kimball" "20","angular-transitions" "20","wails" "20","aws-mediapackage" "20","aksequencer" "20","wikimapia" "20","pvpython" "20","kermit" "20","docx2pdf" "20","venn" "20","twitter-bootstrap-form" "20","write-error" "20","openbr" "20","sim7600" "20","envjs" "20","passthrough-elements" "20","derelict3" "20","bower-register" "20","tvbox" "20","nsenter" "20","hourglass" "20","gulp-plugin" "20","azure-android-sdk" "20","ttkthemes" "20","http4s-circe" "20","module-federationnextjs-mfutils" "20","gtkada" "20","one-time-binding" "20","nest-simulator" "20","neptune" "20","turn.js" "20","nscondition" "20","axelar" "20","ion-checkbox" "20","gulp-minify-css" "20","gulp-minify" "20","invocationhandler" "20","twitter-share" "20","svn-export" "20","spring-batch-excel" "20","ttstyledtextlabel" "20","pdo-odbc" "20","cps" "20","nsb-servicecontrol" "20","enscript" "20","initwithcontentsoffile" "20","worker-pool" "20","silicon" "20","gulp-if" "20","swift-compiler" "20","kafka-join" "20","ndb" "20","grunt-assemble" "20","online-algorithm" "20","dynamic-web-twain" "20","internal-class" "20","wsd" "20","mongodb-biconnector" "20","bonsaijs" "20","android-studio-dolphin" "20","spring-integration-file" "20","twinfield" "20","android-studio-chipmunk" "20","sass-rails" "20","poppler-utils" "20","dynamic-frameworks" "20","nsobjectcontroller" "20","interval-arithmetic" "20","apple-musickit-js" "20","superblock" "20","azure-auto-ml" "20","erdpy" "20","ion-list" "20","epoxy-modelview" "20","apple-authentication" "20","azure-feature-manager" "20","jxmaps" "20","azure-ad-verifiable-credentials" "20","wreq" "20","wpf-core" "20","pomm" "20","salesforce-cli" "20","jxmapviewer" "20","postgres-operator" "20","twenty-ten-theme" "20","samsung-health" "20","borland-c" "20","wp7test" "20","jumphost" "20","kannada" "20","spring-mono" "20","ephemeral-storage" "20","jukito" "20","desfire" "20","inline-method" "20","nchar" "20","jquery-hotkeys" "20","codemod" "20","codelldb" "20","sysex" "20","minor-mode" "20","wordnik" "20","pyforms" "20","android-3.1-honeycomb" "20","object-design" "20","ubi" "20","vici" "20","shinyauthr" "20",".net-generic-math" "20","pymongo-2.x" "20","abap-st" "20","dom4" "20",".net-traceprocessing" "20","richeditabletext" "20","wordpress-action" "20","rich-domain-model" "20","r-distill" "20","shouldly" "20","brew-doctor" "20","reversegeocodelocation" "20","typeglob" "20","ubuntu-8.10" "20","bridge.net" "20","networkinfo" "20","magento-1.3" "20","amazon-sumerian" "20","os-agnostic" "20","lupa" "20","coexistence" "20","microsoft-graph-sites" "20","go-flag" "20","kohana-2" "20","pygmt" "20","kognitio-wx2" "20","levelhelper" "20","koding" "20","viewwilldisappear" "20","pyrserve" "20","rap" "20","java-failsafe" "20","ui4j" "20","atari-2600" "20","librarian-puppet" "20","cocor" "20","rippled" "20","gonum" "20","academic-graph" "20","aurigma" "20","codecave" "20","facebook-graph-api-v2.1" "20","auraphp" "20","pydbg" "20","librato" "20","magic-leap" "20","libnice" "20","tabbed-browsing" "20","typeset" "20","pydotplus" "20","augraph" "20","goinstall" "20","accelerate-haskell" "20","android-activity-alias" "20","mac-frameworks" "20","wisper" "20","android-actionbar-tabs" "20","pyro.ai" "20","syphon" "20","osxfuse" "20","virtual-channel" "20","uap" "20","6510" "20","extension-builder3" "20","java-console" "20","spying" "20","notification-action" "20","gadbannerview" "20","nuxmv" "20","xcode6-beta7" "20","mktemp" "20","sqlacodegen" "20","caf-receiver-sdk" "20","noraui" "20","png-8" "20","pnp.powershell" "20","pmwiki" "20","hkobserverquery" "20","highs" "20","cordova-facebook" "20","wxhtmlwindow" "20","directmemory" "20","hoplon" "20","android-device-owner" "20","expressiveannotations" "20","xcode11.2.1" "20","coproc" "20","non-scrolling" "20","sqlbuddy" "20","azure-resource-lock" "20","homoiconicity" "20","c14n" "20","pointofservice" "20","context-configuration" "20","node-test-runner" "20","nowdoc" "20","sql-rank" "20","gvisor" "20","hmr" "20","ixmldomelement" "20","gwt-elemental" "20","controlled-folder-access" "20","isml" "20","polygon.io" "20","npm-config" "20","dremel" "20","ui-spy" "20","tinytest" "20","dsymutil" "20","tinyproxy" "20","uisplitviewdelegate" "20","tanstack-router" "20","mod-auth-kerb" "20","dfply" "20","dgrams" "20","bupar" "20","bunnycdn" "20","dotnet-interactive" "20","toll-free-bridging" "20","openwrap" "20","radtreelist" "20","douglas-peucker" "20","modeless-dialog" "20","tobject" "20","dotnetcharting" "20","opensymphony" "20","openxml-table" "20","associative-table" "20","uiactivitytypeairdrop" "20","uiprintformatter" "20","dpinst" "20","drupal-routes" "20","tag-handler" "20","aspnet-merge" "20","scalatra-sbt" "20","redis-stack" "20","qx" "20","drupal-render" "20","scalr" "20","uidocumentbrowserviewcontroller" "20","asp.net-cache" "20","ref-struct" "20","gd-graph" "20","lc3-trap" "20","meta-learning" "20","mercurial-commit" "20","genie.jl" "20","e-sim" "20","odometry" "20","proguard-maven-plugin" "20","qgraphicsrectitem" "20","eslint-plugin-vue" "20","mercurial-server" "20","qkeysequence" "20","qcubed" "20","esri-loader" "20","lazyvim" "20","prom-client" "20","odatalib" "20","ohhttpstubs" "20","protogen" "20","chakracore" "20","proximo" "20","geograpy" "20","moquette" "20","omnicppcomplete" "20","geokettle" "20","omnixml" "20","monobjc" "20","cflocation" "20","cfinvoke" "20","ondrawitem" "20","hypergraph" "20","request-pipeline" "20","huffman-tree" "20","huawei-ml-kit" "20","http-status-code-505" "20","strawberryshake" "20","petastorm" "20","http-permissions-policy" "20","http-mock" "20","httpi" "20","resharper-c++" "20","stretchblt" "20","persisted-column" "20","strong-reference-cycle" "20","perlnetssh" "20","electronic-direct-mail" "20","zts" "20","responsestream" "20","periodic" "20","elasticsearch-client" "20","accountpicker" "20","elastic-container-registry" "20","acl9" "20","acorn" "20","action-mailbox" "20","pencilblue" "20","nls-sort" "20","lasso-lang" "20","custom-overlay" "20","custom-linq-providers" "20","customizer" "20","iot-devkit" "20","react-chat-engine" "20","terraform-provider-helm" "20","ipcopen3" "20","node-kafka" "20","ls-remote" "20","large-text" "20","long-path" "20","angular2-dart" "20","nhlambdaextensions" "20","nhibernate-search" "20","google-doodle" "20","cuba" "20","irule" "20","evaluation-strategy" "20","evil-dicom" "20","google-flexible" "20","google-floodlight" "20","ironspeed" "20","ip-protocol" "20","launch-condition" "20","ews-javascript-api" "20","logical-tree" "20","colmap" "20","nodeenv" "20","qmk-firmware" "20","qmk" "20","lazyhgrid" "20","angularjs-3rd-party" "20","userchrome.css" "20","flutter-stacked" "20","ignoreroute" "20","webchartcontrol" "20","three-valued-logic" "20","concourse-task" "20","panelbar" "20","compositionroot" "20","cypress-origin" "20","heliconzoo" "20","zio-http" "20","mawk" "20","hdiutil" "20","user-location" "20","subliminal" "20","shell-icons" "20","alt-ergo" "20","tibbletime" "20","compositeitemwriter" "20","sortedcontainers" "20","image-annotations" "20","igbinary" "20","folktale" "20","solr9" "20","zerotier" "20","statelist" "20","utf8json" "20","autodesk-webhooks" "20","mtgox" "20","zend-form-fieldset" "20","mdxstudio" "20","amazon-ground-truth" "20","spark-bigquery-connector" "20","zapproxy" "20","qtquick-designer" "20","msscci" "20","structured-clone" "20","glossaries" "20","heroku-nodejs" "20","qtsvg" "20","search-keywords" "20","scullyio" "20","toplevel-statement" "20","battlenet-api" "20","qtooltip" "20","yt" "20","spark-2014" "20","ember-query-params" "20","ysod" "20","scroll-snap-type" "20","array-pointer" "20","struts2-junit-plugin" "20","zend-rest-route" "20","tor-browser-bundle" "20","licode" "20","mt940" "20","scroll-lock" "20","google-realtime-api" "20","hasura-cli" "20","webfiltering" "20","idbcommand" "20","lifecycleowner" "20","dark-theme" "20","spark2.4.4" "20","ppc64le" "20","ilrepack" "20","precompiling" "20","stencil-compiler" "20","meck" "19","claimcenter" "19","felix-dependency-manager" "19","sitescope" "19","cloudposse" "19","graphiti-js" "19","mutual-friendship" "19","apache-commons-scxml" "19","vue-dropzone" "19","trinitycore" "19","php-attributes" "19","clover-payment" "19","yii-migrations" "19","github-dependabot" "19","clean-language" "19","mvcrazortopdf" "19","backload" "19","sll" "19","trunk-rs" "19","repopulation" "19","intel-media-sdk" "19","xsl-grouping" "19","decimal-precision" "19","decimal.js" "19","programmatic-config" "19","filecopy" "19","repaintmanager" "19","fdroid" "19","anonymous-recursion" "19","eclipse-project-file" "19","gitleaks" "19","flutter-audio-query" "19","anypoint-rtf" "19","cj" "19","eclipse-temurin" "19","xtemplate" "19","liquibase-cli" "19","linux-x32-abi" "19","tensorflow-addons" "19","flickrj" "19","clickup-api" "19","ffmpeg.js" "19","stack-level" "19","tenancyforlaravel" "19","location-aware" "19","ant-design-blazor" "19","flex-datagrid" "19","private-cloud" "19","jfeed" "19","yampa" "19","dbtable" "19","slashdb" "19","php-jwt" "19","tensorflowjs" "19","coccinelle" "19","multipart-upload" "19","weston" "19","cobol.net" "19","instagrapi" "19","gitbox" "19","template-mixins" "19","barbecue" "19","cloudfront-functions" "19","groovyfx" "19","apache-abdera" "19","slick-codegen" "19","instancestate" "19","ssha" "19","eclipse-api" "19","yahoo-widgets" "19","ggdist" "19","ggalt" "19","easytracker" "19","ssdt-2017" "19","siteedit" "19","cloudmailin" "19","easysnmp" "19","ssas-2016" "19","react-native-view-shot" "19","aopalliance" "19","edge-devtools" "19","citrix-access-gateway" "19","laravel-filters" "19","adornerdecorator" "19","ngx-modal" "19","laravel-gate" "19","switchers" "19","flask-flatpages" "19","managed-cuda" "19","discrete-space" "19","biztalk-2006" "19","ozone" "19","p4.net" "19","rx-netty" "19","maquette" "19","flatpak-builder" "19","xml3d" "19","filevisitor" "19","send-on-behalf-of" "19","disable-caching" "19","symengine" "19","picture-element" "19","jsmpeg" "19","file-templates" "19","sendgrid-rails" "19","mangopay" "19","softbody" "19","chronicle-wire" "19","adversarial-attack" "19","makehuman" "19","bitcoinjs-lib" "19","aedes" "19","filestructure" "19","padding-oracle-attack" "19","flex-builder-3" "19","ngrep" "19","constraintlayout-guideline" "19","uitextrange" "19","constraint-handling-rules" "19","constraintexception" "19","ng-lightning" "19","aero-snap" "19","binding.pry" "19","nexus6" "19","bincode" "19","binary-diff" "19","self-healing" "19","nginx-rtmp" "19","selenium-side-runner" "19","uniscribe" "19","uniquery" "19","apache-whirr" "19","chop" "19","select-xml" "19","nginx-log" "19","jspeex" "19","ng2-pdf-viewer" "19","celerity" "19","apoc" "19","uniface" "19","apiato" "19","selectmanylistbox" "19","pandasgui" "19","unattend-file" "19","cds.copernicus" "19","unfoldingmap" "19","configurationproperty" "19","ngcomponentrouter" "19","adapt" "19","apipie" "19","python-manylinux" "19","js-data-angular" "19","xml-spreadsheet" "19","run-sequence" "19","ruport" "19","django-1.2" "19","picoblaze" "19","careplicatorlayer" "19","smart-tv-alliance" "19","firefox-nightly" "19","smd" "19","python-reflex" "19","firefox-sidebar" "19","physfs" "19","administrative" "19","xmlpoke" "19","kubernetes-jenkins-plugin" "19","xmllite" "19","vs-android" "19","kuka-krl" "19","kurento-media-server" "19","kwicks" "19","kxml" "19","displaymode" "19","impromptu-interface" "19","display-cutouts" "19","datetimerangefield" "19","v-play" "19","import-table" "19","vpd" "19","rxfire" "19","adobe-extension" "19","rxbluetooth" "19","jsm" "19","aws-deeplens" "19","callisto" "19","cam-pdf" "19","jpath" "19","angular-theming" "19","agda-stdlib" "19","vegas-viz" "19","iasyncdisposable" "19","angular-mdl" "19","facebook-node-sdk" "19","datagridviewlinkcolumn" "19","r-ppp" "19","value-iteration" "19","myro" "19","data-importer" "19","validator.js" "19","uploadstring" "19","pure-react-carousel" "19","mysql-command-line-client" "19","ora-01031" "19","ruby-gnome2" "19","methodaccessexception" "19","ruby-daemons" "19","servemux" "19","serpapi" "19","jms2" "19","rro" "19","public-members" "19","vaadin-touchkit" "19","rs.exe" "19","gota" "19","keycloak-admin-client" "19","keyfilter" "19","grails-resources-plugin" "19","mysql-pconnect" "19","unreliable-connection" "19","psd2" "19","namedparameterjdbctemplate" "19","opnsense" "19","oracle-service-cloud" "19","unocss" "19","fallocate" "19","kicad" "19","fastcgi++" "19","fastcall" "19","sharejs" "19","oracle-integration-cloud" "19","sitecore-social-connected" "19","kindle-kdk" "19","microsoft.extensions.configuration" "19","react-use-gesture" "19","far" "19","django-mssql-backend" "19","avr-studio5" "19","angularjs-ng-style" "19","database-comparison" "19","session-per-request" "19","avr-studio4" "19","vb-like-operator" "19","crossbeam" "19","vbcodeprovider" "19","cross-context" "19","aws-resource-group" "19","wincache" "19","dogecoin-api" "19","canjs-control" "19","waterlock" "19","row-value-expression" "19","aws-scp" "19","watij" "19","robocup" "19","ora-01861" "19","django-fsm" "19","nanoscroller" "19","pycups" "19","data-capture" "19","avdepthdata" "19","dataconnect" "19","servicemonitor" "19","variable-product" "19","service-management" "19","single-shot-detector" "19","serviceknowntype" "19","service-installer" "19","pyalsaaudio" "19","rpgmakermv" "19","icr" "19","capturestream" "19","carbon-emacs" "19","data-formatters" "19","routedcommand" "19","nanogallery" "19","cardinality-estimation" "19","nspreferencepane" "19","bottomtabs" "19","simd-library" "19","inline-namespaces" "19","blazor-hosted" "19","postgresql-8.0" "19","spring-integration-ftp" "19","payment-services" "19","pear-mail" "19","cpanel-uapi" "19","nspec" "19","demoscene" "19","onutterancecompleted" "19","bootstrap-image-gallery" "19","sass-lint" "19","createdibsection" "19","blender-2.76" "19","module-packaging" "19","neodynamic" "19","jurassic" "19","gulp-jscs" "19","blitz.js" "19","degrafa" "19","saleslogix" "19","enomem" "19","blinkid" "19","braintree-data" "19","nsgradient" "19","nservicebus6" "19","blend-2012" "19","boost-context" "19","delphi-mocks" "19","nested-checkboxes" "19","input-method-kit" "19","paypal-plus" "19","inittab" "19","bodypix" "19","pattern-finding" "19","hsc2hs" "19","spring-boot-starter-security" "19","openapi.net" "19","application-scope" "19","application-role" "19","spring-modules" "19","bpftrace" "19","boxy" "19","android-shortcutmanager" "19","twarc2" "19","jrecord" "19","surface-controller" "19","deriveddata" "19","grunt-contrib-htmlmin" "19","turbopack" "19","mongodb-schema" "19","android-sharesheet" "19","entity-groups" "19","intldateformatter" "19","swf-decompiler" "19","android-vts" "19","earth-movers-distance" "19","svg-font" "19","dv360" "19","azure-blueprints" "19","wpr" "19","invalidprogramexception" "19","erlang-escript" "19","svn-merge-reintegrate" "19","ioptionsmonitor" "19","suptitle" "19","tynamo" "19","wso2-msf4j" "19","dust-helpers" "19","turbojpeg" "19","swank-clojure" "19","two-legged" "19","jqueryi-ui-buttonset" "19","couch-cms" "19","grpc-dart" "19","axure" "19","wsc" "19","amazon-silk" "19","newforms" "19","type-stability" "19","sgmlreader" "19","wingdings" "19","magiczoomplus" "19","newrelic-synthetics" "19","librarian" "19","windsor-nhfacility" "19","javascript-oscillator" "19","google-api-explorer" "19","window-tester" "19","framework-design" "19","google-bigquery-java" "19","koa-passport" "19","async-onprogressupdate" "19","rfc1123" "19","amethyst" "19","javaloader" "19","netlist" "19","raspberry-pi-os" "19","foundry-phonograph" "19","viennacl" "19","wordpress-ecommerce" "19","system-f" "19","rdiff-backup" "19","form.io" "19","javafx-17" "19","vinyl-ftp" "19","foundry-actions" "19","formatmessage" "19","freefem++" "19","rautomation" "19","typesafe-actions" "19","pyiron" "19","winrt-httpclient" "19","netiq" "19","octane" "19","mirah" "19","virtio" "19","fosjsroutingbundle" "19",".net-services" "19","extjs6.5.1" "19","syndication-item" "19","winpdb" "19","shakespeare-text" "19","formsy-material-ui" "19","oracle-warehouse-builder" "19","video-effects" "19","newlisp" "19","buffer-objects" "19","java-assist" "19","orbbec" "19","typescript2.8" "19","lua-lanes" "19","java-custom-serialization" "19","dom-selection" "19","vlckit" "19","o3d" "19","codefresh" "19","vlad-deployer" "19","lwuit-textarea" "19","microsoft-partnercenter-java" "19","virtualquery" "19","visionos-simulator" "19","system.drawing.common" "19","abaddressbooksource" "19","pyrocms-lex" "19","rightjs" "19","razorlight" "19","richpush" "19","vmt" "19","code-profiling" "19","ouya" "19","analytics-for-apache-hdp" "19","kommunicate" "19","domain-aliasing" "19","nvrtc" "19","nxopen" "19","mindsdb" "19","lesscss-resources" "19","code-splitting-async" "19","audiowaveform" "19","outerwidth" "19","nexe" "19","google-analytics-campaign-builder" "19","rc2-cipher" "19","kronecker-product" "19","java-text-blocks" "19","amz-sagemaker-distributed-training" "19","4store" "19","attachmate-extra" "19","oauth-refresh-token" "19","netpbm" "19","f2c" "19","cocoascript" "19","nxbre" "19","domainkeys" "19","orthanc-server" "19","gcallowverylargeobjects" "19","polipo" "19","android-cling" "19","h5p" "19","tagify" "19","mobx-persist" "19","explicit-intent" "19","busy-loop" "19","tiptip" "19","tizen-sdk" "19","ntvdm" "19","dotras" "19","openshift-pipelines" "19","gymnasium" "19","android-compose-image" "19","tabmenu" "19","tlc" "19","assignment-problem" "19","nopcommerce-4.1" "19","scrapysharp" "19","hallo-js" "19","taskservice" "19","nosql-injection" "19","plt-redex" "19","plt" "19","gcp-databricks" "19","tau-prolog" "19","reference-collapsing" "19","android-gnss" "19","android-go" "19","uipopoverbackgroundview" "19","openide" "19","tcm" "19","contextify" "19","vertx4" "19","exclusionpath" "19","regl" "19","mockito-inline" "19","aspnetcoretemplatepack" "19","asmselect" "19","gegl" "19","hardware-port" "19","reflexil" "19","diarization" "19","drawnow" "19","c++builder-2007" "19","sqlmail" "19","itunesconnect-analytics" "19","mobilefirst-console" "19","rack-cache" "19","direct-initialization" "19","sqlroleprovider" "19","sqlite-journal-mode" "19","uibackgroundmode" "19","openwebstart" "19","c++filt" "19","garb-gem" "19","scala-script" "19","gargle" "19","quire-api" "19","j2html" "19","itemprocessor" "19","c1001" "19","dexmaker" "19","numerical-recipes" "19","sql-azure-federations" "19","sql-azure-alerts" "19","diffstat" "19","isomorphic-style-loader" "19","hiveserver2" "19","isoneway" "19","hive-table" "19","tnef" "19","uilaunchimagefile" "19","ui-leaflet" "19","mmix" "19","x10" "19","spurious-wakeup" "19","railsinstaller-windows" "19","devpartner" "19","buzz" "19","diego" "19","xact" "19","jandex" "19","dsoframer" "19","xcodegen" "19","cfinput" "19","cfindex" "19","react-material-ui-form-validator" "19","ios-9-beta3" "19","terraform-import" "19","cfpreferences" "19","splitpanel" "19","spml" "19","terraform-provider-docker" "19","speedment" "19","google-cloud-recommendation" "19","spoonacular" "19","cfselect" "19","central" "19","omf" "19","terraform-provider-oci" "19","pgdb" "19","specter" "19","storage-access-api" "19","lars" "19","resharper-2016" "19","storyboard-reference" "19","google-cloud-colab-enterprise" "19","laravel-herd" "19","test-double" "19","testdrivendesign" "19","http-auth" "19","custom-collection" "19","string-building" "19","gesturelistener" "19","resourcestring" "19","perl-prove" "19","textformat" "19","cupertino-widgets" "19","textpattern" "19","response.transmitfile" "19","text-to-html" "19","periscope" "19","elasticsearch-snapshot" "19","textual" "19","resque-retry" "19","angular2-styleguide" "19","rest-firebase" "19","zyte" "19","leaky-abstraction" "19","angular-bootstrap-calendar" "19","command-execution" "19","acrylic-material" "19","getfileversion" "19","learning-locker" "19","action-caching" "19","actionhero" "19","angularjs-events" "19","angularjs-decorator" "19","pending-transition" "19","actionsheetpicker" "19","pytype" "19","react-date-range" "19","lotus-wcm" "19","project-navigator" "19","pythreejs" "19","react-canvas" "19","collectionbase" "19","lorenz-system" "19","office-dialog-api" "19","lsm-tree" "19","promiscuous-mode" "19","event-channel" "19","character-codes" "19","lorem-ipsum" "19","propertychangesupport" "19","qcursor" "19","propertypath" "19","moviecliploader" "19","loopingselector" "19","qsa" "19","qformlayout" "19","odoo-enterprise" "19","react-google-places-autocomplete" "19","merge-file" "19","chainable" "19","evaluation-function" "19","react-graph-vis" "19","longhorn" "19","spectator" "19","cfstoredproc" "19","memory-sanitizer" "19","qprogressdialog" "19","cgrectintersectsrect" "19","qore" "19","vaadin-fusion" "19","imagecreatefromjpg" "19","webnfc" "19","conferencing" "19","zope.component" "19","mediaprojectionmanager" "19","flux-machine-learning" "19","google-ios-vision" "19","webkit-transition" "19","emacs-ediff" "19","heroku-review-app" "19","linea-pro" "19","conditional-attribute" "19","avatar-generation" "19","subquery-factoring" "19","sortdirection" "19","zipfoundation" "19","ijetty" "19","startup-folder" "19","maven-indexer" "19","image.createimage" "19","web-folders" "19","dart-stream" "19","here-ios" "19","linemanjs" "19","flutter-reorderable-listview" "19","quantumgrid" "19","starling-server" "19","strtoull" "19","md-card" "19","yui-menu" "19","cvlib" "19","bell-curve" "19","search-engine-api" "19","automatic-mixed-precision" "19","gloo" "19","haskell-ffi" "19","automatic-variable" "19","autocreate" "19","benthos" "19","glip" "19","sedna" "19","seektotime" "19","hasura-jwt" "19","argument-matcher" "19","git-secret" "19","mqx" "19","stumbleupon" "19","compile-static" "19","mediacenter" "19","ietf" "19","trailing-newline" "19","parquet.net" "19","bgiframe" "19","autoquery-servicestack" "19","maxstringcontentlength" "19","google-maps-ios-utils" "19","solid" "19","traefik-authentication" "19","sonarqube-plugin" "19","bicep" "19","google-loader" "19","archive-tar" "19","solrclient" "19","uwb" "19","arbre" "19","quantconnect" "19","powerpoint-interop" "19","shdocvw.internetexplorer" "19","zfdoctrine" "18","locallib" "18","markov-random-fields" "18","class-attribute" "18","ecb-pattern" "18","intercom.js" "18","dce" "18","matmul" "18","backfire" "18","antlrv3ide" "18","loadmask" "18","graphql-ws" "18","grobid" "18","prisma-binding" "18","load-link-store-conditional" "18","yellow-pages" "18","flex-charts" "18","groovy++" "18","ebay-net-sdk" "18","pgtap" "18","sly-scroller" "18","feature-tracking" "18","clusterpoint" "18","slt" "18","react-pagination" "18","remote-mysql" "18","process-mining" "18","jellyfin" "18","wiegand" "18","flourishlib" "18","fluid-mac-app-engine" "18","teamcity-5.0" "18","vuejs-transition-group" "18","jdeveloper-11g" "18","ansi-nulls" "18","primary-interop-assembly" "18","jdoodle" "18","ddt" "18","react-native-sensors" "18","stackunderflow" "18","weak-entity" "18","apache-commons-dateutils" "18","jbake" "18","tree-rotation" "18","insightly" "18","ggstatsplot" "18","phpstorm-2016.3" "18","instagramapi-mgp25" "18","apache-arrow-cpp" "18","standardanalyzer" "18","tensorflow-extended" "18","php-toolkit" "18","treeline" "18","wheelcollider" "18","transplant" "18","gfsh" "18","tree-grammar" "18","telerik-window" "18","fbrequest-form" "18","cloudant-sdp" "18","reportviewerformvc" "18","citrus-engine" "18","mxunit" "18","whitesource" "18","gino" "18","travis-ci-api" "18","triple-equals" "18","reportico" "18","reportdocument" "18","php-opencloud" "18","github-services" "18","gifsicle" "18","sizehint" "18","backup-sqldatabase" "18","clbeacon" "18","size-reduction" "18","jconfirm" "18","telerik-editor" "18","ecmascript-temporal" "18","repast-hpc" "18","bangla-font" "18","clcircularregion" "18","wid" "18","pageasynctask" "18","pagecontext" "18","bin-folder" "18","freewalljs" "18","firefox2" "18","frontpage-extensions" "18","manuals" "18","cast-iron" "18","syncfusion-blazor-sfgrid" "18","constinit" "18","aerospike-loader" "18","bindingflags" "18","firefox6" "18","python-anyio" "18","langchain4j" "18","xdcr" "18","xml-rpc.net" "18","nexus-js" "18","pageshow" "18","uiviewanimation-curve" "18","uiwindowscene" "18","app-ads.txt" "18","chrome-aws-lambda" "18","python-redmine" "18","nftw" "18","ng2-completer" "18","pixabay" "18","apache-torque" "18","ccscrollview" "18","fxsl" "18","ultratree" "18","freshbooks-api" "18","fxcop-customrules" "18","fullscreenchange" "18","python-phonenumber" "18","nginx-cache" "18","connect-direct" "18","celery-canvas" "18","python-pbr" "18","jsr311" "18","iminuit" "18","unidecoder" "18","conic-gradients" "18","mapfish" "18","makemessages" "18","smartxls" "18","impacket" "18","confluent-rest-proxy" "18","cdsw" "18","unfiltered" "18","first-level-cache" "18","first-normal-form" "18","discountasp" "18","biztalk-schemas" "18","catalystcloudscale" "18","bizagi" "18","disconnected-session" "18","flatlaf" "18","jsonfx" "18","syck" "18","imx7" "18","bittorrent-sync" "18","smips" "18","bitsets" "18","symbolicc++" "18","fselector" "18","sming" "18","kusto-java-sdk" "18","chronological" "18","app-engine-modules" "18","flask-graphql" "18","caucho" "18","bitmapencoder" "18","causalml" "18","pjl" "18","lamemp3" "18","chef-attributes" "18","filesystemexception" "18","firecracker" "18","python-sql" "18","vscode-calva" "18","dbca" "18","jsonpath-plus" "18","php-webdriver" "18","ximea" "18","index.html" "18","symfony-serializer" "18","docker-selenium" "18","faulted" "18","rstudio-connect" "18","inet-ntop" "18","cakephp-3.5" "18","jfreechart-fx" "18","rspec-api-documentation" "18","jfreereport" "18","shared-module" "18","jgap" "18","docker-cp" "18","sharedsizegroup" "18","falsy" "18","sharelatex" "18","verificationexception" "18","docassemble" "18","rsample" "18","jmesa" "18","venia" "18","rubygame" "18","rqda" "18","dmalloc" "18","camel-rest" "18","dmake" "18","capture-list" "18","variable-binding" "18","camera-intrinsics" "18","join-hints" "18","camus" "18","agora-cloud-recording" "18","wildfly-cluster" "18","crossdomain-request.js" "18","cross-device" "18","wildfly-maven-plugin" "18","hyperledger-fabric-orderer" "18","nanobind" "18","micronaut-openapi" "18","reconcile" "18","akka-fsm" "18","updatebatchsize" "18","django-jet" "18","mybinder" "18","gopherjs" "18","google-widget" "18","ora-12899" "18","unstage" "18","real-time-java" "18","session-keys" "18","dask-jobqueue" "18","django-openid-auth" "18","servlet-dispatching" "18","airsim" "18","ora-02291" "18","named-constructor" "18","readonly-variable" "18","kephas" "18","serverless-framework-offline" "18","real-ip" "18","rocket-u2" "18","metismenu" "18","unowned-references" "18","key-rotation" "18","purifycss" "18","database-inspector" "18","metawidget" "18","servicedcomponent" "18","mysql-error-1364" "18","unobserved-exception" "18","ibm-jsf" "18","ora-01843" "18","django-socketio" "18","django-hstore" "18","database-tools" "18","microsoft.extensions.hosting" "18","icmpv6" "18","upsolver" "18","akka.net-streams" "18","wallaby" "18","django-localflavor" "18","graalpython" "18","rotor" "18","agroal" "18","crossmint" "18","op-tee" "18","mysql-parameter" "18","angular-scully" "18","gotw" "18","keycloak-admin-cli" "18","angular-masonry" "18","oracle-apex-23" "18","narayana" "18","kiicloud" "18","wakatime" "18","angular-package-format" "18","rmariadb" "18","upsizing" "18","routify" "18","icann" "18","oracle-application-server" "18","django-stubs" "18","craueformflow" "18","modula-2" "18","apple-expose" "18","spring-boot-starter-parent" "18","hoverfly" "18","innobackupex" "18","pbjvision" "18","app-signing" "18","suppressfinalize" "18","html-dataset" "18","popperjs" "18","openfx" "18","peakutils" "18","nsdocktile" "18","paysafe" "18","postgresql-initdb" "18","easyphp-devserver" "18","sap-cloud-connector" "18","dynamics-crm-3" "18","surveyor-gem" "18","swagger-tools" "18","wsdl4j" "18","nest-asyncio" "18","dynamic-data-masking" "18","blazor-bootstrap" "18","pcx" "18","survivejs" "18","apple-business-manager" "18","juel" "18","pdftoppm" "18","jupyterdash" "18","booking.com-api" "18","wse2.0" "18","nestjs-exception-filters" "18","ncks" "18","ontouchstart" "18","polymorphic-variants" "18","samsung-gear-fit" "18","android-tap-and-pay" "18","nsitemprovider" "18","info-hash" "18","intersection-types" "18","sbt-buildinfo" "18","nslinguistictagger" "18","guest-executable" "18","delta-index" "18","apple-model-io" "18","mongodb-csfle" "18","nerdcommenter" "18","superslim" "18","modx-getresources" "18","n-quads" "18","azerty-keyboard" "18","worklight-mbs" "18","inputsimulator" "18","boot-animation" "18","potrace" "18","azapi" "18","gtkscrolledwindow" "18","dynamic365" "18","payfast" "18","portable-python" "18","dynamics-365-ce-onpremises" "18","inexact-arithmetic" "18","jvx" "18","dutch-national-flag-problem" "18","entityresolver" "18","nsprintinfo" "18","bleach" "18","application-singleton" "18","coypu" "18","mongobee" "18","paypal-permissions" "18","gulp-filter" "18","mongoose-os" "18","workflow-rehosting" "18","grunt-concurrent" "18","hound" "18","infura" "18","model-mommy" "18","gulp-eslint" "18","mimosa" "18","nwpathmonitor" "18","libhdfs" "18","microsoft-odata" "18","virtualdub" "18","facebook-game-groups" "18","virtuozzo" "18","rcloud" "18","system.net.websockets" "18","java-resources" "18","rational-unified-process" "18","rangeseekbar" "18","wix5" "18","codecharge" "18","netflix-nebula-plugins" "18","freelancer.com-api" "18","ueberauth" "18","otapi" "18","visx" "18","krypton" "18","kotlin-generics" "18","android-api-34" "18","aurelia-auth" "18","r-forge" "18","overhead-minimization" "18","ochamcrest" "18","cockroachcloud" "18","pyeda" "18","minimist" "18","external-secrets-operator" "18","ounit" "18","java-ffm" "18","rightscale" "18","pysphere" "18","rateyo" "18","free-command" "18","authorization-server" "18","go-libp2p" "18","pyml" "18","razorpay-andoid-sdk" "18","r-base-graphics" "18","cocotron" "18","viewaction" "18","pysmb" "18","libvips" "18","wkurlschemehandler" "18","kotlinx-html" "18","outgoing-call" "18","synthetica" "18","libusb-win32" "18","facebook-custom-audience" "18","pymesh" "18","winsnmp" "18","f#-fake-4" "18","sfhfkeychainutils" "18","pygmo" "18","table-driven" "18","cognitive-complexity" "18","objectspace" "18","ortc" "18","siemens-nx" "18","java-sealed-type" "18","lets-plot" "18","pyqtchart" "18","coin3d" "18","objectsize" "18","microsoft-live-connect" "18","python-2.2" "18","java-test-fixtures" "18","jasmine-ajax" "18","octest" "18","wordpress-block-theme" "18","macrabbit-espresso" "18","rawrabbit" "18","orderbook" "18","object-class" "18","system.web.http" "18","rc-slider" "18","abas" "18","anchor-cms" "18","andar" "18","tablehtml" "18","shopify-cli" "18","codelyzer" "18","pygame-menu" "18","setediting" "18","shinymanager" "18","wordfence" "18","viber-bot-python" "18","pyi" "18","raptor" "18","for-range" "18","oaep" "18","buddyboss" "18","vldb" "18","rapidfuzz" "18","at-sign" "18","bucket4j" "18","luaxml" "18","vexflow" "18","ispc" "18","npm-login" "18","qwebengine" "18","mjsip" "18","mixim" "18","uicontextmenuinteraction" "18","excel-writer-xlsx" "18","r3-gui" "18","sql-server-7" "18","opengl-es-lighting" "18","x10-language" "18","nps" "18","plotgooglemaps" "18","controllercontext" "18","qvt" "18","is-same" "18","notifyjs" "18","android-gradle-7.0" "18","android-gradle-3.1.0" "18","executionexception" "18","hinstance" "18","dronedeploy" "18","uigravitybehavior" "18","sql-max" "18","sceptre" "18","itunes-api" "18","plutus" "18","droidscript" "18","android-downloadable-fonts" "18","android-displaymanager" "18","sqlite-browser" "18","raddocking" "18","dry-run" "18","mod-cache" "18","quip" "18","android-concatadapter" "18","tal" "18","model-driven-app" "18","jackson-module-scala" "18","nonclient" "18","uikit-transitions" "18","expectj" "18","openseamap" "18","point-to-point" "18","jain-slee" "18","openstack4j" "18","poll-syscall" "18","openser" "18","dot-notation" "18","sciruby" "18","hmvc-codeigniter" "18","tkintermapview" "18","expo-calendar" "18","tkinter-photoimage" "18","mkusertrackingmode" "18","nsxmlparsererrordomain" "18","coolite" "18","gclient" "18","ntruencrypt" "18","numeric-textbox" "18","azuremapscontrol" "18","gcc4.6" "18","mobile-emulator" "18","nuget-update" "18","azure-management-portal" "18","ca65" "18","difference-equations" "18","mmppf" "18","asp-net-config-builders" "18","dput" "18","didfailwitherror" "18","mockgoose" "18","mobile-security" "18","numbered" "18","lparam" "18","customising" "18","stream-management" "18","streamparse" "18","euiccmanager" "18","httpbuilder-ng" "18","char-traits" "18","latte" "18","es6-generator" "18","actionmailer.net" "18","ode-library" "18","string-externalization" "18","text-database" "18","lazy-io" "18","resource-governor" "18","mender" "18","ls2j" "18","csstidy" "18","resource-utilization" "18","metacircular" "18","nilearn" "18","duplicate-detection" "18","eslint-plugin-import" "18","actionbuilder" "18","actionable-notification" "18","qcolordialog" "18","elasticui" "18","generatestaticparams" "18","mercurial-keyring" "18","android-room-migration" "18","message-bundle" "18","messageboard" "18","qscopedpointer" "18","getlocation" "18","irix" "18","android-priority-jobqueue" "18","einsum" "18","elasticsearch-2.4" "18","iron-list" "18","zxspectrum" "18","merge-strategy" "18","ctfont" "18","iphone-xr" "18","esri-oss" "18","perch" "18","launcher-icon" "18","elasticjs" "18","iplanet" "18","motionbuilder" "18","oledragdrop" "18","communication-diagram" "18","proxyfactory" "18","react-native-button" "18","monomorphism" "18","mongrel2" "18","cflogin" "18","react-native-collapsible" "18","node.io" "18","cfftp" "18","cfdictionary" "18","splitbrain" "18","laravel-livewire-wireclick" "18","okvs" "18","loop-counter" "18","monstache" "18","node-jose" "18","chamilo-lms" "18","spotify-desktop" "18","centrify" "18","google-cloud-profiler" "18","ohif" "18","sp-rename" "18","google-cloud-network-load-balancer" "18","locbaml" "18","moonsharp" "18","nodebox" "18","stoplight" "18","http-trace" "18","excel-2002" "18","terser-webpack-plugin" "18","prometheus-net" "18","reaction-commerce" "18","pf-ring" "18","spectral-clustering" "18","pf4j" "18","projekktor" "18","project-types" "18","httpretty" "18","petite-vue" "18","ios-privacy-settings" "18","cfwebsocket" "18","resharper-7.0" "18","reactive-feign-client" "18","hex-pm" "18","google-postmaster" "18","gnip" "18","gmongo" "18","qt-mfc-migration" "18","mde" "18","zopim" "18","amazon-ion" "18","mssticker" "18","glue-crawler" "18","alias-method-chain" "18","compressed-files" "18","ember-cli-rails" "18","maven-plugin-development" "18","link-checking" "18","maven-pdf-plugin" "18","heap-analytics" "18","google-license-manager" "18","foldable-devices" "18","emacs-jedi" "18","flutter-native" "18","here-traffic" "18","maven-package" "18","maxdb" "18","hasp" "18","ember.js-3" "18","git-sign" "18","concatenative-language" "18","mbrola" "18","concept-insights" "18","mediabrowser" "18","bevelled" "18","media-buttons" "18","maven-gatling-plugin" "18","maven-glassfish-plugin" "18","email-analytics" "18","mui" "18","lighthouse-ci" "18","alternateview" "18","allen-sdk" "18","concourse-resource-types" "18","complex-upset" "18","multi-camera-api" "18","concourse-fly" "18","articulate" "18","vaadin20" "18","seam-carving" "18","tidekit" "18","sourcegraph" "18","yui-grids" "18","webextension-polyfill" "18","parallel-ssh" "18","d3pie.js" "18","solus" "18","autoproxy" "18","zio-streams" "18","autoeventwireup" "18","search-dialog" "18","theme-daynight" "18","cypress-component-testing" "18","status-register" "18","startprocessinfo" "18","shelly" "18","prefixfree" "18","dangerous-request" "18","staticfilehandler" "18","static-generator" "18","araxis" "18","thruk" "18","tfs-to-tfs-migration-tool" "18","user-customization" "18","sdcalertview" "18","source-server" "18","particle.io" "18","shell-trap" "18","preroll" "18","endlessadapter" "18","tidytable" "18","struts2-s2hibernate" "18","tilesets" "18","preconnect" "18","args4j" "18","usability-testing" "18","scrollable-table" "18","passenger-apache" "18","medusa" "18","ms-reports" "18","securid" "18","link-to-function" "18","tpkeyboardavoiding" "18","stencyl" "18","autocommand" "17","annoy" "17","relative-time-span" "17","representable" "17","tensorlayer" "17","weakly-typed" "17","ansicon" "17","jenkins-generic-webhook-trigger" "17","graphengine" "17","cjuidialog" "17","webpart-connection" "17","jenkins-mstest" "17","flutter-charts" "17","stamplay" "17","clog" "17","vue3-sfc-loader" "17","backbone.paginator" "17","clustal" "17","primefaces-push" "17","slather" "17","telerik-blazor" "17","xstate-react" "17","groovlet" "17","clojure-repl" "17","ggthemes" "17","react-native-native-ui-component" "17","webpack-serve" "17","skywalking" "17","primefaces-dataexporter" "17","default-template-argument" "17","youku" "17","defaultstyleddocument" "17","multiple-cursor" "17","git-ls-remote" "17","xtabs" "17","react-native-pager-view" "17","treasure-data" "17","stacktrace.js" "17","vue-server-renderer" "17","ckeditor4" "17","termux-linux" "17","jaxl" "17","cl-who" "17","whmcs-invoice-template" "17","skrill" "17","priority-inversion" "17","squarify" "17","php-mode" "17","deepstream" "17","effector" "17","list-processing" "17","photo-management" "17","jdesktop" "17","apache-dubbo" "17","jdk-desugaring" "17","intel-advisor" "17","backgroundrb" "17","wijmo-grid" "17","interaction-design" "17","teavm" "17","grip" "17","interaction-to-next-paint" "17","jest-enzyme" "17","fcbkcomplete" "17","felgo" "17","getsystemmetrics" "17","weak-symbol" "17","livefyre" "17","baduk" "17","anonymous-pipes" "17","vuetify-loader" "17","yarn-berry" "17","wikia" "17","stackedit" "17","jemmyfx" "17","github-advanced-security" "17","ddlutils" "17","eddsa" "17","graphileon" "17","lisp-2" "17","flash-10" "17","function-try-block" "17","biztalk-services" "17","function-coverage" "17","divx" "17","contentproperty" "17","imposition" "17","constraintviolationexception" "17","api-auth" "17","pinned-site" "17","blackberry-torch" "17","xnet" "17","fusionreactor" "17","jsprettier" "17","imodeljs" "17","fiware-cep" "17","overloaded-strings" "17","contentlayer" "17","pandapower" "17","imsl" "17","incremental-static-regeneration" "17","celleditingtemplate" "17","django-activity-stream" "17","jsonidentityinfo" "17","financialinstrument" "17","p8" "17","unimrcp" "17","smartview" "17","snakebite" "17","imghdr" "17","pack-uri" "17","pin-ptr" "17","kuromoji" "17","connect-redis" "17","bindgen" "17","flannbasedmatcher" "17","bind2nd" "17","xip.io" "17","ftok" "17","bitmapframe" "17","pagetabviewstyle" "17","directus-flows" "17","bitmapfield" "17","laravel-environment" "17","chromebug" "17","binary-xml" "17","bitmapeffect" "17","social-stream" "17","cdash" "17","ng-maxlength" "17","runjettyrun" "17","rust-language-server" "17","cheshire" "17","dawg" "17","mappath" "17","ngx-select-dropdown" "17","datatextfield" "17","ngreact" "17","child-objects" "17","jsweet" "17","davinci" "17","jsr299" "17","chef-client" "17","adobe-pdf-library" "17","cbo" "17","adobe-launch" "17","ultracombo" "17","markdowndeep" "17","ngx-http-rewrite-module" "17","adium" "17","socketfactory" "17","unboundid" "17","vpi" "17","carrot" "17","js-scrollto" "17","plato" "17","mapshaper" "17","chibios" "17","dateonly" "17","sentencecase" "17","ngtools" "17","adversarial-machines" "17","vegeta" "17","angular-load-children" "17","singer-io" "17","serverless-stack" "17","cakephp-helper" "17","fallbackvalue" "17","cryptoki" "17","database-cloning" "17","camel-spring-dsl" "17","keyserver" "17","oracle-cloud-functions" "17","django-listview" "17","methodbase" "17","iclientmessageinspector" "17","realmrecyclerviewadapter" "17","oracle-enterprise-linux" "17","dladdr" "17","fakexrmeasy" "17","fakeroot" "17","windows-95" "17","microsoft-adal-angular6" "17","joomla3.8" "17","data.stackexchange.com" "17","mysql-error-150" "17","ibm-pcomm" "17","windows-build-tools" "17","metrolog" "17","real-time-systems" "17","roots-toolkit" "17","hypnotoad" "17","fast-excel" "17","r-optimization" "17","uniwebview" "17","jopendocument" "17","daru" "17","creation-pattern" "17","vdm-sl" "17","ptrdiff-t" "17","recent-screens" "17","windows-embedded-standard" "17","joy-ui" "17","ibm-wcm" "17","rudp" "17","jpeg-xr" "17","docker-proxy" "17","simpletip" "17","pstcollectionview" "17","oracle12.2" "17","unity-remote" "17","microsoft.office.interop.excel" "17","kern-invalid-address" "17","keyboard-python" "17","crossplane" "17","jkube" "17","wait-free" "17","waitforimages" "17","keyboard-wedge" "17","go-xorm" "17","django-subdomains" "17","wapiti" "17","pycorenlp" "17","gource" "17","aws-landing-zone" "17","crossroadsjs" "17","optaweb-vehicle-routing" "17","indextank" "17","wac" "17","agvtool" "17","cross-window-scripting" "17","nastran" "17","django-supervisor" "17","warren-abstract-machine" "17","dojo-1.9" "17","django-dynamic-scraper" "17","vash" "17","go-server" "17","capedwarf" "17","akka-dispatcher" "17","aws-glue3.0" "17","roassal" "17","akka-io" "17","dnsbl" "17","vuex-module-decorators" "17","siren" "17","grafana-agent" "17","v-btn" "17","unused-functions" "17","kendo-draggable" "17","rsnapshot" "17","jolie" "17","joiner" "17","crunchy-postgresql-operator" "17","aiokafka" "17","named-scopes" "17","fast-ui" "17","unsafe-unretained" "17","ruby2d" "17","ora-01008" "17","window.crypto" "17","grails-maven" "17","mysql-error-1248" "17","readerquotas" "17","serviceinstall" "17","awesome-nested-set" "17","faults" "17","docco" "17","django-floppyforms" "17","unqlite" "17","aws-elastictranscoder" "17","shared-addin" "17","jquery-selectric" "17","neo4jrb" "17","boost-mp11" "17","swampdragon" "17","post-format" "17","postgraphql" "17","html5-clipboard-api" "17","bleve" "17","easyar" "17","kana" "17","jwt.io" "17","design-tokens" "17","svnx" "17","k2-blackpearl" "17","postcss-cli" "17","apt-key" "17","nested-fields" "17","erasure-code" "17","svnbridge" "17","internet-explorer-5" "17","gtk-textbuffer" "17","jquery-form-wizard" "17","online-storage" "17","jquery-mobile-dialog" "17","tx-dce" "17","e10s" "17","sapscript" "17","twilio-flow" "17","desktop-background" "17","bootjack" "17","oneplustwo" "17","azure-availability-zones" "17","mod-speling" "17","two-step-verification" "17","swagger-net" "17","android-virtualdisplay" "17","azure-batch-account" "17","onix" "17","sigv4" "17","bootsnap" "17","error-console" "17","dets" "17","apple-photos" "17","bootstrap-confirmation" "17","silent-post" "17","turbodbc" "17","grunt-contrib-coffee" "17","nrf52840" "17","applicationwillterminate" "17","android-scrolling" "17","ioloop" "17","opencomputers" "17","opendolphin" "17","entity-framework-designer" "17","jruby-openssl" "17","dependency-analysis" "17","inlineuicontainer" "17","grpc-swift" "17","workbox-window" "17","swift-data-modelcontext" "17","payola" "17","turi" "17","passport-github2" "17","azure-container-app-jobs" "17","android-sourcesets" "17","denotational-semantics" "17","ncqrs" "17","grunt-ember-templates" "17","pay-per-click" "17","aws-site-to-site" "17","dvi" "17","dynamiclayout" "17","tvalue" "17","nativexml" "17","kebab-case" "17","wso2-micro-gateway" "17","svg-morphing" "17","easypie" "17","crc8" "17","super-linter" "17","derived-instances" "17","nsfastenumeration" "17","boundaries" "17","bottom-type" "17","sales-tax" "17","gulp-uncss" "17","interruptions" "17","dynamic-execution" "17","pclzip" "17","springloops" "17","sc.exe" "17","blue-screen-of-death" "17","hp-exstream" "17","moditect" "17","samsung-internet" "17","inotify-tools" "17","ws-i" "17","scada-ignition" "17","easy-engine" "17","blktrace" "17","application-framework" "17","polymodel" "17","virtual-webcam" "17","amo" "17","facebook-monetization-manager" "17","visualstategroup" "17","javacameraview" "17","codeigniter-helpers" "17","frame-grab" "17","raspistill" "17",".net-4.0-beta-2" "17","magic-command" "17","asynctoken" "17","reversion" "17","virtualenv-commands" "17","codeigniter-pagination" "17","rational-developer-for-i" "17","typedjs" "17","google-chrome-android" "17","luasec" "17","windows-wpp" "17","rethinkdb-ruby" "17","mifos" "17","rbenv-gemset" "17","jasmine-spec-reporter" "17","macaulay2" "17",".net-core-authorization" "17","external-contenttype" "17","type-switch" "17","right-mouse-button" "17","amsmath" "17","wordbreaker" "17","mac-roman" "17","attrs.xml" "17","accelerated-c++" "17","coefficient-of-determination" "17","lynxos" "17","pypm" "17","magento-1.12" "17","buddy.com" "17","pyrax" "17","signalfx" "17","3d-convolution" "17","shinythemes" "17","jansi" "17","android-asynclistdiffer" "17","woodstock" "17","cocostudio" "17","asyncssh" "17","facebook-litho" "17","ripcord" "17","build-chain" "17",".refresh" "17","vite-plugin-pwa" "17","visual-assist-x" "17","pyre-check" "17","atoti" "17","form-generator" "17","raygun.io" "17","ocpsoft-rewrite" "17","shopizer" "17","dominate" "17","pygame-mixer" "17","doophp" "17","uglifycss" "17","pygui" "17","klepto" "17","kss" "17","java-synthetic-methods" "17","known-hosts" "17","system.json" "17","viewdeck" "17","syscache2" "17","koa.js" "17","ublock-origin" "17","minoccurs" "17","dompi" "17","do-not-disturb" "17","donejs" "17","ocg" "17","go-github" "17","uc4" "17","netadvantage" "17","lemur" "17","domain-forwarding" "17","go-imagick" "17","librt" "17","ory-hydra" "17","nx-angular" "17","outlook-2011" "17","nsviewanimation" "17","xaml-resources" "17","gcp-config-connector" "17","dioxus" "17","cookie-path" "17","openlayers-8" "17","openxlsx2" "17","openmv" "17","azure-service-fabric-mesh" "17","screencapturekit" "17","openstack-python-api" "17","tiny-core-linux" "17","nopcommerce-4.2" "17","numpyro" "17","dialogbasedapp" "17","ituneslibrary" "17","cooliris" "17","pnunit" "17","droid-fu" "17","tangible-t4-editor" "17","uispec4j" "17","tiny-slider" "17","drei" "17","pocl" "17","xcode6.3.2" "17","scout-sass" "17","pocodynamo" "17","azure-lab-services" "17","openwisp" "17","expect.js" "17","openstack-api" "17","mo-cap" "17","sql-generation" "17","schemabinding" "17","mobx-react-form" "17","hkdf" "17","nominal-data" "17","open-search-server" "17","jacc" "17","opentools" "17","tmxtiledmap" "17","coqui" "17","uiloader" "17","sqlbrowser" "17","spryker" "17","devextreme-react" "17","togetherjs" "17","radpanelbar" "17","gasp" "17","ca2202" "17","gateways" "17","tabular-editor" "17","jail-shell" "17","redstone.dart" "17","jackson-dataformat-yaml" "17","hidl" "17","tabslideout" "17","higher-order-types" "17","tktable" "17","xcode-archive" "17","expression-encoder-4" "17","tablib" "17","number-to-currency" "17","tlbexp" "17","copymemory" "17","nodeselector" "17","azure-task-groups" "17","openswoole" "17","jank" "17","reg-expressionvalidator" "17","tcollectionitem" "17","reference-manual" "17","haraka" "17","exception-safe" "17","dtr" "17","timeouterror" "17","vertex-buffer-objects" "17","itemspresenter" "17","time-difference" "17","as-operator" "17","aspstate" "17","drupal-alter" "17","ask-sdk" "17","pleasewait" "17","gae-userservice" "17","tcpportsharing" "17","verysleepy" "17","cadquery" "17","geany-plugin" "17","gameanalytics" "17","dialogviewcontroller" "17","cakefile" "17","asp.net-core-security" "17","referential" "17","q-value" "17","asp.net-mail" "17","sqlprofileprovider" "17","cadence-virtuoso" "17","itemcollection" "17","omniverse" "17","o-d-matrix" "17","ldc" "17","cgpathref" "17","node-glob" "17","pep3118" "17","laravel-telescope" "17","node-deasync" "17","node-dev" "17","lazyeval" "17","leantween" "17","resty" "17","eurekalog" "17","requests-per-second" "17","ios-contacts" "17","certificate-signing-request" "17","espruino" "17","event-calendar" "17","iphone7plus" "17","reservoir-sampling" "17","response.addheader" "17","reset-button" "17","evented-io" "17","nim-game" "17","ogdf" "17","pftableviewcell" "17","es6-shim" "17","pfsubclassing" "17","ninject-3" "17","ios-messages-extension" "17","lavaplayer" "17","chart-director" "17","curvycorners" "17","spreedly" "17","qf-test" "17","elevatr" "17","melt-framework" "17","mosso" "17","spip" "17","curvesmoothing" "17","react-loading-skeleton" "17","coldfusion-administrator" "17","stratum" "17","hyperas" "17","actorsystem" "17","moor" "17","prototype-oriented" "17","qabstractbutton" "17","color-tracking" "17","curtains.js" "17","terraform-provider-datadog" "17","acme.sh" "17","current-principal" "17","comautomationfactory" "17","currencymanager" "17","qdrantclient" "17","morphline" "17","mootools-fx" "17","curlftpfs" "17","httpfilecollection" "17","android-restrictions" "17","android-licenses" "17","morea-framework" "17","cua-mode" "17","dukpt" "17","google-friend-connect" "17","elasticsearch-java-api-client" "17","zxing.net.mobile" "17","property-testing" "17","react-button" "17","qqmllistproperty" "17","mercurial-revsets" "17","getclientrect" "17","common-code" "17","getconstructor" "17","logistf" "17","test-fixture" "17","lockup" "17","ternary-search" "17","log4postsharp" "17","testinfra" "17","httptestingcontroller" "17","metamug" "17","seandroid" "17","zeta-components" "17","parboiled2" "17","stubby4j" "17","automapper-11" "17","cypress-task" "17","identity-operator" "17","msloadtest" "17","std-system-error" "17","media-keys" "17","msbuild-buildengine" "17","lightadmin" "17","maven-frontend-plugin" "17","webapplicationstresstool" "17","gnucash" "17","google-sheets-vlookup" "17","git-sync" "17","sdv" "17","msbuild-projectreference" "17","webcontext" "17","bernoulli-numbers" "17","automapper-7" "17","tile-engine" "17","argo-rollouts" "17","steam-condenser" "17","gnulib" "17","autoexec" "17","url-protocol" "17","amazon-clouddrive" "17","ieditableobject" "17","hatchstyle" "17","hd44780" "17","touchescancelled" "17","styleable" "17","havok" "17","gmisc" "17","sharppdf" "17","mdm-zinc" "17","paseto" "17","structural-equality" "17","automatic-speech-recognition" "17","user-config" "17","automatic-migration" "17","solr4j" "17","stdcopy" "17","link-prefetch" "17","bazaar-plugins" "17","quarkus-kafka" "17","zoneminder" "17","confidential" "17","bazel-gazelle" "17","toolstripcombobox" "17","bento" "17","uu-parsinglib" "17","linpack" "17","bazel-query" "17","sum-type" "17","array-flip" "17","bengali" "17","zola" "17","sparkfun" "17","ember.select" "17","linewidth" "17","dart-build" "17","fmj" "17","compss" "17","qstk" "17","font-awesome-3.2" "17","arc2" "17","for-await" "17","bencoding" "17","zkp" "17","qstringlistmodel" "17","globus-toolkit" "17","user-messaging-platform" "17","pressflow" "17","danger" "17","the-amazing-audio-engine" "17","webinar" "17","spark-skinning" "17","tiers" "17","autodesk-data-visualization" "17","damerau-levenshtein" "17","papaya" "17","emsdk" "17","dailybuilds" "17","theme-development" "17","query-engine" "17","starcounter" "17","ilookup" "17","sugar.js" "17","userland" "17","glowscript" "17","d3tree" "17","ember-cp-validations" "17","d3-graphviz" "17","tika-python" "16","anthropic" "16","groove" "16","pg-notify" "16","babel-plugin-module-resolver" "16","wear-os-tiles" "16","clojure-testing" "16","jbchartview" "16","react-native-tvos" "16","skfieldnode" "16","fieldmanager" "16","groovysh" "16","phassetslibrary" "16","cloud-pak-for-data" "16","mutablecapabilities" "16","cloudpickle" "16","file-forks" "16","vue-cookies" "16","maven-1" "16","maturity" "16","matterport" "16","matio" "16","groupie" "16","react-phone-number-input" "16","apache-druid" "16","clpq" "16","yjs" "16","photon-fusion" "16","clpr" "16","sized-box" "16","back-projection" "16","mxchip" "16","vue-strap" "16","vue-socket.io" "16","yolonas" "16","clusterize" "16","clsx" "16","github-classroom" "16","slider-revolution" "16","flutter-floor" "16","integerupdown" "16","github-check-run" "16","report-viewer2016" "16","trifecta" "16","trifacta" "16","tridion-core-services" "16","littler" "16","srilm" "16","xshell" "16","fenv" "16","feel-language" "16","remap-istanbul" "16","gremlin-java" "16","square-wire" "16","fdr" "16","multipart-alternative" "16","fedora-29" "16","ggbreak" "16","flowgorithm" "16","remodal" "16","decision-model-notation" "16","multipartconfig" "16","wijgrid" "16","annotorious" "16","installshield-2008" "16","relate" "16","graphql-java-tools" "16","list-template" "16","trng" "16","ecmascript-2021" "16","wexitstatus" "16","decap-cms" "16","wevtutil" "16","remote-client" "16","remote-connections" "16","skylark" "16","remote-input" "16","load-generator" "16","floating-action-menu" "16","renderman" "16","tsup" "16","anormcypher" "16","default-package" "16","graphql-spring-boot" "16","default-initialization" "16","smalot-datetimepicker" "16","treecell" "16","weed-fs" "16","fhir-net-api" "16","yattag" "16","jsmin" "16","fileparse" "16","flang" "16","appcelerator-cli" "16","piral" "16","pageloadtimeout" "16","apache-spark-1.3" "16","consoleappender" "16","ladon" "16","finger-tree" "16","xqilla" "16","playhaven" "16","xnat" "16","nexus-player" "16","nhibernate-4" "16","afbedsheet" "16","main-bower-files" "16","immediate-attribute" "16","flashmedialiveencoder" "16","image-translation" "16","flask-apispec" "16","pinterest-api" "16","cassini-dev" "16","pagedcollectionview" "16","bing-webmaster-tools" "16","laravel-encryption" "16","ngondestroy" "16","mark.js" "16","cimage" "16","castle-windsor-3" "16","voice-detection" "16","swipe.js" "16","software-estimation" "16","overridependingtransition" "16","casyncsocket" "16","ngx-international-phone-number" "16","flesch-kincaid" "16","pigeon" "16","contactgroups" "16","aegir" "16","socketio4net" "16","flask-user" "16","pixman" "16","sencha-test" "16","swrlapi" "16","adsense-anchor-ads" "16","addmodelerror" "16","ngx-clipboard" "16","safariwatir" "16","smartmeter" "16","ngsw-config" "16","firewall-access" "16","adaptive-dialogs" "16","picat" "16","mapguide" "16","python-fire" "16","conkeror" "16","chiliproject" "16","selectonelistbox" "16","cdatabase" "16","ng2-tag-input" "16","direct-runner" "16","directorystream" "16","chinese-postman" "16","jtest" "16","python-arrow" "16","ng-img-crop" "16","python-iptables" "16","undici" "16","cctexturecache" "16","disposing" "16","fundamental-matrix" "16","api-linkpreview" "16","umbraco-forms" "16","jsr363" "16","unirest-java" "16","ng2-google-chart" "16","plasmo" "16","django-cookies" "16","seleniummanager" "16","xmlignore" "16","paintbox" "16","selectboxit" "16","xmonad-contrib" "16","adobe-bridge" "16","functx" "16","circular-slider" "16","jsonx" "16","xmltransient" "16","kyma" "16","unite.vim" "16","fixup" "16","ada95" "16","datetimeparseexception" "16","swift-regexbuilder" "16","python-module-unicodedata" "16","aiven" "16","microsoft-graph-cloudcommunications" "16","valdr" "16","canoo" "16","window-size" "16","pycxx" "16","urchin" "16","ora-01830" "16","canvas3d" "16","kendo-splitter" "16","dockable-windows" "16","kendo-timepicker" "16","ops4j" "16","prunsrv" "16","ps2exe-gui" "16","pusherswift" "16","alexa-account-linking" "16","readstata13" "16","validating-event" "16","read-fwf" "16","nakama" "16","value-of-css-property" "16","ruby-style-guide" "16","puppetlabs-mysql" "16","ora-01000" "16","updatedate" "16","ora-00955" "16","akka-zeromq" "16","reasoned-schemer" "16","kitty" "16","facebook-widgets" "16","simplyscroll" "16","ora-00913" "16","kint" "16","r-promises" "16","sipml5" "16","ora-12541" "16","pubmed-api" "16","wall-time" "16","ahp" "16","r-mapedit" "16","keycloak-authorization-services" "16","keycloak-javascript" "16","goproxy" "16","wasp" "16","docx-to-pdf-conversion" "16","gradle-properties" "16","aws-mediaservices" "16","robotframework-browser" "16","grafana-mimir" "16","django-packages" "16","aggregators" "16","servlet-4" "16","mysql-error-1046" "16","service-virtualization" "16","sharepoint-listtemplate" "16","document-types" "16","meta-title" "16","servicemodelex" "16","django-multiselectfield" "16","fast-xml-parser" "16","meteor-easy-search" "16","watson-virtual-agent" "16","ibm-installation-manager" "16","database-reconciliation" "16","jooby" "16","crictl" "16","keystore-access" "16","keyword-expansion" "16","ibm-rad-7.5" "16","document-based-database" "16","ropc" "16","joox" "16","keyword-spotting" "16","camel-blueprint" "16","camel-jdbc" "16","jpanelmenu" "16","windows-mui" "16","mysqlrouter" "16","faraday-oauth" "16","vector-class-library" "16","mysql-error" "16","docksal" "16","mysql-regexp" "16","jpf" "16","sequelize-hooks" "16","docsy" "16","mysqlpp" "16","awscognitotoken" "16","microsoft-expression" "16","rosters" "16","htsql" "16","in-memory-oltp" "16","bluetooth-keyboard" "16","payeezy" "16","nb-iot" "16","interspire-shopping-cart" "16","pdf2json" "16","spring-content-community-project" "16","ionic2-providers" "16","springdoc-openapi-maven-plugin" "16","awtutilities" "16","nest-winston" "16","simevents" "16","mod-lua" "16","defn" "16","power-apps-custom-connector" "16","oneget" "16","blog-post" "16","android-tabstrip" "16","wwan" "16","initializr" "16","postgresapp" "16","onrowclick" "16","opencyc" "16","azure-ad-domain-services" "16","android-wear-3.0" "16","htmlwriter" "16","jqpagination" "16","near-cache" "16","silverlight-embedded" "16","bluedata" "16","internetsetoption" "16","android-studio-flamingo" "16","gsubfn" "16","blockhound" "16","jquery-datatables-checkboxes" "16","karma-typescript" "16","blkid" "16","initwithframe" "16","dev-appserver-2" "16","paytabs" "16","bluno" "16","grunt-exec" "16","svg-react-loader" "16","jquery-context" "16","two-phase-commit" "16","postgresql-8.1" "16","mod-pywebsocket" "16","ncommon" "16","salesforce-rest-api" "16","htmltable-control" "16","kairos-api" "16","application-monitoring" "16","salesforce-sfdx" "16","dvajs" "16","monero" "16","scalaj-http" "16","hostvars" "16","workdir" "16","sbt-docker" "16","corrupted-state-exception" "16","azure-devops-artifacts" "16","twentytwenty" "16","satellite-navigation" "16","infyom" "16","couchbase-ottoman" "16","cppdepend" "16","nsincrementalstore" "16","mongo-connector" "16","mongolian-vertical-script" "16","tuist" "16","couchbase-nodejs-sdk" "16","corepack" "16","hostheader" "16","gulp-changed" "16","bounds-check-elimination" "16","desktop-recording" "16","native-maven-plugin" "16","twilio-autopilot" "16","epd-python" "16","worksite-sdk" "16","entity-framework-4.3.1" "16","boost-sml" "16","spring-internationalization" "16","jquery-lint" "16","entra" "16","azure-dev-spaces" "16","nsmutableorderedset" "16","neo4j-php-ogm" "16","neo4j-plugin" "16","easylogging++" "16","tuprolog" "16","syscache" "16","cocoapods-1.2" "16","mailgun-api" "16","shoryuken" "16","codepad" "16","javapolicy" "16","pytest-selenium" "16","shouldautorotate" "16","significant-terms" "16","vip" "16","browserify-rails" "16","kronos-workforce-central" "16","object-equality" "16","macos-mail-app" "16","reverting" "16","code-regions" "16","mageia" "16","out-of-source" "16","misuse" "16","knockout-es5-plugin" "16","cocos2d-swift" "16","mini-xml" "16","mindsphere" "16","f#+" "16","typescript3.8" "16","occurs-check" "16","ramda-fantasy" "16","kotlinx.coroutines.channels" "16","kotlin-when" "16","object-state" "16","amos" "16","mission-planner" "16","riak-ts" "16","vis-timeline" "16","pyfilesystem" "16","rancheros" "16","oberon" "16","javax-validation" "16","shape-rendering" "16","overlap2d" "16","facebook-ios-sdk-4.0" "16","kotlin-function-type" "16","typescript2.3" "16","lxc-docker" "16","f#-4.0" "16","raw-file" "16","abcl" "16","rethinkdbdash" "16","reviver-function" "16","dolby-audio-api" "16","ordered-set" "16","authorization-header" "16","asyncimageview" "16","leda" "16","oai-pmh" "16","sfc" "16","atlassian-forge" "16","libfaac" "16","android-api-33" "16","viewdraghelper" "16","netcobol" "16","google-barchart" "16","android-appstandby" "16","wordpress-4.5.2" "16","ubuntu-19.10" "16","revokeobjecturl" "16","vim-ale" "16","vimclojure" "16","rgtk2" "16","amazon-translate" "16","synopsis-detect" "16","rich-media" "16","java-vertx-web" "16","pygmaps" "16","objective-git" "16","google-ajax-libraries" "16","rhinoceros" "16","netlib" "16","pygbag" "16","rawurl" "16","dom-if" "16","neura" "16","libstrophe" "16","libspatialindex" "16","javafx-bindings" "16","nokia-wrt" "16","exchange-server-2019" "16","taglet" "16","registry-virtualization" "16","wxstring" "16","isuserinteractionenabled" "16","askql" "16","contextio" "16","jabberd2" "16","radphp" "16","high-level-architecture" "16","polykinds" "16","xcore" "16","histogram-of-oriented-gradients" "16","rad-server" "16","azure-workflow-automation" "16","nuget-package-manager-console" "16","holoeverywhere" "16","node-uuid" "16","scnvector3" "16","cordite" "16","redis-rails" "16","npm-private-modules" "16","hg-log" "16","vgo" "16","dotnet-new" "16","azure-web-app-firewall" "16","hashtree" "16","hashrocket" "16","control-charts" "16","expression-body" "16","quickjs" "16","nvidia-isaac" "16","spritely" "16","convector" "16","quicksilver" "16","gatsby-cloud" "16","spriteview" "16","asp.net-core-css-isolation" "16","bulk-create" "16","refinitiv-eikon-api" "16","drupal-distributions" "16","control-library" "16","dev-tunnels" "16","ref-parameters" "16","openstack-juno" "16","mkmapcamera" "16","asp.net-mvc-migration" "16","plsql-psp" "16","gcp-notebook" "16","notificationlistenerservice" "16","iso-639" "16","xamlx" "16","hookrouter" "16","gcp-compute-instance" "16","plunit" "16","drupal-zen" "16","hipe" "16","itrs" "16","drwatson" "16","redex" "16","gamesalad" "16","nsxmlparserdelegate" "16","tolua++" "16","iso8583-1993" "16","sched-deadline" "16","openinfowindowhtml" "16","azure-service-plan" "16","ntfs-3g" "16","rabbitmq-stream" "16","plotly.net" "16","digital-handwritting" "16","droidparts" "16","scrapy-item" "16","digital-downloads" "16","modbus-rtu-over-tcp" "16","gameclosure" "16","redux-selector" "16","dry-validation" "16","plnkr.co" "16","nuget-package-explorer" "16","business-application" "16","android-compound-view" "16","xcf" "16","digestive-functors" "16","nuget-cli" "16","isolated-scope" "16","double-brace-initialize" "16","scorm-cloud-api" "16","openrtsp" "16","tokenize2" "16","context-info" "16","wxmathplot" "16","open-webkit-sharp" "16","cube-dimension" "16","montgomery-multiplication" "16","react-laravel" "16","responsive-nav" "16","lazycache" "16","esp-now" "16","mercury-mta" "16","onactionexecuted" "16","layout-xml" "16","collaboration-diagram" "16","spinwait" "16","ctabitem" "16","elasticsearch-bulk" "16","message-authentication-code" "16","offline.js" "16","launch-time" "16","elastic-mq" "16","metacello" "16","comint-mode" "16","cfnetworking" "16","iriscouch" "16","restlet-2.3.1" "16","angular-dynamic-forms" "16","iron-form" "16","commerceserver2007" "16","python-winshell" "16","elaboration" "16","react-native-datetimepicker" "16","spectacle" "16","angular-abstract-control" "16","perlapp" "16","node-repl" "16","log4shell" "16","httpsys" "16","requiressl" "16","periodformatter" "16","lock-guard" "16","zuul-ci" "16","node-odbc" "16","eway" "16","lolcode" "16","accessibility-inspector" "16","string-metric" "16","loopback3" "16","everlive" "16","string-catalog" "16","stretchdibits" "16","loose-typing" "16","loupe" "16","httpconfiguration" "16","acitree" "16","ios9-today-widget" "16","streaminghttpresponse" "16","google-cloud-language" "16","ls-colors" "16","google-cloud-instances" "16","odfdom" "16","google-cloud-cpp" "16","event-b" "16","ios-searchapi" "16","elinks" "16","mellon" "16","evc4" "16","evaporate.js" "16","element-binding" "16","memory-overcommitment" "16","monocle" "16","acts-as-follower" "16","cups4j" "16","qdoc" "16","cumulative-distribution-function" "16","android-navhostfragment" "16","android-ndk-r4" "16","android-pagedlistview" "16","cuda.net" "16","certreq" "16","qcommandlineparser" "16","einops" "16","chart.js-datalabels" "16","proofs" "16","chartpanel" "16","character-reference" "16","spa-template" "16","duckduckgo-api" "16","nmock2" "16","prose" "16","moxiemanager" "16","text-mask" "16","laravel-sitemap" "16","project-server-2007" "16","protected-resource" "16","tomcat-juli" "16","nixops" "16","geometrydrawing" "16","get-filehash" "16","getpwuid" "16","spec#" "16","protector" "16","cgihttpserver" "16","iroutehandler" "16","prolog-defaulty" "16","moss2007enterprisesearch" "16","cgpdfscanner" "16","getschematable" "16","step-through" "16","ember-validations" "16","mcedit" "16","seamless-immutable" "16","tpersistent" "16","searchable-dropdown" "16","glcanvas" "16","hedera" "16","sonarqube7" "16","amazon-sagemaker-debugger" "16","static-dispatch" "16","stingray" "16","tidyterra" "16","fluture" "16","as-if" "16","benfords-law" "16","mrv2" "16","imagedecoder" "16","presenceinsights" "16","scrolltoindex" "16","stig" "16","ascii85" "16","maven-wrapper" "16","ember-paper" "16","bert-toolkit" "16","heatwave" "16","mca" "16","bemsimplelinegraph" "16","google-sheets-charts" "16","sonarqube-4.0" "16","sdef" "16","power-state" "16","lifetimes-python" "16","torchmetrics" "16","thoughtbot" "16","sourceanalyser" "16","embedded-coder" "16","lightning-network" "16","pgmagick" "16","medial-axis" "16","subtext" "16","quantified-constraints" "16","user-instance" "16","flutter-path" "16","d3-cloud" "16","autotouch" "16","ziggy" "16","userjs" "16","iiviewdeckcontroller" "16","bcolz" "16","mediaplayerelement" "16","msstickerview" "16","google-jax" "16","google-instant" "16","forcing" "16","dangling-else" "16","google-health" "16","dapper-fluentmap" "16","imagehandler" "16","alire" "16","znodes" "16","weblogic-maven-plugin" "16","batch-fetching" "16","multi-database-connections" "16","user-secret" "16","uthash" "16","fontspec" "16","solid-start" "16","stdbool" "16","linkurious" "16","quarkus-hibernate-orm" "16","tools-for-apache-cordova" "16","sharpen-tool" "16","subsonic-simplerepository" "16","bfloat16" "16","beef" "16","user-extensions.js" "16","customstringconvertible" "16","argument-matching" "16","compiler-compiler" "16","embla-carousel" "16","arduino-uno-wifi" "16","argp" "16","webby" "16","transactional-database" "16","zend-session-namespace" "16","help-authoring" "16","sharpffmpeg" "16","partial-sort" "16","emf-compare" "16","sortcomparefunction" "16","google-persistent-disk" "16","partitioned-view" "16","state-dict" "16","cvsimport" "16","helpshift" "15","gitlab-ci-trigger" "15","graphql-mesh" "15","graphql-relay" "15","badboy" "15","react-oidc" "15","term-vectors" "15","vue-slider-component" "15","xt" "15","xtea" "15","render-html" "15","backup-agent" "15","reporting-services-map" "15","mvxlistview" "15","flutter-beamer" "15","cluster-manager" "15","terminate-handler" "15","mxnet-gluon" "15","tensorflow-android" "15","jaxer" "15","mat-chip" "15","efpocoadapter" "15","eframe" "15","ghc-pkg" "15","tenacity" "15","phplot" "15","ghcjs-dom" "15","mat-drawer" "15","weld-junit5" "15","git2-rs" "15","inspect.exe" "15","treestore" "15","stagewebviewbridge" "15","git-assume-unchanged" "15","git-authentication" "15","inspinia" "15","react-native-instagram-login" "15","git-completion" "15","ggnewscale" "15","ballerina-composer" "15","ssis-data-flow" "15","material-swift" "15","websphere-ce" "15","cloud-haskell" "15","git-dangling" "15","instantmessenger" "15","transform-stream" "15","cloudkit-js" "15","sitemapnode" "15","website-metrics" "15","trezor" "15","stanford-parser" "15","file-icons" "15","srv-record" "15","gexperts" "15","integer-hashing" "15","terminal-ide" "15","sqwrl" "15","fcgid" "15","fciv" "15","cmultifileupload" "15","relevanssi" "15","loaderlock" "15","dbms-xmlgen" "15","ansible-pull" "15","background-clip" "15","react-simple-keyboard" "15","c-mode" "15","tsavedialog" "15","teamcity-6" "15","gridding" "15","yammer-api" "15","ddpg" "15","react-pose" "15","ckshare" "15","livedocx" "15","teamstudio-unplugged" "15","v-stepper" "15","react-sidebar" "15","ckrecordzone" "15","yahoo-search" "15","phonegap-admob" "15","preverify" "15","jersey-3.0" "15","yii-cformmodel" "15","eclipse-2020-06" "15","dbimport" "15","lita" "15","cmaltimeter" "15","eclipse-fragment" "15","jdic" "15","fedora-28" "15","localsocket" "15","slimselect" "15","listof" "15","vssconverter" "15","baseweb" "15","llrp" "15","debian-7.6.0" "15","cm" "15","matplotlib.mlab" "15","llvm-4.0" "15","mvvmfx" "15","class-dbi" "15","ansys-apdl" "15","mvw" "15","xtraeditors" "15","discord-rpc" "15","funcunit" "15","ngx-gallery" "15","firrtl" "15","picaxe" "15","filevault" "15","sygic-mobile-sdk" "15","runtime-identifier" "15","safe-bool-idiom" "15","vndocumentcameraviewcontroller" "15","fishtown-analytics" "15","django-2.x" "15","python-lru-cache" "15","owl-date-time" "15","runtimemodification" "15","flask-smorest" "15","jsvalidation" "15","jsonlogic" "15","python-fabric-2" "15","python-pex" "15","picamera2" "15","cifacefeature" "15","black-code-formatter" "15","swipecardview" "15","python-decimal" "15","cifar100" "15","xmlupdate" "15","cardspace" "15","adornment" "15","cardscrollview" "15","fitvids" "15","volta" "15","django-auditlog" "15","python-bleak" "15","image-science" "15","kubernetes-dns" "15","laravel-airlock" "15","django-cache-machine" "15","language-studio" "15","smartsheet-c#-sdk-v1" "15","cassandra-stress-tool" "15","snowboy" "15","datastax-csharp-driver" "15","rule-of-zero" "15","mail-mime" "15","jsgauge" "15","flambo" "15","imports-loader" "15","xml-error" "15","rust-rustlings" "15","mailsystem.net" "15","picqer-exact-php-client" "15","firebase-genkit" "15","fizzler" "15","flag-secure" "15","map-basic" "15","jsr172" "15","configuration-as-code" "15","dirtyrectangle" "15","packetdotnet" "15","selectcheckboxmenu" "15","semicolon-inference" "15","undecidable-instances" "15","pact-python" "15","apache-marmotta" "15","nexus-5x" "15","page-loading-message" "15","xinu" "15","next-translate" "15","player-stage" "15","cedar-bdd" "15","fileresponse" "15","sendable" "15","symfony-config-component" "15","pamie" "15","page-flow" "15","apertium" "15","unifiednativeadview" "15","synced-folder" "15","pidcrypt" "15","django-environ" "15","unreal-gameplay-ability-system" "15","windows-sbs" "15","awesome-typescript-loader" "15","r-shinylive" "15","unsemantic-css" "15","varint" "15","carbon-components" "15","car-analogy" "15","grafana-plugin" "15","mysema" "15","keybase" "15","angular-pagination" "15","vue-tsc" "15","canjs-component" "15","react-to-pdf" "15","react-templates" "15","oraclejdk" "15","py-amqplib" "15","aiobotocore" "15","robobinding" "15","jgiven" "15","gradle-node-plugin" "15","sis" "15","gradle-managed-device" "15","ruby-kafka" "15","gradle-kts" "15","windows-live-mail" "15","update-post-meta" "15","jqote" "15","ruby-characters" "15","oracle-home" "15","crowdflower" "15","wildfly-21" "15","gradle-2" "15","jiffy" "15","optical-drive" "15","iactivescript" "15","uprobe" "15","mysql-error-1075" "15","mysql-error-1071" "15","govmomi" "15","wagtail-pageurl" "15","gpudirect" "15","dmcs" "15","gpu-cooperative-groups" "15","alfresco-ldap" "15","pycountry-convert" "15","jitcode-jitcdde-jitcsde" "15","sitecore-habitat" "15","jjs" "15","canonical-name" "15","wcf-rest-starter-kit" "15","mfe" "15","reassign" "15","face-landmark" "15","ibook-author" "15","rpscreenrecorder" "15","oracle8" "15","ruby-upgrade" "15","simulte" "15","dashclock" "15","publisher-policy" "15","rubyinstaller" "15","puppet-bolt" "15","roofline" "15","wbr" "15","keras-vggface" "15","fandjango" "15","fastinfoset" "15","metric-fu" "15","kinetica" "15","publify" "15","joml" "15","mic-1" "15","rodio" "15","public-fields" "15","hyperledger-cello" "15","nag-fortran" "15","ruby-1.9.1" "15","oracle-bpm-suite" "15","creators-update" "15","i18next-browser-languagedetector" "15","ptv-developer" "15","service-level-agreement" "15","simpl-schema" "15","recent-documents" "15","cspack" "15","service-operations" "15","wcf-faults" "15","rubocop-rspec" "15","ics-openvpn" "15","service-pack" "15","kingsoft" "15","aws-jwt-authorizer" "15","push-queue" "15","jpicker" "15","farpoint" "15","datadesign" "15","ibm-eventstreams" "15","turtle-mock" "15","nsdatecomponent" "15","app-search" "15","ionic-native-http" "15","kefir.js" "15","nested-tibble" "15","sus" "15","tymon-jwt" "15","corporate-policy" "15","tutum" "15","azure-eventhub-client" "15","depth-camera" "15","svgz" "15","ionic-serve" "15","ionic-material" "15","nativescript-codesharing" "15","jquery-rotate" "15","htc-hero" "15","dynamics-sl" "15","invalidselectorexception" "15","mojo-sdk" "15","dynamic-dll-import" "15","openacs" "15","dynamic-expresso" "15","android-tablet-layout" "15","tvar" "15","twemoji" "15","ephesoft" "15","design-data" "15","aws-sftp" "15","dynamic-schema" "15","kcov" "15","samsung-galaxy-watch" "15","demand-paging" "15","gulp-shell" "15","grover" "15","inheritdoc" "15","nsight-systems" "15","appixia" "15","typedactor" "15","swift-for-tensorflow" "15","pdc" "15","wowslider" "15","juicy-pixels" "15","enzyme-to-snapshot" "15","postgresql-parallel-query" "15","opalvoip" "15","infomaker" "15","opaleye" "15","nest-dynamic-modules" "15","scala-2.7" "15","mongodb-security" "15","ncml" "15","easy-modbus" "15","kata-containers" "15","bottleneck" "15","covr" "15","grunt-build-control" "15","mod-userdir" "15","mod-verto" "15","nested-gridview" "15","deftjs" "15","nerves-project" "15","jxtaskpane" "15","modulino" "15","blazor-webapp" "15","model-inheritance" "15","swa-cli" "15","k0s" "15","path.js" "15","boost-type-erasure" "15","opencv-features2d" "15","sap-solution-manager" "15","mongoose-auto-increment" "15","desktop-integration" "15","navigateuri" "15","jquery-mobile-fieldset" "15","entity-framework-6.4" "15","deploy-keys" "15","cpm" "15","grunt-contrib-compress" "15","module-alias" "15","mongokitten" "15","wumpus-world" "15","host-object" "15","dynogels" "15","html-compression" "15","apple-help" "15","azure-ddos" "15","bootstrap-4.1.x" "15","popupcontrolextender" "15","positive-lookbehind" "15","openbadge" "15","east-text-detector" "15","kaizala-action" "15","jquery-reel" "15","bpmn-js" "15","block-programming" "15","blu-ray" "15","countly-analytics" "15","jupyter-widget" "15","inline-table-function" "15","injective-function" "15","desktopcapturer" "15","bootstrap-native" "15","coreos-ignition" "15","spring-integration-jdbc" "15","deoptimization" "15","ara" "15","entitykey" "15","neoclipse" "15","gulp-load-plugins" "15","justin.tv" "15","milter" "15","f#-charting" "15","winlibs" "15","kotlin-experimental" "15","jasperstarter" "15","bronto" "15","typeinitializer" "15","libdc1394" "15","ordercloud" "15","r-devtools" "15","shopee" "15","kognitio" "15","netmodules" "15","windward" "15","shakapacker" "15","rational-test-workbench" "15","javax.swing.text" "15","signed-overflow" "15","buddy-class" "15","rapier-3d" "15","amoeba-gem" "15","setpropertyactionlistener" "15","amazon-workdocs" "15","milton" "15","retained-in-memory" "15","windows-subsystem-for-android" "15","lwuit-dialog" "15","rawbytestring" "15","java-22" "15","bufferunderflowexception" "15","libcst" "15","signal-protocol" "15","win-prolog" "15","ami.js" "15","audeering-opensmile" "15","pygraph" "15","rdf-star" "15","r-doredis" "15","netbeans-15" "15","code-intelligence" "15","typerex" "15","typedi" "15","format-currency" "15","ocamldoc" "15","kooboo" "15","audioworkletprocessor" "15","code-testing" "15","migx" "15","rfc6749" "15","libudev" "15","java-process-runtime" "15","javaexec-gradle-plugin" "15","fabric-answers" "15","freefair-aspectj" "15","analytics-for-hadoop" "15","r-box" "15","free-diameter" "15","aurelia-store" "15","microsoft-machine-learning-server" "15","wkhttpcookiestore" "15","typescript-namespace" "15","golfscript" "15","external-assemblies" "15","nxjs" "15","pykde" "15","winui-xaml" "15","foundry-scenarios" "15","pysmt" "15","pysocks" "15","express-winston" "15","facebook-conceal" "15","dolphin-smalltalk" "15","express-ws" "15","android-asset-delivery" "15","objectivezip" "15","authlogic-oauth" "15","android-appwidget-list" "15","nevron" "15","kuali" "15","synset" "15","otroslogviewer" "15","javahg" "15","least-astonishment" "15","uiaccessoryview" "15","java-micro-editon-sdk3.0" "15","obscured-view" "15","mincemeat" "15","rfc1035" "15","dollar-quoting" "15","viewpoint" "15","mahjong" "15","objectpath" "15","cocos2d-iphone-2.x" "15","klist" "15",".net-fiddle" "15","microstack" "15","windows-shell-extension-menu" "15","wm-concat" "15","google-apps-activity" "15","rio" "15","udb" "15","riot-os" "15","pyexcelerate" "15","less-rails" "15","oscache" "15","do-not-track" "15","retrytemplate" "15","lync-server-2013" "15","buildmanager" "15","asynctest" "15","absl-py" "15","uiaction" "15","dialog-framework" "15","dotnet-format" "15","sqlmigrations" "15","drupal-cache" "15","high-volume" "15","gunit" "15","number-recognition" "15","xcode6.0.1" "15","scenejs" "15","gwmodel" "15","dreamservice" "15","azure-iot-hub-device-update" "15","scikit-plot" "15","isolation-frameworks" "15","digitization" "15","scalene" "15","reddot" "15","hirb" "15","dexopt" "15","dibs" "15","nvdec" "15","sqf" "15","express-ntlm" "15","iview-ui" "15","scalameter" "15","gamut" "15","mobilefirst-mtw" "15","diffbot" "15","uifeedbackgenerator" "15","uidatepickermodetime" "15","istorage" "15","is-uploaded-file" "15","dto-mapping" "15","uielementcollection" "15","cordova-2.7.0" "15","azure-metrics-advisor" "15","dragtarget" "15","android-compose-appbar" "15","android-compose-dropdownmenu" "15","drakma" "15","non-public-selectors" "15","tinysort" "15","tap-harness" "15","pnp-framework" "15","hadoopy" "15","azure-mobile-engagement" "15","openoffice-api" "15","pmw" "15","gcp-alerts" "15","assembly-name" "15","pluto-grid" "15","mlabwrap" "15","tasmota" "15","reference-cycle" "15","hamming-window" "15","version-control-keywords" "15","android-gradle-2.2" "15","mockserver-netty" "15","gcp-secret-manager" "15","hanami-model" "15","caeagllayer" "15","reference-library" "15","execute-as" "15","contenttypes" "15","reference-source" "15","general-protection-fault" "15","tcptrace-pocketsoap" "15","tdatasetprovider" "15","generalized-method-of-moments" "15","cag" "15","azure-regions" "15","azure-performancecounters" "15","asl" "15","dropdownlistview" "15","gc-roots" "15","regexserde" "15","playstation-portable" "15","cake-bake" "15","hardware-design" "15","geckosdk" "15","control-template" "15","uilayoutguide" "15","drupal-domain-access" "15","openssl-net" "15","expo-splash-screen" "15","sptbxlib" "15","spsitedataquery" "15","tmail" "15","uimafit" "15","gwtmockito" "15","tlsharp" "15","buybutton.js" "15","tablesaw" "15","gwt-visualization" "15","nodester" "15","dsofile" "15","expo-module" "15","uimodalpresentationformsh" "15","expo-eas" "15","device-compatibility" "15","dropwizard-guice" "15","mlvision" "15","red-system" "15","tizen-sdb" "15","azure-static-website-routing" "15","droptarget" "15","cabal-dev" "15","android-blur-effect" "15","policywrap" "15","titanium-widgets" "15","quickchart" "15","quickbuild" "15","opensearch-security-plugin" "15","peoplesoft-query" "15","ctfe" "15","angular2-build" "15","acralyzer" "15","prototype-chosen" "15","project-open" "15","react-leaflet-search" "15","actframework" "15","resulttype" "15","angular2-custom-component" "15","esphome" "15","char32-t" "15","hyperapp" "15","iphone-xs" "15","penn-treebank" "15","espocrm" "15","project-structuring" "15","message-map" "15","google-cloud-test-lab" "15","lazyframe" "15","project-valhalla" "15","elision" "15","office-web-app" "15","meio-upload" "15","lazy-propagation" "15","ios-shortcut" "15","qclipboard" "15","text-shadow" "15","gen-event" "15","iphone-sdk-4.0.1" "15","pegkit" "15","text-embedding-ada-002" "15","nodejs-polars" "15","pgbadger" "15","splitactionbar" "15","member-enumeration" "15","lcc-win32" "15","cuda-events" "15","iphone-accessory" "15","pg-ctl" "15","activerecord-jdbc" "15","node-ipc" "15","memcachier" "15","qdateedit" "15","prolog-coroutining" "15","iphone11" "15","android-multiple-apk" "15","qemu-device" "15","geolitecity" "15","cuelang" "15","centreon-api" "15","ipfs-cli" "15","ipad-playgrounds" "15","monologue" "15","react-infinite-scroll" "15","proxytunnel" "15","speaker-diarization" "15","esc-key" "15","iron-data-table" "15","node.js-napi" "15","speechkit" "15","react-native-charts-wrapper" "15","get-cli" "15","zpanel" "15","ios14.5" "15","metacpan" "15","commandinjection" "15","angularjs-authentication" "15","logminer" "15","oledbdestination" "15","logonserver" "15","commitanimations" "15","cgcontextdrawpdfpage" "15","http-negotiate" "15","mouseleftbuttonup" "15","special-form" "15","chakram" "15","perlapi" "15","zynq-ultrascale+" "15","iruby" "15","nlog.config" "15","logan-square" "15","hummingbird" "15","access-data-project" "15","evolus-pencil" "15","ipvs" "15","common-expression-language" "15","spidev" "15","node-memwatch" "15","restforce" "15","cfzip" "15","moose-technology" "15","cfwindow" "15","perwebrequest" "15","oleview" "15","nipyapi" "15","httpfs" "15","largest-contentful-paint" "15","csvde" "15","column-sizing" "15","cgi.pm" "15","property-editor" "15","log-ascii-standard" "15","lotus-designer" "15","zset" "15","google-dataform" "15","font-feature-settings" "15","fogbugz-on-demand" "15","std-expected" "15","git-rev-parse" "15","arc-lisp" "15","trace-listener" "15","usefaketimers" "15","security-identifier" "15","argocd-notification" "15","stellent" "15","force-directed-graph" "15","user-account-control" "15","mts" "15","headroom.js" "15","statsforecast" "15","fog-aws" "15","steinberg-asio" "15","solc" "15","urlsessionwebsockettask" "15","tiingo" "15","sterling-db" "15","arithabort" "15","authprovider" "15","traefik-routers" "15","haskell-streaming" "15","user-information-list" "15","ietf-bcp-47" "15","urlscan" "15","glassfish-4.1.1" "15","autobahnjs" "15","forerunnerdb" "15","iesi-collections" "15","qshortcut" "15","composite-application" "15","foreigner" "15","gns3" "15","flutter-web3" "15","web-application-security" "15","identifying-relationship" "15","screen-time" "15","embperl" "15","cuvid" "15","google-playground" "15","zend-form-select" "15","preact-cli" "15","pass-by-reference-value" "15","web-app-manifest" "15","partytown" "15","amazon-acl" "15","beanstream" "15","emacsw32" "15","license-maven-plugin" "15","id-card" "15","cyberneko" "15","msinfo32" "15","cycript" "15","zenodo" "15","parseexcel" "15","webdeploy-3.5" "15","powershell-provider" "15","powershell-hosting" "15","zerolog" "15","powershell-7.4" "15","google-managed-prometheus" "15","parameter-object" "15","elm-signal" "15","spark-webui" "15","mediaquery" "15","pantone" "15","tgridpanel" "15","topcoat" "15","mspgcc" "15","eloqua-bulk-api" "15","dapper-simplecrud" "15","webkitrequestfullscreen" "15","mediaview" "15","linfu" "15","linkchecker" "15","linksys" "15","artemis" "15","msas" "15","amazon-linux-extras" "15","google-street-view-static-api" "15","mtktextureloader" "15","artifact-deployer" "15","z39.50" "15","amazon-inspector" "15","gluonts" "15","tidb-pd" "15","zaber" "15","tidal-scheduler" "15","sublime-syntax" "15","globalevent" "15","google-sdm-api" "15","as86" "15","sdata" "15","subnormal-numbers" "15","prefast" "15","gmplot" "15","helidon-webclient" "15","sony-audio-control-api" "15","ember-power-select" "15","amazon-ec2-spot-market" "15","ember-select" "15","array-comparison" "15","custom-search-provider" "15","custom-stories" "15","thunar" "15","stateful-actor-service" "14","rehosting" "14","rehypejs" "14","flot.tooltip" "14","pgu" "14","vue3-carousel" "14","cloudflare-turnstile" "14","phpsh" "14","wdqs" "14","loaderinfo" "14","skygear" "14","fiddler-everywhere" "14","webviewdidfinishload" "14","sklearn2pmml" "14","class-designer" "14","transparent-control" "14","php-printer" "14","weak-head-normal-form" "14","jest-expo" "14","fhs-twitter-engine" "14","babashka" "14","babel-babylon" "14","ginac" "14","vstesthost" "14","skopeo" "14","wedge" "14","ghprb" "14","local-node-modules" "14","fgetpos" "14","jbi" "14","file-loader" "14","vue3-openlayers" "14","vue-authenticate" "14","tslib" "14","trepan" "14","phantomjs-node" "14","reqif" "14","jboss-rules" "14","flowground" "14","ferry" "14","sleekxmpp" "14","website-admin-tool" "14","github-actions-services" "14","github-actions-workflows" "14","jemos-podam" "14","reliable-dictionary" "14","reliable-multicast" "14","truthy" "14","vue-tel-input" "14","civicrm-extension" "14","php-8.3" "14","phonegap-developer-app" "14","cmfcribbonpanel" "14","cknotification" "14","jchart2d" "14","vuejs-routing" "14","remote-assistance" "14","wiener-filter" "14","vuelayers" "14","class-relationship" "14","photospicker" "14","flutter-button" "14","smart-commits" "14","slsvcutil" "14","removable" "14","smaato" "14","feature-clustering" "14","intercom-ios" "14","deadline-timer" "14","process-migration" "14","privileged-functions" "14","xsuperobject" "14","edge-runtime" "14","procobol" "14","grid.js" "14","yolk" "14","react-slingshot" "14","dd4t" "14","apache-falcon" "14","telerik-radlistbox" "14","multiscroll.js" "14","edifabric" "14","mate-desktop" "14","annotatorjs" "14","profunctor" "14","intellij-platform-psi" "14","multi-value-dictionary" "14","react-native-map-clustering" "14","telerik-datepicker" "14","preview-pane" "14","clojureql" "14","gridlength" "14","deconstructor" "14","mvc.jquery.datatables" "14","dbms-redefinition" "14","antlrworks2" "14","matlabcontrol" "14","installr" "14","inspections" "14","greasekit" "14","telegraph" "14","deep-fake" "14","apache-james" "14","easytrieve" "14","anvil" "14","ssdl" "14","jsog" "14","cdetailview" "14","pageheap" "14","carter" "14","snapshot-view" "14","smooth-numbers" "14","swiftui-navigation" "14","rx-javafx" "14","cassandra-node-driver" "14","directory-upload" "14","platform-independence" "14","jssh" "14","platform-detection" "14","smoke" "14","makegood" "14","frontity" "14","dispatchworkitem" "14","xgoogle" "14","flare3d" "14","ngx-swiper-wrapper" "14","swiftui-alert" "14","sn" "14","python-envoy" "14","mapdispatchtoprops" "14","flamelink-cms" "14","chatsdk" "14","jsyn" "14","imageset" "14","appcelerator-acs" "14","js-scrollby" "14","jsjac" "14","mapmyfitness" "14","labelled-generic" "14","labelfunction" "14","label-for" "14","unity3d-cloud-build" "14","dbext" "14","self-documenting-code" "14","playgrounds" "14","conntrack" "14","jtooltip" "14","inappsettings" "14","fixed-format" "14","snowballanalyzer" "14","mailsettings" "14","paillier" "14","vrvideoview" "14","ultidev" "14","unison-lang" "14","apache-twill" "14","apollo-link-rest" "14","pakyow" "14","palantir-foundry-security" "14","datastax-search" "14","phundament" "14","rust-embedded" "14","rust-diesel-mysql" "14","soap-serialization" "14","firefox-57+" "14","fuelphp-routing" "14","firelens" "14","kubeflow-kserve" "14","firefox-addon-bootstrap" "14","firefox-addon-overlay" "14","apdex" "14","rust-2018" "14","pandadoc" "14","pike" "14","chunkypng" "14","contactsui" "14","mapbox-static-maps" "14","p4eclipse" "14","python-o365" "14","chatgpt-plugin" "14","owin.security" "14","jsonelement" "14","xlrelease" "14","blackberry-os5" "14","pingouin" "14","addcallback" "14","symfony-translator" "14","distutils2" "14","switchcontrol" "14","jstockchart" "14","flex2" "14","xlet" "14","add-custom-target" "14","file-sorting" "14","xlsx-js" "14","symja" "14","flatten-pdf" "14","ngredux" "14","smart-listing" "14","file-saver" "14","function-query" "14","sofia-sip" "14","ccc" "14","ng-dropdown-multiselect" "14","jsc3d" "14","void-safety" "14","flatui" "14","bitrock" "14","smtp-server" "14","swiftype" "14","bitpay" "14","playback-rate" "14","ngtoast" "14","vaadin-testbench" "14","aif360" "14","windows-embedded-8" "14","django-ratings" "14","rtl-language" "14","nant-task" "14","ag-charts-react" "14","mylyn-wikitext" "14","kinto" "14","mysql-error-1451" "14","dlm" "14","key-storage" "14","aws-mediastore" "14","aws-ios" "14","rtw" "14","nameservice" "14","mysql-error-1170" "14","kigg" "14","mysql-error-1049" "14","name-length" "14","rtmpd" "14","windows-phone-sl-8.1" "14","call-flow" "14","win32serviceutil" "14","nam" "14","aion" "14","django-lfs" "14","django-rules" "14","r-text" "14","unityvs" "14","vendoring" "14","avcapturephotosettings" "14","csproj-user" "14","red5-recorder" "14","vb-power-pack" "14","angularjs-q" "14","vue-treeselect" "14","routedevents" "14","ice4j" "14","simpleioc" "14","fakeweb" "14","csdl" "14","cscfg" "14","google-trusted-stores" "14","ibm-datacap" "14","cs0246" "14","angular-rc5" "14","angular-router-events" "14","crystal-reports-export" "14","roundedcorners-dropshadow" "14","oracle-rdb" "14","vector2" "14","vc10" "14","angular-touch" "14","session-reuse" "14","session-replay" "14","grails-2.0.4" "14","animsition" "14","session-less" "14","fastclick" "14","serilog-expressions" "14","vc90" "14","serverfbml" "14","document-directory" "14","hystrix-dashboard" "14","fastify-swagger" "14","metricsgraphicsjs" "14","database-fragmentation" "14","method-combination" "14","server-side-sync" "14","meteor-collection-hooks" "14","serviceextension" "14","datadirect" "14","metapost" "14","grammy" "14","napa" "14","dlt-daemon" "14","sitecore-commerce-server" "14","pychef" "14","pychecker" "14","gpuarray" "14","iauthorizationfilter" "14","pycel" "14","updatepanel-progressbar" "14","wampsharp" "14","validform" "14","react-universal" "14","captured-variable" "14","indy-node" "14","react-vis-network" "14","jmathplot" "14","read-access" "14","ora-01036" "14","verizon" "14","ora-01403" "14","gouraud" "14","card-flip" "14","ora-01461" "14","single-source" "14","indexwriter" "14","gradcam" "14","facebook-public-feed-api" "14","css-layer" "14","gradientstop" "14","docker-aws" "14","alamofire-upload" "14","wasabi-hot-cloud-storage" "14","single-abstract-method" "14","realm-studio" "14","ruby-thread" "14","crowdin" "14","rnetlogo" "14","ruby-watir" "14","alcatel-ot" "14","vensim" "14","gradle-play-publisher" "14","unity-xr" "14","gulp-jasmine" "14","nsdmanager" "14","npz-file" "14","nem" "14","crashpad" "14","wso2-choreo" "14","svggraph" "14","wso2-ml" "14","neovis" "14","ndesk.options" "14","denormal-numbers" "14","iodocs" "14","grunt-connect" "14","path-to-regexp" "14","android-seek" "14","scalafix" "14","bpg" "14","count-min-sketch" "14","invantive-query-tool" "14","createchildcontrols" "14","worhp" "14","jquery-uniform" "14","countdownevent" "14","hotfolder" "14","dependabot-script" "14","braintree-javascript" "14","intrinsicattributes" "14","grunt-init" "14","entity-data-model" "14","nscala-time" "14","neoxygen" "14","sas-gtl" "14","sas-ds2" "14","portsip" "14","andromda" "14","boost-stacktrace" "14","erc1155" "14","neo4j-shell" "14","android-xml-attribute" "14","delayed-paperclip" "14","silvershop" "14","portable-database" "14","jquery-filer" "14","twine-game-engine" "14","kademi" "14","nspr" "14","nspointerarray" "14","one-time-pad" "14","azure-arc" "14","surroundscm" "14","bootstrap-affix" "14","silk" "14","jquery-mobile-table" "14","onfocusout" "14","html.checkbox" "14","arago" "14","interix" "14","gss" "14","neocomplete" "14","sigqueue" "14","applescript-studio" "14","azure-application-proxy" "14","swagger-play2" "14","mojoportal" "14","on-lisp" "14","htcondor" "14","devel-nytprof" "14","bootstrap-toast" "14","ept" "14","hslf" "14","in-place-editor" "14","nsimagecell" "14","android-studio-giraffe" "14","bot-emulator" "14","infection" "14","epf" "14","bluetooth-5" "14","svg-rect" "14","svg-salamander" "14","onset-detection" "14","bosch-iot-suite" "14","jquery-triggerhandler" "14","epilogue" "14","oodb" "14","hql-delete" "14","design-surface" "14","episerver-find" "14","typebox" "14","hping" "14","postgres-11" "14","twig.js" "14","spring-cloud-deployer-kubernetes" "14","pdfpage" "14","gulp-webpack" "14","pcov" "14","svg-pattern" "14","brio" "14","jasmine-matchers" "14","kotlin-maven-plugin" "14","ktpass" "14","vmime" "14","observable-plot" "14","kotlin-logging" "14","brother-bpac" "14","abmultivalue" "14","objectbox-java" "14","coffeekup" "14","pyelftools" "14","codebird" "14","f#-3.1" "14","kotlin-contracts" "14","visa-api" "14","pygmentize" "14","javonet" "14","vliw" "14","accent-color" "14","pyexcelerator" "14","overlay-view" "14","mac-dashboard-widget" "14","vitis-ai" "14","facebook-account-kit" "14","3dr" "14","aad-pod-identity" "14","asyncappender" "14","dokka" "14","codexl" "14","misfire-instruction" "14","setdlldirectory" "14","r-collapse" "14","kostache" "14","rcall" "14","microsoft-search-server" "14","ucma2.0" "14","andengine-gles-2" "14","brownfield" "14","microsoft-live-meeting" "14","bruno" "14","ksonnet" "14","attachment-field" "14","midas-server" "14","async-graphql" "14","browser-based" "14","netmon" "14","objgraph" "14","kovan" "14","luxonis" "14","kongregate" "14","maestro" "14","visualstudio.testtools" "14","system.web.mail" "14","nettle" "14","bricscad" "14","rich-communications-services" "14","domain-calculus" "14","ringout" "14","facebook-graph-api-v2.5" "14","authkit" "14","codemaid" "14","facebook-graph-api-v2.6" "14","fpdf2" "14","pygubu" "14","pyhf" "14","rates" "14","lua-resty-openidc" "14","pyper" "14","minibufexplorer" "14","magma-ca" "14","random-testing" "14","pypdf4" "14","shaped-window" "14","shoulda-matchers" "14","r-graphviz" "14","rfc2396" "14","showuserlocation" "14","asyncpostbackerror" "14","google-base" "14","buildforge" "14","winprt" "14","java.security" "14","wordperfect" "14","java-scripting-engine" "14","miniport" "14","libfuse" "14","sgp4" "14","vimium" "14","rfc4180" "14","netcoreapp2.1" "14","videosdk.live" "14","raspbian-wheezy" "14","javascript-date" "14","shinycssloaders" "14","wonderpush" "14","jautodoc" "14","asyncpraw" "14","orcid" "14","mailinator" "14","network-storage" "14","goconvey" "14",".net-core-sdk" "14","form-editing" "14","shopifyscripts" "14","frameless" "14","lumen-routing" "14","minio-client" "14","typescript-5" "14","withcontext" "14","foxids" "14","pyke" "14","kloudless" "14","sysdatetime" "14","viewmodelfactory" "14","pyprocessing" "14","systemd-nspawn" "14","winpty" "14","magiczoom" "14","woocommerce-email" "14","system-generator" "14","typeshed" "14","vim-go" "14","coldfusion-6" "14","google-business-profile" "14","object-inspector" "14","radicale" "14","asp.net-core-staticfile" "14","hardware-infrastructure" "14","mkcoordinatespan" "14","x2go" "14","uidocumentmenuvc" "14","azure-in-role-cache" "14","spuser" "14","nonatomic" "14","dictview" "14","dicttoxml" "14","asn1crypto" "14","tailrecursion-modulo-cons" "14","mknetworkengine" "14","noncharacter" "14","diffsharp" "14","mobileme" "14","hirefire" "14","sp-who2" "14","gulp-zip" "14","dex2oat" "14","hangfire-console" "14","azure-text-translation" "14","point-in-time-recovery" "14","wxlua" "14","azure-packaging" "14","nsurldownload" "14","qxmpp" "14","wx.html2" "14","ntt" "14","azure-tableclient" "14","mode-analytics" "14","tcpmon" "14","r3f" "14","tcomponent" "14","plop" "14","handbrakecli" "14","redips.drag" "14","redhat-datagrid" "14","hopper" "14","uiprintinfo" "14","polar-plot" "14","mobilink" "14","quotaguard" "14","hootsuite" "14","sqlake" "14","spring-surf" "14","uiactionsheetdelegate" "14","direct-buffer" "14","sqljocky" "14","diode" "14","azure-service-runtime" "14","task-tracking" "14","assembly.reflectiononly" "14","timetk" "14","tkinter.text" "14","jackson-annotations" "14","modal-logic" "14","moarvm" "14","uipi" "14","quicken" "14","polyglot-notebooks" "14","hiawatha" "14","android-httptransport" "14","executestorequery" "14","scnlight" "14","drupal-node-hook" "14","exide" "14","scosta" "14","drupal-roles" "14","highperformance" "14","gcc5.2" "14","drupal-behaviors" "14","xcode9-beta5" "14","xamarin-component" "14","scalala" "14","dropshadoweffect" "14","drop-cap" "14","sciter" "14","gbdk" "14","exceptionfilterattribute" "14","xaml-composition" "14","scrapyd-deploy" "14","drag-event" "14","buzz.js" "14","xcode-tools" "14","expansion-files" "14","g729" "14","android-compose-dialog" "14","dropdownchecklist" "14","bwwalkthrough" "14","ispeech" "14","bytedeco-javacv" "14","convox" "14","dsx-desktop" "14","android-bubbles" "14","on-disk" "14","node-gcm" "14","react-image-lightbox" "14","android-jetpack-compose-modifier" "14","electric-fence" "14","activex-documents" "14","node-github" "14","io-ts-library" "14","mp3agic" "14","qrubberband" "14","nmi" "14","nmatrix" "14","etimedout" "14","activitypub" "14","elementary-functions" "14","memurai" "14","re2c" "14","httpuv" "14","geographic-lib" "14","ipaas" "14","eglibc" "14","log-forging" "14","textexpander" "14","react-alt" "14","ios10.3.2" "14","log4c" "14","octobercms-user-plugin" "14","strongly-typed-enum" "14","prometheus-python-client" "14","resharper-2017" "14","laravel-jwt" "14","performance-estimation" "14","getpasswd" "14","strobe-media-playback" "14","hyperfilesql" "14","pfsense" "14","react-effects" "14","odk-xform" "14","google-cloud-asset-inventory" "14","mozilla-prism" "14","logrocket" "14","strava-api-v3" "14","movewindow" "14","nircmd" "14","stripe-customer-portal" "14","requirehttps" "14","google-cloud-auth" "14","strcat-s" "14","evo" "14","prooph" "14","googledns" "14","tesseract-5.x" "14","acr1252" "14","textboxlist" "14","google-cloud-node" "14","requestify" "14","google-cloud-proxy" "14","streamex" "14","streaming-analytics" "14","requestly" "14","google-cloud-vm" "14","chainercv" "14","getschema" "14","combinedchart" "14","qbuffer" "14","elasticsearch-river" "14","spleeter" "14","omnikey" "14","react-masonry" "14","elastic-network-interface" "14","textrank" "14","cgns" "14","ohlcv" "14","cucumber-cpp" "14","ipycytoscape" "14","textswitcher" "14","android-rendering" "14","iphone-8" "14","angular2-modal" "14","omnicontacts-gem" "14","chartnew.js" "14","terraform-loop" "14","irate" "14","mercurial-phases" "14","node-expat" "14","mercurial-api" "14","cfimport" "14","ctransformers" "14","project-gutenberg" "14","cfhttpparam" "14","column-chooser" "14","cudpp" "14","spinach" "14","android-monitor" "14","layoutpanels" "14","spatial-regression" "14","qdesktopservices" "14","speedglm" "14","om-next" "14","spinalhdl" "14","lateinit" "14","offsite" "14","restxq" "14","elastislide" "14","colordrawable" "14","nikola" "14","texture-packing" "14","commodity" "14","android-layout-direction" "14","android-largeheap" "14","geocaching" "14","cgan" "14","specialized-annotation" "14","ipp-qbd-sync" "14","collibra" "14","layout-engine" "14","android-jetpack-security" "14","cfdump" "14","project-conversion" "14","tfs-aggregator" "14","hexchat" "14","weboptimizer" "14","multicorn" "14","fmodf" "14","qshareddata" "14","heroku-ssl" "14","sourcesafe-6.0" "14","v2ray" "14","touch-typing" "14","bigloo" "14","embedded-control" "14","sonarqube-5.5" "14","emacs25" "14","tf.dataset" "14","webpack-mix" "14","conditional-binding" "14","elm-ui" "14","sugarcube" "14","starkit" "14","bigcommerce-checkout-sdk" "14","helenus" "14","here-autocomplete" "14","sonic" "14","iis-arr" "14","threetenabp" "14","tibco-gi" "14","bin2hex" "14","toscawidgets" "14","startup-probe" "14","web3php" "14","static-text" "14","state.go" "14","flutter-typeahead" "14","tilecache" "14","web3swift" "14","imagebitmap" "14","avaudiosessioncategory" "14","msan" "14","array-view" "14","search-multiple-words" "14","glpi" "14","searchactivity" "14","alliedvision" "14","ember-concurrency" "14","yui-uploader" "14","sealedsecret" "14","bcc-compiler" "14","quantities" "14","amazonica" "14","msbuild-itemgroup" "14","zipexception" "14","bcg" "14","beginanimations" "14","befunge" "14","sdl.net" "14","preference-v7" "14","powermta" "14","qubes-os" "14","qtopcua" "14","amazon-ecr-public" "14","parameterinfo" "14","precompiled-templates" "14","scribus" "14","gnu-apl" "14","amazon-cloudwatch-synthetics" "14","identity-delegation" "14","preact-router" "14","google-play-console-beta" "14","parameter-list" "14","zfdatagrid" "14","measurestring" "14","particle.js" "14","beanstalkc" "14","cy.intercept" "14","cycle-plugin" "14","google-native-ads" "14","ppd" "14","google-maps-android-api-1" "14","quadrilaterals" "14","paravirtualization" "14","altiris" "14","zentyal" "14","google-maps-compose" "14","autorepeat" "14","google-maps-timezone" "14","parquet-dataset" "14","alternate-access-mappings" "14","arduino-cli" "14","ietester" "14","git-non-bare-repository" "14","ieframe.dll" "14","mudselect" "14","bazel-genrule" "14","bazel-extra-action" "14","user-manual" "14","qt5.11" "14","transcendental-equation" "14","linkedblockingqueue" "14","embeddinator" "14","zoom-meeting" "14","ender" "14","alibaba-cloud-oss" "14","compileassemblyfromsource" "14","urlstream" "14","userpoints" "14","component-query" "14","bespin" "14","stickynote" "14","prestashop-helper-classes" "14","urlimageviewhelper" "14","powerbi-gateway" "14","haskell-vector" "14","stipple" "14","dart-dev-compiler" "14","tradestation" "14","haskell-polysemy" "14","styleswitching" "14","line-of-business-app" "14","autocommenting" "14","seasoned-schemer" "14","dapper-rainbow" "14","yt-project" "14","autodesk-arvr" "13","vuestic" "13","slonik" "13","truedbgrid" "13","phprunner" "13","pritunl" "13","classiejs" "13","multiple-inclusions" "13","fedora12" "13","jexceljs" "13","privategpt" "13","privateobject.invoke" "13","jcaps" "13","vue-teleport" "13","ferror" "13","base85" "13","flutter-date-range-picker" "13","react-native-tools" "13","llvm-py" "13","vuetify2" "13","phpt" "13","react-native-ui-components" "13","related-posts" "13","interface-class" "13","flutter-expanded" "13","websphere-6" "13","clpplus" "13","cockpit-cms" "13","sitefinity-3x" "13","backbase" "13","telerik-radribbonbar" "13","mathematica-7" "13","webservice-discovery" "13","photoshop-sdk" "13","xxtea" "13","fencepost" "13","apache-fineract" "13","mathcontext" "13","matchevaluator" "13","locally-abstract-type" "13","jest-image-snapshot" "13","mvcminiprofiler" "13","backing" "13","ecdsasignature" "13","jblas" "13","multitasking-gestures" "13","backgroundtaskidentifier" "13","cmd2" "13","eclipse-atl" "13","jdf" "13","react-native-modalize" "13","jepp" "13","pg-repack" "13","munge" "13","feathericons" "13","vt-x" "13","yii2-authclient" "13","eclipse-2018-09" "13","musicg" "13","yandexcloud" "13","vue-data" "13","background-drawable" "13","echoprint" "13","phonegap-gmaps-plugin" "13","gitg" "13","gitfs" "13","instascan" "13","srtm" "13","srl" "13","groebner-basis" "13","clever-cloud" "13","ssl-security" "13","clone-element" "13","ffmpy" "13","apache-camel-aws-kinesis" "13","sslv2" "13","react-redux-i18n" "13","skinny-war" "13","ssms-2005" "13","intel-inspector" "13","sstoolkit" "13","renderx" "13","intellij-2020" "13","wechat-auth" "13","gitlab-wiki" "13","renderbox" "13","wh-keyboard-ll" "13","re-natal" "13","clientcontext" "13","clay" "13","clockrates" "13","listview-filter" "13","edge-to-edge" "13","listviewgroup" "13","procps" "13","sjs" "13","rematch" "13","baresip" "13","react-os" "13","fileitem" "13","reltool" "13","web-stomp" "13","grib-api" "13","remarks" "13","wdio-jasmine" "13","edgecast" "13","claudia.js" "13","proc-format" "13","classwizard" "13","six-python" "13","interaction-plot" "13","getwindowlong" "13","livegraph" "13","anonymousidentification" "13","websphere-process-server" "13","filesysteminfo" "13","symfony-finder" "13","filenet-workplace" "13","bitdefender" "13","display-suite" "13","vrone" "13","apache-storm-flux" "13","adobe-cc" "13","underlyingtype" "13","safefilehandle" "13","data-tracing" "13","umlgraph" "13","ngx-doc-viewer" "13","date-fns-tz" "13","nhibernate-collections" "13","apache-tailer" "13","cdk8s" "13","umn-mapserver" "13","datashape" "13","adsl" "13","ngdraggable" "13","file-traversal" "13","packages.json" "13","pibase" "13","fiware-poi" "13","safe-tensors" "13","ultraesb" "13","python-requests-json" "13","fiware-perseo" "13","chatwoot" "13","xmlinclude" "13","db2-content-manager" "13","umbraco9" "13","snmpwalk" "13","cirq" "13","advanced-indexing" "13","chdatastructures" "13","kubernetes-java-client" "13","js-fancyproductdesigner" "13","checkeditems" "13","aframe-react" "13","cellbrowser" "13","admin-interface" "13","checkboxtree" "13","adhearsion" "13","manager-app" "13","jsr233" "13","semantic-comparison" "13","xhp" "13","laravel-data" "13","pixiedust" "13","constraintlayout-barrier" "13","makumba" "13","binmode" "13","laraadmin" "13","jsr170" "13","marimekko-chart" "13","cassandraunit" "13","language-recognition" "13","blackmagic-design" "13","funkload" "13","addressable-gem" "13","platform-of-trust" "13","pkcanvasview" "13","uiuserinterfacestyle" "13","swiftui-menu" "13","swiftui-map" "13","constructor-reference" "13","langsmith" "13","maniphest" "13","mambaforge" "13","apicurio-registry" "13","pinot" "13","xqj" "13","ui-validate" "13","lamson" "13","xlslib" "13","jsondoc" "13","rvg" "13","xenu" "13","lambda-prolog" "13","nexus-iq" "13","freemat" "13","console-redirect" "13","apiconnect-test-monitor" "13","jslint4java" "13","mainmenu" "13","pict" "13","bitbar" "13","xfl" "13","jscalendar" "13","datalore" "13","page-state" "13","selflanguage" "13","s3transfermanager" "13","jscep" "13","self-intersection" "13","xfermode" "13","crossterm" "13","aws-authorizer" "13","keyboard-focus" "13","crudbooster" "13","varybyparam" "13","cross-page-postback" "13","mysql-error-1050" "13","iab" "13","awilix" "13","cryptlib" "13","aiosqlite" "13","air2" "13","avsystemcontroller" "13","crysis" "13","django-saml2-auth" "13","airflow-connections" "13","hypriot" "13","create-react-kotlin-app" "13","icccm" "13","avoriaz" "13","icedtea-web" "13","alexa-interaction-model" "13","avcapturevideodataoutput" "13","iconnectionpoint" "13","mysqldbcompare" "13","valentina-studio" "13","vercel-hyper-terminal" "13","mysql-date" "13","ruby-mode" "13","verify-tests" "13","django-wysiwyg" "13","al.exe" "13","ruby-saml" "13","ruby-native-extensions" "13","django-wiki" "13","aws-emr-studio" "13","django-weasyprint" "13","rubypython" "13","django-syndication" "13","kendo-maskedtextbox" "13","kendo-ui-window" "13","aws-graviton" "13","purgecss" "13","docker.dotnet" "13","realm-net" "13","pup" "13","ptv-vissim" "13","pthread-key-create" "13","unity-test-tools" "13","recoverymodel" "13","pstricks" "13","pstats" "13","r-paws" "13","recvmsg" "13","pseudolocalization" "13","angularjs-new-router" "13","simple-oauth2" "13","simplenlg" "13","oracle-cloud-shell" "13","angular-maps" "13","oracle-export-dump" "13","simplejdbcinsert" "13","faktor-ips" "13","angular-nglist" "13","routed" "13","angular-permission" "13","routeboxer" "13","oracle-objects" "13","jplist" "13","oracle-soda" "13","angular-structural-directive" "13","doctrine-collection" "13","animatewindow" "13","fast-android-networking" "13","roslynpad" "13","joypad" "13","microclimate" "13","jotm" "13","jooq-sbt-plugin" "13","rootbeer" "13","server2go" "13","rom-rb" "13","data-access-app-block" "13","servertag" "13","watson-explorer" "13","metasyntactic-variable" "13","joda-convert" "13","data-execution-prevention" "13","datagridrow" "13","watchos-8" "13","datahub" "13","jncryptor" "13","vue-typescript" "13","dogpile.cache" "13","gradle-groovy-dsl" "13","jhipster-blueprint" "13","goslate" "13","jikes" "13","jing" "13","jinjava" "13","gpyopt" "13","gpu-instancing" "13","wal-e" "13","jjaql" "13","windows-client" "13","kinterbasdb" "13","windows-core-audio" "13","window-scroll" "13","windows-10-sdk" "13","camera-projection" "13","django-evolution" "13","named-function" "13","caniuse" "13","windows-logon" "13","sharelink" "13","urlcomponents" "13","kibana-3" "13","wildfly-27" "13","wildfly-14" "13","camel-file" "13","dmenu" "13","opserver" "13","mysql-fabric" "13","dmoz" "13","pychart" "13","sharepoint-alerts" "13","pybuffer" "13","pybit" "13","pybel" "13","sirius" "13","callscreeningservice" "13","react-stripe" "13","dnp3" "13","aggdraw" "13","pyapns" "13","keyman-developer" "13","keyman" "13","ora-00928" "13","rubyamf" "13","carbon-components-svelte" "13","callcontext" "13","mysql-error-1140" "13","carbonkit" "13","ruby-csv" "13","realm-browser" "13","mysql-error-1060" "13","jvm-codecache" "13","katta" "13","sass-variables" "13","sa-mp" "13","inline-c" "13","cpn-tools" "13","createbitmap" "13","nestedlayout" "13","scala.rx" "13","android-studio-3.5.3" "13","surface-hub" "13","azure-data-share" "13","svn-switch" "13","android-studio-3.5.1" "13","kawa" "13","karpenter" "13","blazor-pwa" "13","modular-monolith" "13","monaco-languageserver" "13","wssf" "13","satpy" "13","corenlp-server" "13","moment-range" "13","twilio-verify" "13","juliadb" "13","android-subscriptionmanager" "13","injected-class-name" "13","wpf-listview" "13","modelstatedictionary" "13","android-update-sdk" "13","just" "13","jupyter-server" "13","wsdl2php" "13","twilio-cli" "13","workqueue" "13","sbom" "13","kakoune" "13","mod-proxy-wstunnel" "13","sap-analysis-for-office" "13","kamal" "13","android-spellcheck" "13","supportfragmentmanager" "13","ttimer" "13","coroutineworker" "13","apple-watch-glances" "13","mongify" "13","android-test-orchestrator" "13","wordpress-roles" "13","innerxml" "13","jquery-mobile-checkbox" "13","nshost" "13","jquery-mobile-radio" "13","input-iterator" "13","near-sdk-rs" "13","ncron" "13","dynamic-picklist-vtiger" "13","html-target" "13","bound-variable" "13","nemlogin" "13","boxee" "13","opal-framework" "13","pcl-crypto" "13","guacamole-common.js" "13","boa-constructor" "13","dynamic-management-views" "13","developer-payload" "13","easybind" "13","gulp-newer" "13","pcmanfm" "13","b-prolog" "13","inno-tools-downloader" "13","oovoo" "13","enroute" "13","aquafold" "13","interposing" "13","bluespec" "13","jquery-color" "13","ncclient" "13","descartes" "13","ion-content" "13","appsweep" "13","postgresql.conf" "13","blur-admin" "13","pdm" "13","envstats" "13","dynamics365-app-mobile" "13","pdh" "13","onpreferenceclicklistener" "13","enumerize" "13","postgres-9.4" "13","bluetooth-lowenergy-4.2" "13","neatupload" "13","errorcollector" "13","dynamic-c" "13","jquery-gmap" "13","bookblock" "13","nbehave" "13","bootstrapvalidator-1000hz" "13","early-return" "13","pot" "13","grunt-ngdocs" "13","pathelement" "13","payone" "13","nslevelindicator" "13","introsort" "13","jqplot-highlighter" "13","jqprint" "13","grunt-express" "13","boost-parameter" "13","jquery-flexbox" "13","applocalizations" "13","delegated-properties" "13","earthpy" "13","paypal-vault" "13","delta-rs" "13","ndebug" "13","detailslist" "13","bluefish" "13","migrate-mongo" "13","codeigniter-a3m" "13","miniupnpc" "13","jave" "13","nxml" "13","ranch" "13","wolfram-cdf" "13","typo3-form" "13","rgbcolor" "13","typed-dataset" "13","virtual-topic" "13","braintree-vault" "13","libneo4j-client" "13",".net-standard-1.6" "13","pyresttest" "13","shiva3d" "13","system.graphics" "13","f#-compiler-services" "13","visio-2010" "13","nethack" "13","wkinterfacebutton" "13","magicline" "13","builder.io" "13","ubikloadpack" "13","shinysky" "13","coclass" "13","shape-outside" "13","google-app-engine-launch" "13","object-initializer" "13","mission-critical" "13","typescript-language-server" "13","shinyjqui" "13","buildingblocks" "13","codea" "13","rbs" "13","codata" "13","dom7" "13","raw-post" "13","ramdrive" "13","kmip" "13","breakiterator" "13","java-communication-api" "13","netbeans6.1" "13","syndesis" "13","authlogic-oid" "13","visualdesigner" "13","fortumo" "13","videojs-record" "13","rinohtype" "13","pytextrank" "13","anaglyph-3d" "13","goaop" "13","setuserinteractionenabled" "13","jasmine-headless-webkit" "13","atlasboard" "13","ledger-nano-s" "13","vite-plugin-development" "13","right-aws" "13","pystache" "13","object-sharing" "13","sigma-grid-control" "13","viewlets" "13","libcmtd" "13","pyrcc" "13","fppopover" "13","middle-tier" "13","r-dbconnect" "13",".x" "13","atomic-values" "13","buddy-build" "13","settingslogic" "13","newmips" "13","signalrcore" "13","rhino-esb" "13","revision-graph" "13","libreoffice-impress" "13","android-app-ops" "13","network-tools" "13","bsmultiselect" "13","midi.js" "13","uiaccessibility-notification" "13","magento-fpc" "13",".searchable" "13","word-completion" "13","libreoffice-draw" "13","kornia" "13","codeigniter-flashdata" "13","winqual" "13","pyhdfs-client" "13","magicalrecord-2.1" "13","retransmit-timeout" "13","shoretel" "13","wordpress-6" "13","android-asset-studio" "13","uglifyjs-webpack-plugin" "13","knockout-postbox" "13","mirrorlink" "13","setneedsdisplayinrect" "13","abandoned-memory" "13","typed-lambda-calculus" "13","vimba-sdk" "13","libcurl.net" "13","libical" "13","domain-service-class" "13","2-tier" "13","a86" "13","maas" "13","libresolv" "13","rewritepath" "13","richtextctrl" "13","dokku-alt" "13","devilbox" "13","izpanel" "13","controller-tests" "13","tmediaplayer" "13","redo-logs" "13","mobipocket" "13","devirtualization" "13","j2objc-gradle" "13","redlock.net" "13","rails-for-zombies" "13","drf-extensions" "13","quick-install-package" "13","astah" "13","play-templates" "13","rails-5.1.6" "13","rails-4-upgrade" "13","azure-pipeline-python-script-task" "13","conversions-api" "13","scichart.js" "13","npm-debug" "13","play-ws" "13","mobx-utils" "13","assistive" "13","nsurlcredentialstorage" "13","radscheduleview" "13","drupal-form-validation" "13","asreml" "13","convertall" "13","tasty" "13","taskfile" "13","openjml" "13","mockrunner" "13","polychart" "13","downloadify" "13","tchecklistbox" "13","polyglot-markup" "13","xctestplan" "13","tingodb" "13","poison-queue" "13","polyglot-persistance" "13","hidden-variables" "13","expecto" "13","opengl-to-opengles" "13","polylineoptions" "13","vertexdata" "13","drupal-schema" "13","xcode-target" "13","homomorphic-encryption" "13","tdatetimepicker" "13","azureshell" "13","xcode-plugin" "13","tdl" "13","gemma" "13","nonserializedattribute" "13","registerhelper" "13","tinytext" "13","poc" "13","as-keyword" "13","non-web" "13","nook-tablet" "13","ex-navigation" "13","honeysql" "13","export-to-image" "13","android-devicetoken" "13","model-binders" "13","notarization" "13","tag-dispatching" "13","hjson" "13","gdata-java-client" "13","tkinter.style" "13","hopscotch" "13","hibernate-batch-updates" "13","scollector" "13","hail" "13","r-4.0.0" "13","cabwiz" "13","c#-devkit" "13","racf" "13","racerjs" "13","dict-comprehension" "13","mobile-app-tracker" "13","haiku" "13","c#-code-model" "13","uicolorpickerviewcontroller" "13","c++-attributes" "13","uicontextmenuconfiguration" "13","wx2" "13","uibubbletableview" "13","nvblas" "13","sceneeditor" "13","bzr-svn" "13","azure-functions-docker" "13","sched" "13","uibaritem" "13","gwt-syncproxy" "13","mm7" "13","cordys-opentext" "13","hammerdb" "13","itms-90809" "13","openwebanalytics" "13","xamarin.forms.collectionview" "13","null-string" "13","xamarin-forms-shell" "13","c++-tr2" "13","xaction" "13","qupath" "13","cache-digests" "13","diem" "13","dhc" "13","azure-image-builder" "13","x509certficiate2" "13","rabbitmq-federation" "13","issharedsizescope" "13","sql-server-ce-toolbox" "13","event-queue" "13","streamingmarkupbuilder" "13","layerkit" "13","ole-object" "13","texnic-center" "13","chainlit" "13","react-d3-graph" "13","sphider" "13","propertyconfigurator" "13","react-mapbox-gl" "13","getpwnam" "13","httpfox" "13","string-math" "13","combinedresourcehandler" "13","lookback" "13","combine-pdf" "13","resharper-8.1" "13","ipworks" "13","pyvimeo" "13","css-paint-api" "13","spgwr" "13","ipython-sql" "13","restivus" "13","projectitem" "13","qq" "13","mplab-5.45" "13","ios16.4" "13","angularjs-infdig" "13","es-hyperneat" "13","cfpdfform" "13","nitrous" "13","large-address-aware" "13","angular-gantt" "13","getcolor" "13","motor-asyncio" "13","propfind" "13","spcontext" "13","logiql" "13","escp" "13","angularfire2-offline" "13","testim.io" "13","strstream" "13","no-database" "13","ternjs" "13","lark" "13","angular-bootstrap-toggle" "13","android-moxy" "13","android-motionscene" "13","android-mqtt-client" "13","memoryanalyzer" "13","memoir" "13","android-navigation-editor" "13","cue-points" "13","ondblclick" "13","reactivemongo-play-json" "13","euterpea" "13","splunk-api" "13","react-google-autocomplete" "13","android-nsd" "13","customization-point" "13","ios-urlsheme" "13","splobjectstorage" "13","nike" "13","android-measure" "13","tomcat5" "13","peer-discovery" "13","memberinfo" "13","monotone" "13","terraform-variables" "13","pgcc" "13","pgbench" "13","electron-notarize" "13","resource-dll" "13","proxy.pac" "13","android-preference-v14" "13","cubrid" "13","android-project-template" "13","resource-based-authorization" "13","mems" "13","pelias" "13","textdocumentproxy" "13","duplicati" "13","moodle-boost" "13","egnyte" "13","pendo" "13","qaxwidget" "13","android-resource-qualifiers" "13","monostate" "13","android-jetpack-compose-navigation" "13","elastix-itk" "13","android-json-rpc" "13","curand" "13","react-dragula" "13","ejabberd-saas" "13","collapsibletree-r" "13","ipl" "13","hydrotsm" "13","react-library" "13","prototypal" "13","odesk" "13","flutter-radiobutton" "13","here-tourplanning" "13","linkshare" "13","dart-frog" "13","here-fleet-telematics" "13","sunmi" "13","quarkus-grpc" "13","cypress-session" "13","suncc" "13","czmq" "13","linkedin-gem" "13","eluna-lua-engine" "13","lightwindow" "13","quantify" "13","d3fo" "13","parallel-assignment" "13","elrte" "13","webgrabber" "13","dart-pdf" "13","batch-delete" "13","line-processing" "13","darkaonlinel5-swagger" "13","linux-mint-19" "13","google-groups-migration" "13","dapper-plus" "13","header-injection" "13","archive-file" "13","foq" "13","arcsight" "13","traefik-middleware" "13","ardl" "13","bftask" "13","hdf5dotnet" "13","stx" "13","timbre" "13","bigdl" "13","betamax" "13","authorize.net-aim" "13","shell-verbs" "13","berkelium" "13","gleam" "13","uttype" "13","bentoml" "13","gliffy" "13","glktextureloader" "13","array-of-dict" "13","fmle" "13","seasonal-adjustment" "13","qt-faststart" "13","search-regex" "13","bigquery-public-datasets" "13","glpointsize" "13","flynn" "13","structured-storage" "13","sdmmc" "13","vaadin-push" "13","autofactory" "13","beeswax" "13","fluxlang" "13","asciimatics" "13","scriptservice" "13","qtpositioning" "13","gnu99" "13","cve-2021-44228" "13","webapp-runner" "13","google-place-picker" "13","thttpd" "13","automoc" "13","parse-live-query" "13","query-help" "13","threat-model" "13","web-control" "13","substratevm" "13","cypress-iframe" "13","autoreload" "13","max-pool-size" "13","zenhub" "13","mui-autocomplete" "13","ms-access-2002" "13","compositeusertype" "13","enigma2" "13","statusbaritem" "13","ignore-duplicates" "13","zinc" "13","preferencefragmentcompat" "13","zoomify" "13","ember-cli-pods" "13","solidworkspdmapi" "13","concurrent-vector" "13","maven-install" "13","embed-tag" "13","powercommands" "13","alpha-shape" "13","stellaris" "13","altium-designer" "13","powerpoint-automation" "13","measurementformatter" "13","predicatewithformat" "13","media-manager" "13","so-reuseport" "13","mu4e" "13","solana-py" "13","msbuild-14.0" "13","emacs-projectile" "13","emailfield" "13","ijavascript" "13","igcombo" "13","compiler-as-a-service" "13","predestroy" "13","emoji-tones" "13","spanish" "13","prelink" "13","mcl" "13","ilias" "13","identityserver5" "12","tspl" "12","smart-app-banner" "12","renewcommand" "12","renice" "12","renode" "12","yappi" "12","sqlworkflowpersistencese" "12","decrease-key" "12","gforge" "12","website-monitoring" "12","antplus" "12","dbmetal" "12","babel-6" "12","flink-state" "12","graphson" "12","ecobee-api" "12","clipbucket" "12","yarn-v4" "12","flightpath" "12","classy-prelude" "12","jd-eclipse" "12","slp" "12","temenos" "12","squirejs" "12","weyland" "12","jcurses" "12","photosphereviewer" "12","tensorflow-layers" "12","ebooklib" "12","transitional" "12","livewire-powergrid" "12","deadobjectexception" "12","flutter-focus-node" "12","re-python" "12","ddx" "12","trouble-tickets" "12","websharper.ui.next" "12","loadoptions" "12","eclipseme" "12","edgesdk" "12","webtask" "12","procrustes" "12","template-lite" "12","ant4eclipse" "12","trusted-signing" "12","template-control" "12","print-job-control" "12","prodigy" "12","deferred-deep-linking" "12","ggradar" "12","trusted-types" "12","fc" "12","intel-pytorch" "12","eclipse-digital-twin" "12","wicket-1.4" "12","localserversocket" "12","fluentdata" "12","fcitx" "12","stagevideo" "12","dcat" "12","primeng-menu" "12","remote-containers" "12","eclipse-vorto" "12","tsclust" "12","intellilock" "12","remove.bg" "12","regula" "12","rehype" "12","rendermonkey" "12","graphql-compose" "12","edwin" "12","git-ls-tree" "12","gitlist" "12","sqlsoup" "12","jenkins-template-engine" "12","jenkins-spock" "12","trixbox" "12","terminal.gui" "12","webpack-watch" "12","yeti" "12","php-glide" "12","backbone-paginator" "12","backbase-portal" "12","closesocket" "12","grounddb" "12","backupexec" "12","apache-bloodhound" "12","vue-sweetalert2" "12","apache-ftpserver" "12","clouddb" "12","file-header" "12","phplib" "12","clj-kafka" "12","gridlookupedit" "12","react-native-deck-swiper" "12","apache-commons-text" "12","react-refresh" "12","sketch.js" "12","marqo" "12","skb" "12","groovyc" "12","apache-commons-imaging" "12","react-redux-connect" "12","easy-rules" "12","php-ffi" "12","vue-pwa" "12","banshee" "12","barista" "12","mathdotnet-symbolics" "12","filedrop.js" "12","function-template" "12","selectionchanging" "12","fundamentals-ts" "12","snakeviz" "12","pingaccess" "12","fitch-proofs" "12","mapbox-navigation" "12","python-ipaddress" "12","funnelweb" "12","fxgl" "12","unbuffered-output" "12","django-angular" "12","python-dataset" "12","fxaa" "12","flawfinder" "12","package-design" "12","pabx" "12","pinnacle-cart" "12","paapi" "12","safari9" "12","safari7" "12","flatpack" "12","bit-framework" "12","saaskit" "12","biweekly" "12","s6" "12","caxlsx" "12","flask-table" "12","semmle-ql" "12","bjqs" "12","manifoldjs" "12","packr" "12","biom" "12","cbt" "12","paf" "12","pinging" "12","xmake" "12","laravel-charts" "12","flashplayer-debug" "12","pinyin" "12","socialsharing-plugin" "12","make-scorer" "12","img-area-select-jquery" "12","lapack++" "12","smoothstep" "12","selmer" "12","binding-mode" "12","many2one" "12","imperative-languages" "12","imperva" "12","snorkel" "12","lambdatest" "12","ngx-uploader" "12","import-hooks" "12","uiveri5" "12","laika" "12","la-clojure" "12","labelme" "12","nhibernate-burrow" "12","ujmp" "12","unitofworkapplication" "12","case-tools" "12","ng2-admin" "12","fixedpage" "12","pairing-heap" "12","kubeless" "12","vshost32" "12","python-billiard" "12","fitted-box" "12","fyber" "12","advertised-shortcut" "12","json-ref" "12","xps-generation" "12","smarthost" "12","consul-health-check" "12","jsfuck" "12","symfony-http-kernel" "12","symfony-bundle" "12","symfony-assetmapper" "12","adtf3" "12","funcall" "12","appcompatdialogfragment" "12","aem-core-wcm-components" "12","chrome-plugins" "12","swtchart" "12","apache-pig-grunt" "12","circuits-framework" "12","apache-tuscany" "12","python-slate" "12","cimbalino" "12","data-science-studio" "12","dbclient" "12","firewall-rules" "12","connect-modrewrite" "12","adobe-exprience-manager" "12","datocms" "12","apache-xml-graphics" "12","app2sd" "12","connection-points" "12","date-sunrise" "12","apache-zest" "12","jtc" "12","chatjs" "12","json2xls" "12","jsctags" "12","dbextensions" "12","datastore-admin" "12","cirrious.fluentlayout" "12","aphrodite" "12","jsr380" "12","apfloat" "12","pkg" "12","dbd-mysql" "12","jmxmp" "12","fbloginview" "12","mysql-error-1264" "12","grails-3.0.10" "12","jmspaymentpaypalbundle" "12","grails-plugin-rabbitmq" "12","mysql-error-1222" "12","callfire" "12","gosublime" "12","grammar-induction" "12","gotenberg" "12","data-compaction" "12","jinitiator" "12","meteor-jasmine" "12","fastly-vcl" "12","ruby-dotenv" "12","mysql-error-1130" "12","ibm-oneui" "12","camunda-spin" "12","windows-application-driver" "12","naked-objects" "12","cakephp-ajaxhelper" "12","rti-dds" "12","window.external" "12","windicss" "12","vecmath" "12","angular-sanitizer" "12","vectorbt" "12","microsoft-azure-documentdb" "12","algol68" "12","nanoboxio" "12","iccid" "12","microsoft-entra-external-id" "12","rstudioapi" "12","microsoft-graph-contacts" "12","pycom" "12","nativedroid" "12","recursivetask" "12","icontact" "12","capture-output" "12","verp" "12","facilities" "12","rsm" "12","public-suffix-list" "12","idangero" "12","receive-location" "12","punbb" "12","alation" "12","real-time-strategy" "12","alassetsgroup" "12","realplayer" "12","facebooksdk.net" "12","purescript-halogen" "12","purescript-pux" "12","rsbarcodes" "12","pushapps" "12","service-bus-explorer" "12","universal-code" "12","sitecore-lucene" "12","crystal-reports-10" "12","update-inner-join" "12","urlaccess" "12","rootpy" "12","docker-registry-mirror" "12","oracle-access-manager" "12","aws-ebs-csi-driver" "12","watson-personality-insights" "12","simple-phpunit" "12","simpowersystems" "12","dkan" "12","simplepager" "12","updatecheck" "12","kismet-wireless" "12","rosetta-code" "12","django-inline-models" "12","django-intermediate-table" "12","dns-get-record" "12","oracle-http-server" "12","untyped-variables" "12","django-johnny-cache" "12","hyperledger-fabric2.2" "12","doctrine-orm-postgres" "12","ora-06553" "12","routedeventargs" "12","do178-b" "12","unleash" "12","sharepoint2010-bcs" "12","watchr" "12","walrus" "12","aws-mediatailor" "12","ora-03113" "12","keywordquery" "12","django-rss" "12","unnamed-class" "12","ias" "12","aws-copilot-cli" "12","rl78" "12","watchos-10" "12","wago" "12","keyboard-avoidance" "12","roslyn-project-system" "12","django-pandas" "12","warp-scheduler" "12","doctrine-mapping" "12","django-recaptcha" "12","worklight-cli" "12","horn" "12","nspoint" "12","turbolinks-ios" "12","justinmind" "12","nested-statement" "12","kameleo" "12","kakao" "12","bootp" "12","sap-business-bydesign" "12","wso2-asgardeo" "12","jrecorder" "12","gulpfile" "12","gs1-databar" "12","mojo-dom" "12","nsaffinetransform" "12","swfmill" "12","apple-ii" "12","azul-zing" "12","countdownjs.js" "12","ionic.io" "12","turing-lang" "12","online-forms" "12","wtforms-json" "12","apple-speech" "12","hostinger" "12","ncurses-cdk" "12","apple-clang" "12","ion-infinite-scroll" "12","border-collapse" "12","blazor-jsruntime" "12","ttlauncheritem" "12","initwithstyle" "12","silk-central" "12","neo4j-cql" "12","spring-expression" "12","saslidemenu" "12","degenerate-dimension" "12","grunt-svgstore" "12","boost-fiber" "12","grunt-ssh" "12","silverlight-2-rc0" "12","silverlightcontrols" "12","arangodb-java" "12","swiftgen" "12","invantive-data-hub" "12","grunt-eslint" "12","intersystems-cache-studio" "12","html5-qrcode" "12","dynamics-nav-2015" "12","createitem" "12","springockito" "12","blazy" "12","html5-img" "12","botframeworkemulator" "12","sc" "12","bosh" "12","blazor-routing" "12","modelmultiplechoicefield" "12","write-through" "12","nbug" "12","axvline" "12","httpapplicationstate" "12","paw" "12","grunt-angular-gettext" "12","jquery-infinite-scroll" "12","dynamically-loaded-xap" "12","twitter-recess" "12","dylan" "12","open-array-parameters" "12","openfb" "12","application-size" "12","appsee" "12","modelvisual3d" "12","openflashchart2" "12","inline-if" "12","wsacleanup" "12","postman-flows" "12","html-to-docx" "12","navparams" "12","pbrt" "12","gtmsessionfetcher" "12","k-combinator" "12","easendmail" "12","interfax" "12","corewars" "12","pcapy" "12","wpf-interop" "12","eastl" "12","inlineeditbox" "12","nestacms" "12","swallowed-exceptions" "12","dxcore" "12","needleman-wunsch" "12","mongo-driver" "12","design-consideration" "12","application-integration" "12","mongodb-tools" "12","enumdropdownlistfor" "12","easyquery" "12","kanso" "12","inlay-hints" "12","dynamic-data-exchange" "12","axhost" "12","applicationid" "12","pd4ml" "12","depottools" "12","guidance-automation-tool" "12","inpainting" "12","deps-edn" "12","onserviceconnected" "12","samsung-galaxy-camera" "12","karafka" "12","jquery-ui-slider-pips" "12","cots" "12","lzf" "12","neurolab" "12","newsgroup" "12","vlad-vector" "12","mixed-case" "12","osvr" "12","videojs-transcript" "12","oauth-2.1" "12","minimumosversion" "12","rbtools" "12","wix2" "12","javaexe" "12","gomobile-android" "12","osx-extensions" "12","viewroot" "12","mac-classic" "12","abstract-machine" "12","java-flow" "12","javaimports" "12","pyscreeze" "12","typoscript2" "12","machine.fakes" "12","otcl" "12","coco2d-x" "12","facebook-browser" "12","librabbitmq" "12","abaqus-odb" "12","oas3" "12","raycast" "12","android-app-quick-setting" "12","vim-syntastic" "12","javafx-datepicker" "12","ext.list" "12","frapi" "12","view-debugging" "12","audio-panning" "12","nxt-python" "12","javafx-gradle-plugin" "12","android-banner" "12","wizard-control" "12","rbar" "12","raspivid" "12","atan" "12","goldmine" "12","audio-comparison" "12","winwrap" "12","pygsl" "12","browserslist" "12","ora-hash" "12","amd-app" "12","gocb" "12","orafce" "12","pyrender" "12","netbeans-14" "12","codepage-437" "12","knockout-subscribe" "12","ezpdf" "12","ravenhq" "12","pypi-regex" "12","codesite" "12","miniz" "12","windows-virtual-pc" "12","knowm-xchart" "12","kolite" "12","microsoft-graph-webhooks" "12","pyportmidi" "12","lexical-editor" "12","koken" "12","codeworld" "12","network-conduit" "12","shadow-removal" "12","dominotogo" "12","codeguard" "12","system-databases" "12","shady" "12","range-partitions" "12","objectgears" "12","atlassprites" "12","libmongoc" "12","kotlin-context-receivers" "12","code-elimination" "12","libnds" "12","reverseprojection" "12","wkrefreshbackgroundtask" "12","kobotoolbox" "12","freeling" "12","kover" "12","system-rules" "12","facebook-infer" "12","klvdata" "12","typescript-3.6" "12","mirador" "12","wmd-markdown" "12","syncthing" "12","pyimagej" "12","sfu" "12","jasync-sql" "12","cofoundry" "12","riak-js" "12","kohana-3.0" "12","windows-shortcut" "12",".net-mac" "12","ratecard-api" "12","lxr" "12","amplify-ios" "12","luaplus" "12","raml-java-parser" "12","typeliteral" "12","shutterstock" "12","javasymbolsolver" "12","goblin" "12","shutdown-script" "12","spu" "12","pluggableprotocol" "12","refreshable" "12","azure-ml-component" "12","jalopy" "12","plugin-pattern" "12","gdr" "12","asp.net-mvc-awesome" "12","tagfield" "12","asp.net-mvc-custom-filter" "12","itemrenderers" "12","asmock" "12","ds9" "12","notification-content-extension" "12","difference-between-rows" "12","highspeed" "12","png-transparency" "12","coproduct" "12","hlsl2glsl" "12","expo-publish" "12","asp.net-mvc-uihint" "12","refinitiv-eikon" "12","notifyitemchanged" "12","mockingoose" "12","copssh" "12","r2dbc-mssql" "12","vetiver" "12","vestacp" "12","tamagui" "12","r2d2" "12","double-double-arithmetic" "12","tds-fdw" "12","tangram" "12","h2-console" "12","dragenter" "12","homomorphism" "12","podman-networking" "12","mobify" "12","open-packaging-convention" "12","dinamico" "12","nodevm" "12","gwt-test-utils" "12","android-compose-exposeddropdown" "12","tcpchannel" "12","coq-plugin" "12","node-xbee" "12","tinn-r" "12","polyline-decorator" "12","nodist" "12","pointplot" "12","istool" "12","gwt-dispatch" "12","targetprocess" "12","mms-gateway" "12","openid-dex" "12","openindiana" "12","gwt-2.2" "12","gvariant" "12","nokia-n8" "12","double-splat" "12","openjscad" "12","bwidget" "12","buzztouch" "12","rails-event-store" "12","devise-async" "12","bwip-js" "12","ganon" "12","red-gate-sql-prompt" "12","scintillanet" "12","sqlfire" "12","rails-bullet" "12","rails-roar" "12","uiactivitycontroller" "12","caching-application-block" "12","reddison" "12","redux-async-actions" "12","npn" "12","opera-presto" "12","opensoundcontrol" "12","redux-immutable" "12","redis-om-spring" "12","playscalajs" "12","redis-om" "12","control-adapter" "12","npm-outdated" "12","rackunit" "12","gcc-4.2" "12","tlbinf32" "12","mkoverlaypathrenderer" "12","scct" "12","xcode12.3" "12","expression-sketchflow" "12","re-encoding" "12","garnet-os" "12","bzlmod" "12","sqlite-cipher" "12","dotmailer" "12","assembly-trap" "12","mobile-controls" "12","nvidia-titan" "12","handset" "12","androidinjector" "12","mixed-type" "12","sqlalchemy-continuum" "12","xcode13.3.1" "12","convertigo" "12","xcode12beta6" "12","uisheetpresentationcontroller" "12","handlerinterceptor" "12","menuitem-selection" "12","prometheus-adapter" "12","omml" "12","omemo" "12","huawei-cloud" "12","ofed" "12","perlguts" "12","spectre.console" "12","esb-toolkit-2.1" "12","on-behalf-of" "12","onbeforeload" "12","spoken-language" "12","proxygen" "12","huggingface-evaluate" "12","centos7.6" "12","charm++" "12","qqmlcontext" "12","offline-web-app" "12","spgroup" "12","pyupdater" "12","qgadget" "12","sphere.io" "12","charmap" "12","mergecursor" "12","luadoc" "12","qnx-ifs" "12","lua-4.0" "12","qif" "12","meshroom" "12","eslintignore" "12","esp-idf-sys" "12","pessimistic" "12","lpad" "12","mpkg" "12","pywhatkit" "12","pfbc" "12","spiffe" "12","projectlocker" "12","spinnaker-cam" "12","nhibernate-hql" "12","irvine16" "12","resharper-9.1" "12","elaborated-type-specifier" "12","restrserve" "12","iron-elements" "12","elastalert2" "12","restore-points" "12","google-compute-disk" "12","elastic-enterprise-search" "12","cometserver" "12","perceptual-sdk" "12","restkit-0.24.x" "12","elasticnet" "12","ips" "12","lava" "12","ace-tao" "12","ipropertystorage" "12","elasticsearch-1.6.0" "12","restclientbuilder" "12","react-location" "12","google-cloud-save" "12","google-cloud-run-jobs" "12","nodechildren" "12","color-gradient" "12","iosched" "12","colemak" "12","android-reflection" "12","google-cloud-interconnect" "12","elasticsearch-phonetic" "12","resolvejs" "12","cube-script" "12","elisp-macro" "12","android-pullparser" "12","node-ftp" "12","actionscript-1" "12","node-kafka-streams" "12","active-attr" "12","ipados13" "12","acts-as-state-machine" "12","ios-sqlite" "12","respondcms" "12","ip2long" "12","customize-cra" "12","perl-core" "12","periodictimer" "12","geom-map" "12","getforegroundwindow" "12","niagara-4" "12","angular2-docheck" "12","testswarm" "12","httptransportse" "12","laravel-unit-test" "12","node-pg-migrate" "12","generative-testing" "12","getseq" "12","testdoublejs" "12","react-codemirror2" "12","genericprincipal" "12","genymotion-gps" "12","test-and-target" "12","testtrack" "12","gervill" "12","to-yaml" "12","folksonomy" "12","embedded-container" "12","tiger" "12","uudecode" "12","compose-multiplatform-ios" "12","shgo" "12","qsignalspy" "12","fog-google" "12","autoblogged" "12","uwf" "12","ms-office-addin" "12","static-if" "12","cylon.js" "12","zend-xmlrpc" "12","allow-modals" "12","global-query-filter" "12","secure-trading" "12","compound-operator" "12","struts2-config-browser" "12","tibero" "12","em-websocket-client" "12","belief-propagation" "12","totara" "12","ytt" "12","all-in-one-event-calendar" "12","hec-ras" "12","google-notebook" "12","yui-editor" "12","google-site-verification-api" "12","tortoisegitmerge" "12","webchannelfactory" "12","maven-multi-module" "12","linux-mint-21" "12","helix-editor" "12","amazon-imagebuilder" "12","preinit" "12","glutcreatewindow" "12","git-switch" "12","best-first-search" "12","haxepunk" "12","msmqbinding" "12","trait-bounds" "12","compilationmode" "12","steemit" "12","hazelcast-cloud" "12","embedio" "12","gitsharp" "12","mbsync" "12","power-series" "12","ie-plugins" "12","iextenderprovider" "12","compcert" "12","embedded-script" "12","std-invoke" "12","usedapp" "12","gkscore" "12","user-testing" "12","stylet" "12","cypress-psoc" "12","usda-fooddata-central-api" "12","embedded-postgres" "12","use-swr" "12","architect" "12","bfile" "12","d3-geo" "12","hdf5storage" "12","parlai" "12","std-call-once" "12","sua" "12","solr8.4.1" "12","usage-tracking" "12","d3-org-chart" "12","argument-validation" "12","bhm" "12","bcompiler" "12","statusnet" "12","glfrustum" "12","urlspan" "12","daap" "12","cypress-code-coverage" "12","mcdm" "12","stryker-net" "12","font-replacement" "12","sharpvectors" "12","url-modification" "12","dacapo" "12","arm-linux" "12","sheetrock" "12","subdomain-fu" "12","url-link" "12","conda-pack" "12","bayesglm" "12","starcraftgym" "12","webextension-storage" "12","zammad" "12","linq-to-ldap" "12","tfs-2008" "12","webloadui" "12","zappdev" "12","source-filter" "12","passive-sts" "12","linqbridge" "12","allatori" "12","weblistener" "12","hetzner-cloud" "12","arworldmap" "12","starrocks" "12","webodf" "12","qtserial" "12","preg-quote" "12","mdspan" "12","gnosis-safe" "12","seaglass" "12","allauth" "12","spark2" "12","mdw" "12","help-files" "12","multibox" "12","zcash" "12","google-sheets-filter-view" "12","gnu-indent" "12","mtasc" "12","queued-connection" "12","precompute" "12","gmock" "12","glyph-substitution" "12","mediawiki-visualeditor" "12","conceptnet" "12","pptk" "12","beautytips" "12","quarkus-testing" "12","mdls" "12","webgrind" "12","sourcery" "12","libyang" "11","primeng-checkbox" "11","multitouch-keyboard" "11","bash-it" "11","cmfcmenubutton" "11","sitespeedio" "11","vticker" "11","graphql-compose-mongoose" "11","relstorage" "11","pgsync" "11","marmalade-edk" "11","filecoin" "11","mark-of-the-web" "11","react-native-macos" "11","yii-behaviour" "11","clientside-caching" "11","procstat" "11","slickquiz" "11","jenkins-php" "11","balanced-groups" "11","stalestateexception" "11","intel-xdk-contacts" "11","previewcallback" "11","marklogic-11" "11","clientresource" "11","webtransport" "11","productsign" "11","wickedpicker" "11","remoteserviceexception" "11","php-generators" "11","trtc.io" "11","jaxb2-simplify-plugin" "11","clustermap" "11","mass-package" "11","multiple-interface-implem" "11","tronlink" "11","apache-doris" "11","lmtp" "11","masstransit-courier" "11","lobo-cobra" "11","master-db" "11","jaxb-episode" "11","teamcity-rest-api" "11","trusted-application" "11","react-native-table-component" "11","xsp2" "11","masquerade" "11","citymaps" "11","masterslider" "11","ansible-automation-platform" "11","ecmascript-4" "11","eclipse-europa" "11","filemap" "11","anypoint-mq" "11","fbsnapshottestcase" "11","jet.com-apis" "11","ecobertura" "11","localizedstringkey" "11","fluent-mongo" "11","badgerdb" "11","cmake-js" "11","react-native-upgrade" "11","web-safe-fonts" "11","release-cycle" "11","trimble-maps" "11","jazzylistview" "11","clim" "11","liveservertestcase" "11","fluentbootstrap" "11","process-injection" "11","reliablesession" "11","yii-form" "11","badsqlgrammarexception" "11","clickhouse-kafka" "11","github-third-party-apps" "11","matplotlib-table" "11","skim" "11","deducer" "11","vue-functional-component" "11","tensor-indexing" "11","weechat" "11","decorator-chaining" "11","telecom" "11","ef-postgresql" "11","jcstress" "11","clouddevelopmentkit" "11","default-database" "11","weixinjsbridge" "11","vue-flickity" "11","github-flow" "11","phpfarm" "11","tensorflow-decision-forests" "11","teamwork-projects" "11","flint" "11","gridle" "11","mvcextensions" "11","dbmigrator" "11","php-fig" "11","wexpect" "11","skreferencenode" "11","anycast" "11","repost" "11","giteye" "11","srvany" "11","ant-junit" "11","fedora-coreos" "11","flippy" "11","skyfloatinglabeltextfield" "11","anti-xml" "11","ternary-representation" "11","dbsetup" "11","bac0" "11","anyhow" "11","sscli" "11","decisiontreeclassifier" "11","vue-query" "11","gridview.builder" "11","yardoc" "11","list.selectedvalue" "11","slim-2" "11","fedora-33" "11","clflush" "11","cdi-2.0" "11","api-platform" "11","pact-node" "11","pimcore-datahub" "11","cdo-emf" "11","const-string" "11","sel4" "11","fileslurp" "11","xhtml-mp" "11","kuma" "11","constructorargument" "11","connect.js" "11","jsonrpc4j" "11","bioconda" "11","kubernetes-vitess" "11","pagekit" "11","pagekite" "11","apache-nifi-toolkit" "11","xmlindex" "11","uniform-cost-search" "11","ftpes" "11","independentsoft" "11","consolas" "11","ng2-semantic-ui" "11","chocolatechip-ui" "11","apache-unomi" "11","swiftui-fileimporter" "11","flarum" "11","implicit-class" "11","pircbot" "11","fira-code" "11","xml-crypto" "11","langohr" "11","fingerprintjs" "11","smoothie.js" "11","immutablearray" "11","immer" "11","json2csharp" "11","imgix-js" "11","flambe" "11","pion-net" "11","swiftui-table" "11","flashmessenger" "11","imposm" "11","flashsocket" "11","xml-document-transform" "11","laravel-config" "11","image-management" "11","cimport" "11","final-class" "11","owasp-dependency-track" "11","ox" "11","filterfactory" "11","content-platform-engine" "11","imsdroid" "11","pinned-shortcut" "11","sybase-rs" "11","p4vs" "11","filewalker" "11","xpc-target" "11","l10n.js" "11","sylius-resource" "11","chropath" "11","sym" "11","disclosuregroup" "11","bit-src" "11","bits-per-pixel" "11","kylix" "11","flee" "11","bitbucket-webhook" "11","fleetboard" "11","contactitem" "11","contact-center" "11","chrome-sync" "11","pactflow" "11","python-generateds" "11","catch-exception" "11","function-address" "11","daypilot-scheduler" "11","python-egg-cache" "11","funambol" "11","db2-express-c" "11","s3-object-tagging" "11","mariadb-connector" "11","safariservices" "11","advanced-threat-protection" "11","python-control" "11","python-constraint" "11","sag" "11","fullstory" "11","semweb" "11","appconkit" "11","sails-redis" "11","adobe-native-extensions" "11","datumbox" "11","python-inspect" "11","platformview" "11","vql" "11","checkjs" "11","snap-to-grid" "11","xmlworkerhelper" "11","pix" "11","vscode-restclient" "11","vscode-server" "11","first-class-modules" "11","jsr-275" "11","five9" "11","xmlstore" "11","nginx-status" "11","cartalyst" "11","uiweb" "11","xdp-ebpf" "11","soap-rpc-encoded" "11","cascade-filtering" "11","soapformatter" "11","carrierwave-direct" "11","selenium-ruby" "11","umbraco12" "11","cargo-features" "11","running-balance" "11","mapisendmail" "11","adjustviewbounds" "11","selenium-builder" "11","childactivity" "11","databricks-notebook" "11","document-preview" "11","uplevel" "11","aleph-ilp" "11","push-promise" "11","updateexception" "11","reagent-forms" "11","rsrc" "11","gradle-cache" "11","w3.js" "11","warp10" "11","push-relabel" "11","servermiddleware" "11","hyperkit" "11","cssbundling-rails" "11","hyperldger-fabric-peer" "11","pyansys" "11","vera++" "11","iconutil" "11","ora-00947" "11","ora-00984" "11","ora-01034" "11","dojo2" "11","graffiticms" "11","call-directory-extension" "11","ahk2" "11","sharepoint-upgrade" "11","grails-3.2" "11","mysql-error-126" "11","calendar-store" "11","call-queue" "11","django-rest-framework-permissions" "11","sharepoint-documents" "11","django-role-permissions" "11","fb2" "11","robotium-recorder" "11","calculated-property" "11","camel-jpa" "11","watchmaker" "11","django-localeurl" "11","rtrt" "11","mysqlcheck" "11","grammarly" "11","na.approx" "11","django-sitetree" "11","validates-associated" "11","ajax.request" "11","aws-sdk-android" "11","campfire" "11","jgitver" "11","my-model-jami" "11","dll-dependency" "11","windb" "11","validity.js" "11","ruby-parser" "11","operator-lifecycle-manager" "11","vunit" "11","vuze" "11","nanodbc" "11","urlbinding" "11","roadkill-wiki" "11","verold" "11","gradlefx" "11","pycoral" "11","oracleinternals" "11","gpu-managed-memory" "11","ibm-maximo-worker-insights" "11","gpu-local-memory" "11","fairlearn" "11","mhash" "11","angularjs-slider" "11","microbundle" "11","jira-mobile-connect" "11","angular-material-9" "11","angular-material-tab" "11","failable" "11","fakevim" "11","i2b2" "11","r-lib-cpp11" "11","redbird" "11","recursive-templates" "11","oracle-apex-22" "11","ibm-swift-sandbox" "11","fact++" "11","ibm-was-oc" "11","jqbargraph" "11","crystal-reports-2005" "11","oracle-map-viewer" "11","ptokax" "11","fastapi-crudrouter" "11","gpu-overdraw" "11","simplicity-studio" "11","ptpython" "11","pt-query-digest" "11","aws-acm-certificate" "11","hyper-virtualization" "11","algorithmia" "11","micromamba" "11","wce" "11","aws-databrew" "11","angular-router-loader" "11","animated-webp" "11","dask-gateway" "11","aws-automation" "11","rebass" "11","rmic" "11","aws-amplify-vue" "11","fancyupload" "11","ora-12519" "11","seqlock" "11","avmutablevideocomposition" "11","hypertrack" "11","fare" "11","realm-cloud" "11","csf" "11","facebooktoolkit" "11","cross-domain-proxy" "11","aws-cdk-context" "11","rollingfilesink" "11","unless" "11","sinemacula" "11","joomla3.9" "11","fastify-jwt" "11","farbtastic" "11","svn-api" "11","twiny" "11","mongoose-deleteone" "11","dynamodb-gsi" "11","guitexture" "11","jul-to-slf4j" "11","jumblr" "11","core-banking" "11","wrapt" "11","sbt-crossproject" "11","couchdb-2.x" "11","sbt-concat" "11","twisted.words" "11","sbt-aspectj" "11","interval-intersection" "11","core.match" "11","earthly" "11","applaud" "11","neo4j-dotnet-driver" "11","dynamicgridview" "11","ergm" "11","jquery-boilerplate" "11","nsmergepolicy" "11","nsmutablecopying" "11","native-executable" "11","gs1-qr-code" "11","dynamics-crm-sdk" "11","e57" "11","twitter-client" "11","azure-ase" "11","population-count" "11","jqxtreegrid" "11","couchnode" "11","hostnetwork" "11","nsbatchupdaterequest" "11","gulp-jest" "11","hot-code-replace" "11","tttattritubedlabel" "11","infor-eam" "11","episerver-forms" "11","epoch.js" "11","nsdecimal" "11","ncftp" "11","cramp" "11","ws-ex-layered" "11","negation-as-failure" "11","dxgrid" "11","svn-copy" "11","crash-recovery" "11","bowtie2" "11","wpflocalizationextension" "11","dependent-method-type" "11","boost-container" "11","cosmwasm" "11","ert" "11","twilio-sdk" "11","corert" "11","equalsverifier" "11","bounded-quantification" "11","neo4j.py" "11","wpm" "11","wpn-xm" "11","android-time-square" "11","gulp-connect-php" "11","demeteorizer" "11","jquery-mobile-loader" "11","swift5.9" "11","devdefined-oauth" "11","ws-notification" "11","sbt-sonatype" "11","nehalem" "11","spring-modulith" "11","sbt-proguard" "11","boomla" "11","inline-editor" "11","blendability" "11","silverfrost-fortran" "11","android-sdk-build-tools" "11","bodybuilder.js" "11","inputevent" "11","silverlight-plugin" "11","apple-profile-manager" "11","android-sparsearray" "11","oneplus6t" "11","ndi" "11","nest2" "11","open4" "11","inverse-match" "11","applicationmanager" "11","mod-filter" "11","arangoimport" "11","blcr" "11","ndde" "11","ndk-stack" "11","input-button-image" "11","simian" "11","ionic-popover" "11","peachpie" "11","android-stlport" "11","simmechanics" "11","simple-authentication" "11","grunt-contrib-jade" "11","bolero" "11","paypal-android-sdk" "11","jxmapkit" "11","html-xml-utils" "11","axi4" "11","portletbridge" "11","post-type" "11","ionic2-tabs" "11","ndoc" "11","kaleidoscope" "11","axelor" "11","kargers-algorithm" "11","bluetooth-hci" "11","application-warmup" "11","jwasm" "11","ontorefine" "11","password-retrieval" "11","path-iterator" "11","ons-api" "11","password-strength" "11","delay-sign" "11","pdfminersix" "11","paver" "11","ion-item" "11","initialization-block" "11","jvi" "11","apple-watch-standalone" "11","intunemam" "11","netbanx-api" "11","wordpress-3.9" "11","rhea" "11","libcoap" "11","vlc-unity" "11","wordpress-4.0" "11","abstraction-layer" "11","ordinal-classification" "11","aba" "11","mixcloud" "11","mahara" "11","extjs-form" "11","osstatus" "11","attestations" "11","abstract-interpretation" "11","objc-protocol" "11","exscript" "11","objc-message-send" "11","orjson" "11","oracle-xml-db-repository" "11","mac-in-cloud" "11","oanda" "11","ormar" "11","extension-objects" "11","lempel-ziv-76" "11","mitreid-connect" "11","system-stored-procedures" "11","system.web.extensions" "11","browsercaps" "11","networkcomms.net" "11","rational-performance-test" "11","orphan-removal" "11","goangular" "11","mindtouch" "11","anchor-modeling" "11","built.io" "11","object-test-bench" "11","letsencrypt-nginx-proxy-companion" "11","anamorphism" "11","go-generate" "11","objectiveflickr" "11","win-shell" "11","breach-attack" "11","oauth2-toolkit" "11","mini-language" "11","rawpy" "11","wm-command" "11","python.el" "11","abbrevia" "11","objective-c-framework" "11","brep" "11","libtins" "11","authenticationchallenge" "11","rim-4.2" "11","tabbarios" "11","siema" "11","ufs" "11","rim-4.6" "11","rim-4.7" "11","pykka" "11","sfcartesianchart" "11","facebook-field-expansion" "11","microsoft-tag" "11","kratos" "11","23andme-api" "11","authentication-flows" "11","sifting-appender" "11","freebase-acre" "11","sigmaplot" "11","visual-foxpro-9" "11","java-war" "11","java-persistence-api" "11","obsidian-dataview" "11","visual-c++-2022" "11","komodo-ide" "11","vim-tabular" "11","min.js" "11","codan" "11","udisks" "11","visual-age" "11","atom-liveserver" "11","microsoft-webdriver" "11","retrying" "11","ripping" "11","shinyscreenshot" "11","coderef" "11","uccapi" "11","midasr" "11","pyisapie" "11",".net-core-rc1" "11","videogular2" "11","neural-mt" "11","setorientation" "11","goofys" "11","pyface" "11","rallyapi" "11","codeigniter-session" "11",".net-internals" "11",".net-interactive" "11","japid" "11","jaotc" "11","korpus" "11","9-bit-serial" "11","occam-pi" "11","google-api-key-restrictions" "11","neuroph" "11","lumen-5.5" "11","10gen-csharp-driver" "11","a2hs" "11","goji" "11","typewatch" "11","lubm" "11","1c" "11","net-library" "11","rainbows" "11","forio-contour" "11","razor-component-library" "11","7digital" "11","shopifysharp" "11","type-only-import-export" "11","sha1sum" "11","google-api-cpp-client" "11","oursql" "11","lumisoft" "11","visual-studio-exp-2013" "11","sidekit" "11","aac+" "11","shopify-app-extension" "11","audio-playback-agent" "11","synchronizedcollection" "11","revealing-prototype" "11","convex.dev" "11","gvfs" "11","handlerexceptionresolver" "11","policy-violation" "11","cactoos" "11","vertical-partitioning" "11","screenshotexception" "11","gvnix-es" "11","policy-based-security" "11","hard-real-time" "11","gatsby-plugin-intl" "11","handlersocket" "11","polardb" "11","dragonfly-bsd" "11","redhat-decision-manager" "11","redirectwithcookies" "11","android-companion-device" "11","drupal-commons" "11","draftail" "11","mksh" "11","drawablegamecomponent" "11","expectit" "11","redismqserver" "11","druid-rs" "11","convoy-pattern" "11","directml" "11","cookie-policy" "11","diagflow" "11","control-state" "11","tcustomcontrol" "11","mobify-js" "11","registrator" "11","harvest-scm" "11","hash-reference" "11","mobirise" "11","redux-logger" "11","gadinterstitial" "11","exotel-api" "11","nuxtserverinit" "11","exmpp" "11","cache-oblivious" "11","cache-money" "11","veusz" "11","hadoop-native-library" "11","nvim.cmp" "11","regionadapter" "11","normalize-space" "11","gemcutter" "11","drupal-gmap" "11","diem-cms" "11","pluto" "11","plexe" "11","assembly-reference-path" "11","assemblyfileversion" "11","bulkhead" "11","android-expandable-list-view" "11","hook-widgets" "11","dpd" "11","hadoop2.7.3" "11","cop" "11","reference-parameters" "11","bunch" "11","asp.net-web-api-filters" "11","mockall" "11","bump2version" "11","hopac" "11","hllapi" "11","scikit-build" "11","xc32" "11","sqlglot" "11","sqliteexception" "11","opentelemetry-js" "11","tmsh" "11","sproutcore-controllers" "11","sprof" "11","izimodal" "11","xar" "11","xcode-build-phase" "11","tinyxpath" "11","dotnet-dev-certs" "11","token-pasting-operator" "11","jambi" "11","azure-xplat-cli" "11","azure-synapse-link" "11","uiactivityitemprovider" "11","taiko" "11","xamlbuild" "11","spring-webtestclient" "11","highcharts-boost" "11","uialertsheet" "11","iterator-range" "11","sql-search" "11","iterated-logarithm" "11","spring-tld" "11","scrapyjs" "11","dspace-ecu" "11","mod-authz-host" "11","tapandhold" "11","modal-sheet" "11","rabbitmq-cluster" "11","scrapy-request" "11","hit-count" "11","xcode11.5" "11","quickcontact" "11","tact" "11","android-ble-library" "11","hivecli" "11","uifocusguide" "11","azure-virtual-network-gateway" "11","polymaps" "11","xcode16" "11","uidocumentpicker" "11","uimotioneffect" "11","sqlanydb" "11","tabnine" "11","tkpdfviewer" "11","timing-diagram" "11","r10k" "11","xamarin.communitytoolkit" "11","isomorphic-git" "11","scnsphere" "11","hivedb" "11","tkintertable" "11","azure-vm-extension" "11","openshift-nextgen" "11","wysihat" "11","qx11embedcontainer" "11","openmx" "11","tactionlist" "11","opennn" "11","openshift-web-console" "11","iphone-wax" "11","esri-leaflet-geocoder" "11","cfb-mode" "11","merge-tracking" "11","promoting" "11","responsive-navigation" "11","nltokenizer" "11","cextension" "11","text-capture" "11","spline-data-lineage-tracker" "11","eta-expansion" "11","android-orm" "11","cuda-wmma" "11","iphone-3g" "11","texlipse" "11","ethercard" "11","android-lottie" "11","android-locale" "11","certbot-dns-plugin" "11","menubarextra" "11","android-jetpack-compose-row" "11","response.filter" "11","android-jetpack-compose-pager" "11","duckyscript" "11","menpo" "11","acts-as-nested-set" "11","centrifugo" "11","testflight-public-link" "11","activity-oncreateview" "11","centos-6.9" "11","resourceproviderfactory" "11","react-hot-toast" "11","company-mode" "11","nocilla" "11","spdx" "11","project-folder" "11","terraform-cli" "11","angular2-localstorage" "11","ogl" "11","large-query" "11","spatie-activitylog" "11","python-visual" "11","angular-cdk-overlay" "11","commondomain" "11","restricted-profiles" "11","niceforms" "11","angular-jit" "11","esdoc" "11","comlink" "11","mootools-sortable" "11","generic-relationship" "11","comet-ml" "11","nifi-api" "11","genesys-platform-sdk" "11","react-native-0.46" "11","react-multiselect-checkboxes" "11","sparsehash" "11","node-blade" "11","sparse-columns" "11","charm" "11","eslint-plugin-react" "11","charisma" "11","laravel-pint" "11","columnattribute" "11","textlocal" "11","prolog-tabling" "11","messageformat.js" "11","terraform-provider-vault" "11","ipreviewhandler" "11","colormath" "11","prometheus-postgres-exporter" "11","geometry-class-library" "11","moops" "11","ctfontref" "11","ch" "11","terraform-workspace" "11","action-open-document-tree" "11","access-database-engine" "11","pen-tablet" "11","required-reason-api" "11","event-gateway" "11","lso" "11","action-scheduler" "11","ios-mqtt-client-framework" "11","hypercard" "11","huobi" "11","logstash-input-jdbc" "11","react-charts" "11","stplanr" "11","qgrid" "11","ios-icons" "11","qgraphicspathitem" "11","httpserverutility" "11","oculus-runtime" "11","lookup-field" "11","google-cloud-php-client" "11","react-concurrent" "11","zwoptex" "11","perfplot" "11","stringdictionary" "11","resig" "11","qlocalserver" "11","zumo" "11","lovefield" "11","requests-futures" "11","custom-panel" "11","active-passive" "11","logical-reads" "11","perl-html-template" "11","qmultimap" "11","reactablefmtr" "11","react-developer-tools" "11","streaming-video" "11","odata-connected-service" "11","linfu-dynamicproxy" "11","glkbaseeffect" "11","statsvn" "11","urlsplit" "11","quaqua" "11","elm-test" "11","webkit-appearance" "11","gles20" "11","elm-port" "11","ar-mailer" "11","go-agent" "11","componentwillreceiveprops" "11","pgjdbc-ng" "11","amazon-sagemaker-clarify" "11","haskell-src-exts" "11","tfstate" "11","qualified" "11","beaker-testing" "11","ascensor" "11","source-separation" "11","scrubyt" "11","headereditemscontrol" "11","component-design" "11","sourcekitservice" "11","embree" "11","conf.d" "11","qt6.4.1" "11","compiled-bindings" "11","webpack-handlebars-loader" "11","mdxclient" "11","user-environment" "11","zend-config-xml" "11","condition-system" "11","dartpad" "11","emokit" "11","haven" "11","precompiled-views" "11","hbasetestingutility" "11","git-revision" "11","scriptom" "11","stdstack" "11","given" "11","zerossl" "11","if-case" "11","gjslint" "11","hcl-connections" "11","archway-network" "11","scrollbox" "11","conditional-move" "11","hcluster" "11","zoomooz" "11","uses-clause" "11","msnodesqlv8" "11","asgardcms" "11","webmethods-caf" "11","precompiled-binaries" "11","maybeuninit" "11","usesound" "11","usb-modeswitch" "11","ascmd" "11","amasty" "11","autogluon" "11","scribe-server" "11","lighty" "11","arcface" "11","amazon-macie" "11","secevents" "11","weavy" "11","cycle-sort" "11","preprocessor-meta-program" "11","linearprogressindicator" "11","mediarss" "11","batchnorm" "11","struts2-bootstrap-plugin" "11","array-population" "11","google-settings" "11","totem" "11","zipmap" "11","em-synchrony" "11","vaadin-designer" "11","web-api-contrib" "11","maven-jarsigner-plugin" "11","array-initialize" "11","avaudioconverter" "11","flutter-tex" "11","imageareaselect" "11","ticoredatasync" "11","dancer2" "11","stario-sdk" "11","thiserror" "11","focus-stealing" "11","global-key" "11","sortedcollection" "11","identityserver6" "11","autocode" "11","arview" "11","multidrop-bus" "11","multi-az" "11","zio-json" "11","allusersprofile" "11","que" "11","shenandoah" "11","linqpad7" "11","autodesk-tandem" "11","startforegroundservice" "11","sdhc" "11","zen-of-python" "11","endly" "11","fontastic" "11","google-oauth-.net-client" "11","helm-tls" "11","stitches" "11","autodesk-vault" "11","flutter-reactive-forms" "11","sparktable" "11","email-body" "11","starship" "11","amazon-parallelcluster" "11","staticmatic" "11","linux-rt" "11","bigstatsr" "11","topsy" "11","lindo" "11","folder-access" "11","yui-datasource" "11","automotive-grade-linux" "11","static-language" "10","square-checkout" "10","process-accounting" "10","skpsmtpmessage" "10","react-native-skia" "10","replaysubject" "10","cloudcannon" "10","fiducial-markers" "10","triplot" "10","dead-key" "10","apache-edgent" "10","procedural-music" "10","maskededitvalidator" "10","westwind" "10","transfuse" "10","instant-view" "10","xssfworkbook" "10","grapheme-cluster" "10","github-fine-grained-tokens" "10","bartmachine" "10","problem-steps-recorder" "10","reportprogress" "10","websitespark" "10","xsocket" "10","lm-sensors" "10","filenet-ce-sql" "10","clib" "10","regular-type" "10","closeablehttpresponse" "10","intacct" "10","westwind-globalization" "10","temporary-asp.net-files" "10","profvis" "10","reactql" "10","ggtimeseries" "10","deferrable-constraint" "10","edify" "10","skylink" "10","clcircleregion" "10","react-phone-input-2" "10","decentralized-identifiers" "10","ci-server" "10","skein" "10","staking" "10","decimation" "10","ghost-inspector" "10","cloudflarestream" "10","whitespace-language" "10","intellij-idea-2020" "10","sql-server-mobile" "10","sql-server-on-linux" "10","teneo" "10","stampit.js" "10","stackato" "10","cloud-integration" "10","react-rainbow-components" "10","listview-selector" "10","barebox" "10","skype-uri.js" "10","ggez" "10","trestle-admin" "10","ballerina-vscode-plugin" "10","cloudscribe" "10","cloudera-navigator" "10","terasort" "10","sql-trace" "10","cloudera-director" "10","intellij-16" "10","react-notifications" "10","stablebaseline3" "10","tricore" "10","renviron" "10","websphere-mq-ams" "10","trap" "10","tridion-storage-extension" "10","react-reducer" "10","processmaker-api" "10","transport-layer-protocol" "10","cleartk" "10","livestamp.js" "10","team-city-10.0" "10","flutter-font" "10","cl-ppcre" "10","flipside" "10","easyrepro" "10","fluent-bit-rewrite-tag" "10","tsung-recorder" "10","jdk1.8-73" "10","multi-table-delete" "10","ts-check" "10","greenrobot-objectbox" "10","materialapp" "10","matrix-profile" "10","yarp" "10","jest-junit" "10","mux-video" "10","jedox" "10","floating-ip" "10","small-business-server" "10","trustkit" "10","fence-plots" "10","vue-infinite-loading" "10","graph-query" "10","cmfcpropertypage" "10","mathematical-notation" "10","yfrog" "10","clx" "10","tsql-parser" "10","photostream" "10","photoview" "10","cmockery" "10","yecc" "10","xvim" "10","yii2-user-roles" "10","dbt-bigquery" "10","materialfx" "10","tsparticles" "10","feature-activation" "10","truncate-log" "10","slk" "10","multiple-mice" "10","eclipse-m2t-jet" "10","eclipse-mdt" "10","eclipse-2018-12" "10","phalcon-devtools" "10","ddex" "10","fedora11" "10","truevfs" "10","slik" "10","ckfetchrecordchangesopera" "10","apache-http-server" "10","feedbackpanel" "10","flowbite-svelte" "10","react-native-localize" "10","php-ci" "10","clang-plugin" "10","tediousjs" "10","yamlbeans" "10","fbsdkappinvitecontent" "10","vue-pdf" "10","jenkins-mailer-plugin" "10","eclipse-metadata" "10","vsperfmon" "10","jetpack-compose-swipe-to-dismiss" "10","management-pack" "10","s60-3rd-edition" "10","adsapi-php.ini" "10","implicit-grant" "10","discordgo" "10","xnanimation" "10","managedthreadfactory" "10","chatgpt-function-call" "10","implicit-constructor" "10","s3proxy" "10","managedinstallerclass" "10","rusage" "10","voice-interaction" "10","smspdu" "10","filterexpression" "10","socket.io-stream" "10","castle-validators" "10","json-everything" "10","swixml" "10","managed-ews" "10","data-parallel-haskell" ================================================ FILE: docs/index.html ================================================ Mal Web REPL

Mal

Mal Web REPL

 

View source on Github

Mal at a glance

Datatypes

Maps {"key1" "val1", "key2" 123}
Lists (1 2 3 "four")
Vectors [1 2 3 4 "a" "b" "c" 1 2]
Scalars a-symbol, "a string", :a_keyword, 123, nil, true, false

Functions

Calling (<function> <args*>)
Defining named functions (def! <name> (fn* [<args*>] <action>))
Anonymous function (fn* [<args*>] <action>)

Useful Macros and Special Forms

Conditionals if cond or
Multiple Actions (side-effects) (do <action*>...)
Defining things def! defmacro! let*
Quoting ' ` ~ ~@
Examining macros macroexpand

Useful Functions

Math + - * /
Comparison/Boolean = < > <= >= not
Predicates nil? true? false? symbol? keyword? string? list? vector? map? sequential?
Data processing map apply
Data create list vector hash-map
Data inspection first rest get keys vals count get nth contains? empty?
Data manipulation conj cons concat assoc dissoc
Lists and Vectors first rest nth seq
Hash Maps get keys vals contains?
Strings str pr-str seq
Atoms atom atom? deref[@] reset! swap!
Meta meta with-meta[^]
Output println prn

JavaScript Interop

Evaluate JavaScript (js-eval "JS string to eval")
Method call/access (. js-fn arg...)
================================================ FILE: docs/notes.md ================================================ ## Counting languages, implementations, and runtimes/MODES ``` # languages $ egrep -v "\-mal\>|IMPL: mal,.*nim" IMPLS.yml | grep -o "\|IMPL: mal,.*nim" IMPLS.yml | grep -o "\|IMPL: mal,.*nim" IMPLS.yml | grep -o "\_STEP_TO_PROG entry - add _RUNSTEP entry - for a compiled language, add /Makefile - targets: all, step*, stats, stats-lisp, - use native eval in EVAL if available - libedit/GNU readline: - use existing lib, wrap shell call or implement - load history file on first call - add non-blank lines to history - append to history file - step1_read_print - types module: - add boxed types if no language equivalent: - nil, true, false, symbol, integer, string, list - error types if necessary - reader module: - stateful reader object - alternative: mutate token list - tokenize (if regex available) - standard regex pattern: "/[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\.|[^\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)/" - read_str - read_form(new Reader(tokenize(str))) - read_form - detect errors - call read_list or read_atom - read_list - read_form until ')' - return array (boxed) - read_atom (not atom type) - return scalar boxed type: - nil, true, false, symbol, integer, string - skip unquoting - printer module: - _pr_str: - stringify boxed types to their Mal representations - list/array is recursive - skip quoting - repl loop - catch errors, print them and continue - impls without exception handling will need to have a global variable with checks for it at the beginning of critical code sections - Details: - copy step0_repl.EXT to step1_read_print.EXT - modify Makefile if compiled - call reader.read_str from READ - pass through type returned from read_str through READ/EVAL/PRINT - create reader.EXT - if regex support (much easier) then tokenize with this: /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/g - add read_str: - call tokenize - handle blank line (exceptions, return code, global depending on lang features) - read_str -> read_form -> {read_list, read_atom} - mutable reader thing - create printer.EXT - _pr_str function which basically reverses read_str and returns a string representation - run `make test^EXT^step1`. Much of the basics should pass up to vectors - implement read_hash_map (can refactor read_list) - import read_vector - probably want to define types for List and Vector in types.EXT that extend or wrap native arrays - run `make test^EXT^step1`. All mandatory should pass - comments - vectors - Basically: two array types that retain their boxed types, can be challenging depending on the language (e.g. JS, PHP: no clean way to derive new array types). - types module: - add vector boxed type - derived from array if possible - pr_str: - vector is recursive - sequential? - reader module: - read_vector: - re-use read_list but with different constructor, delims - hash-maps - reader module: - re-use read_list function and apply that using hash-map constructor - types module: - pr_str addition - hash-map, map?, assoc, dissoc, get, contains?, keys, vals (probably assoc! and dissoc! for internal) - eval_map: eval the keys and values of hash_maps - EVAL: - if hash_map, call eval_map on it - step2_eval - types module: - symbol?, list? (if no simple idiomatic impl type check) - first, rest, nth on list - eval_ast: - if symbol, return value of looking up in env - if list, eval each item, return new list - otherwise, just return unchanged ast - EVAL/apply: - if not a list, call eval_ast - otherwise, apply first item to eval_ast of (rest ast) - repl_env as simple one level hash map (assoc. array) - store function as hash_map value - Details: - copy step1_read_print.EXT to step2_eval.EXT - create repl_env hash_map) with +, -, *, / - store anon func as values if possible - types.EXT - implement symbol? (symbol_Q) and list? (list_Q) - add env param to EVAL and add to rep EVAL call - EVAL - if not list call eval_ast - otherwise eval_ast, and call first arg with rest - eval_ast - if symbol?, lookup in env - if List, EVAL each and return eval's list - otherwise, return original - optional: handle vector and hash-map in eval_ast - vectors - eval each item, return new vector - hash-maps - eval each value, return new hash_map - step3_env - types module: - may need function type if HashMap is strongly typed (e.g. Java) - env type: - find, set, get (no binds/exprs in constructor yet) - EVAL/apply: - def! - mutate current environment - let* - create new environment with bindings - Details: - cp step2_eval.EXT to step3_env.EXT - add env.EXT if lang support file dep cycles, otherwise, add to types.EXT - Env type - find, get, set methods/functions - use Env type instead of map/assoc. array - eval_ast: use method for lookup - EVAL: - switch on first symbol - def! - set env[a1] to EVAL(a2, env) - let* - loop through let building up let_env - EVAL(a2, let_env) - move apply to default - step4_if_fn_do - types module: - function type if no closures in impl language - _equal_Q function (recursive) - reader module - string unescaping - printer module - print_readably option for pr_str - add function printing to pr_str - string escaping in pr_str - core module (export via core_ns): - export equal_Q from types as = - move arith operations here - add arith comparison functions - pr_str, str, prn, println - list, list?, count, empty? - env module: - add binds/exprs handling to Env constructor with variable arity - EVAL: - do: - if: - fn*: - simple if language supports closures - otherwise needs a way of representing functions that can have associated metadata - define "not" using REP/RE - Details: - cp step3_env.EXT to step4_env.EXT - modify Makefile if compiled - env.EXT - add binds and exprs args. Create new environments with exprs bound to binds. If & symbol, bind rest of exprs to next bind symbol - EVAL: - do: - eval_ast [1:], then return last eval'd element - if - EVAL(a1) - if true EVAL(a2) - else EVAL(a3), unless no a3 then return nil - fn* - if available use function closures to return a new native function that calls EVAL(a2, Env(env, a1, fargs)) - otherwise, store exp, params and env in a structure - core.EXT - create ns object to hold core namespace - move numeric operators here - add comparison operators - add list, list?, empty?, count - run make test^EXT^step4 - implement equal?/equal_Q in types.EXT and refer in core.ns - implement not as rep("(def! not (fn* (a) (if a false true)))") - run make test^EXT^step4: should pass everything except string routines - implement: pr-str, str, prn, println in core.EXT and refer in core.ns - should leverage pr-str from printer.EXT - add reader/printer string quote/unquote - step5_tco - types module: - mal function type: - stores: eval, exp, env, params - eval is EVAL in native mal case (needed for map function later), otherwise reference to platform function - if metadata support, then store exp, env, params as metadata - printer - add printing of mal function type - EVAL: - while loop around whole thing - cases where we directly return result of EVAL, instead set ast and env to what would be put in the EVAL, then loop. - do, if, "apply" - "apply" - if mal function type - set env to new Env based on properties on the function - if native function, same as before - Details: - types.EXT - create Mal function type to store eval, exp, env, params - cp step4_if_fn_do.EXT to step5_tco.EXT - wrap EVAL in infinite while loop - in let*, do, and if: - set ast and env and loop (no return) - in fn* create Mal function type - if compiled, update Makefile - in apply, test if Mal function type: - if so, generate new env from stored env, args and callee params - set ast to stored ast - step6_file - core module: - read-string, slurp functions - define eval and load-file functions - set *ARGV* - if files on command line, use load-file to run first argument using rest as arguments - Details: - cp step5_tco.EXT to step6_file.EXT - if compiled update Makefile - add eval to repl_env - if no (or limited closures) may have to add an "eval" case to EVAL and use function which gets root of environment to env.EXT (see rust). - add empty *ARGV* list to repl_env - in core.ns: - wrap printer.read-str as read-string - implement slurp - implement load-file using rep - test: (load-file "../tests/inc.mal") (inc3 10) - implement command line execution - test: ./step6_file ../tests/incA.mal =>9 - implement comments in reader.EXT (ignore in tokenize) - step7_quote - add is_pair and quasiquote functions - rewrite ast using cons/concat functions - if vectors, use sequential? instead of list? in is_pair - EVAL: - add 'quote', 'quasiquote' cases - core module: - add cons and concat functions - reader module: - add reader macros to read_form for quote, unquote, splice-unquote and quasiquote - Details: - cp step6_file.EXT to step6_quote.EXT - if compiled update Makefile - implement reader macros (', `, ~, ~@) in reader - retest make test^go^step1 - add is_pair and quasiquote - add quote and quasiquote cases to EVAL - implement cons and concat in core.EXT - retest test^go^step7 - step8_macros - types - capability to store ismacro property in function - core module: - add first, rest, nth functions - add is_macro_call and macroexpand - recursively macroexpand lists - if applying a macro function, run it on the ast first before continuing - call macroexpand apply in EVAL before apply - EVAL: - add 'defmacro!' and 'macroexpand' - set ismacro property on function - Details: - cp step7_quote.EXT to step8_macros.EXT - if compiled update Makefile - add isMacro property to Mal Function type - may need to go back and adjust step5-7 - implement is_macro_call and macroexpand - call macroexpand on ast before apply in EVAL - add defmacro! and macroexpand to EVAL switch - make test^go^step8 should pass some basic macros - add nth, first, and rest to core.ns - make test^go^step8 should now pass - step9_try - core module: - throw function - apply, map functions: should not directly call EVAL, which requires the function object to be runnable - readline - nil?, true?, false? - EVAL: - try*/catch*: for normal exceptions, extracts string otherwise extracts full value - set and print *host-language* - define cond and or macros using REP/RE - Details: - cp step8_macros.EXT to stepA_try.EXT - if compiled update Makefile - core.ns implement nil?, true?, false?, symbol?, sequential?, vector, vector? - add mal error type which wraps normal mal type - in core.ns add throw which wraps type in mal error type and throws/raises/sets exception - add try*/catch* support to EVAL - if mal error type, bind to catch* bind symbol - otherwise, bind string of error to catch* bind symbol - implement apply, map in core.ns - make test^go^stepA - implement readline.EXT - provide option (e.g. commented out) to link with GNU readline (GPL) or libedit (BSD) - add hash-map functions: hash-map, map?, assoc, dissoc, get, contains?, keys, vals - add metadata support to List, Vector, HashMap, and Functions - add reader macro - may need to box HashMap and native functions - add atom type, reader macro and functions: with_meta, meta - get `make test^go^stepA` to fully pass - get `./stepA_try ../mal/step1_read_print` to pass - continue for each mal step until ../mal/stepA_try - Now self-hosting! - Extra definitions needed for self-hosting - core module: - symbol?, sequential? (if not already) - vector, vector? - atoms - reader module: - @a reader macro -> (deref a) - core module: - pr_str case - atom type, atom, atom?, deref, reset!, swap! - metadata - reader module: - ^ reader macro reads ^meta obj -> (with-meta obj meta) - types module: - support meta property on collections: lists, vectors, hash-maps, functions, atoms - clone/copy of collections - core module: - add with-meta, meta functions - Other misc: - conj function - stepA_mal - convert returned data to mal data - recursive, similar to pr_str - Details: ================================================ FILE: docs/web/ansi.css ================================================ .jqconsole-ansi-bold { font-weight: bold!important; } .jqconsole-ansi-lighter { font-weight: lighter!important; } .jqconsole-ansi-italic { font-style: italic!important; } .jqconsole-ansi-underline { text-decoration: underline!important; } @-webkit-keyframes blinker { from { opacity: 1.0; } to { opacity: 0.0; } } @-moz-keyframes blinker { from { opacity: 1.0; } to { opacity: 0.0; } } @-ms-keyframes blinker { from { opacity: 1.0; } to { opacity: 0.0; } } @-o-keyframes blinker { from { opacity: 1.0; } to { opacity: 0.0; } } .jqconsole-ansi-blink { -webkit-animation-name: blinker; -moz-animation-name: blinker; -ms-animation-name: blinker; -o-animation-name: blinker; -webkit-animation-iteration-count: infinite; -moz-animation-iteration-count: infinite; -ms-animation-iteration-count: infinite; -o-animation-iteration-count: infinite; -webkit-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -ms-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -o-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -moz-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -webkit-animation-duration: 1s; -moz-animation-duration: 1s; -o-animation-duration: 1s; -ms-animation-duration: 1s; } .jqconsole-ansi-blink-rapid { -webkit-animation-name: blinker; -moz-animation-name: blinker; -ms-animation-name: blinker; -o-animation-name: blinker; -webkit-animation-iteration-count: infinite; -moz-animation-iteration-count: infinite; -ms-animation-iteration-count: infinite; -o-animation-iteration-count: infinite; -webkit-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -ms-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -o-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -moz-animation-timing-function: cubic-bezier(1.0,0,0,1.0); -webkit-animation-duration: 0.5s; -moz-animation-duration: 0.5s; -o-animation-duration: 0.5s; -ms-animation-duration: 0.5s; } .jqconsole-ansi-hidden { visibility:hidden!important; } .jqconsole-ansi-line-through { text-decoration: line-through; } .jqconsole-ansi-fonts-1 { } .jqconsole-ansi-fonts-2 { } .jqconsole-ansi-fonts-3 { } .jqconsole-ansi-fonts-4 { } .jqconsole-ansi-fonts-5 { } .jqconsole-ansi-fonts-6 { } .jqconsole-ansi-fonts-7 { } .jqconsole-ansi-fonts-8 { } .jqconsole-ansi-fonts-9 { } .jqconsole-ansi-fraktur { } .jqconsole-ansi-color-black { color: black!important; } .jqconsole-ansi-color-red { color: red!important; } .jqconsole-ansi-color-green { color: green!important; } .jqconsole-ansi-color-yellow { color: yellow!important; } .jqconsole-ansi-color-blue { color: blue!important; } .jqconsole-ansi-color-magenta { color: magenta!important; } .jqconsole-ansi-color-cyan { color: cyan!important; } .jqconsole-ansi-color-white { color: white!important; } .jqconsole-ansi-background-color-black { background-color: black!important; } .jqconsole-ansi-background-color-red { background-color: red!important; } .jqconsole-ansi-background-color-green { background-color: green!important; } .jqconsole-ansi-background-color-yellow { background-color: yellow!important; } .jqconsole-ansi-background-color-blue { background-color: blue!important; } .jqconsole-ansi-background-color-magenta { background-color: magenta!important; } .jqconsole-ansi-background-color-cyan { background-color: cyan!important; } .jqconsole-ansi-background-color-white { background-color: white!important; } .jqconsole-ansi-framed { border: 1px solid!important; } .jqconsole-ansi-overline { text-decoration: overline!important; } ================================================ FILE: docs/web/base.css ================================================ /* * Skeleton V1.0.2 * Copyright 2011, Dave Gamache * www.getskeleton.com * Free to use under the MIT license. * http://www.opensource.org/licenses/mit-license.php * 5/20/2011 */ /* Table of Content ================================================== #Reset & Basics #Basic Styles #Site Styles #Typography #Links #Lists #Images #Buttons #Tabs #Forms #Misc */ /* #Reset & Basics (Inspired by E. Meyers) ================================================== */ html, body, div, span, applet, object, iframe, h1, h2, h3, h4, h5, h6, p, blockquote, pre, a, abbr, acronym, address, big, cite, code, del, dfn, em, img, ins, kbd, q, s, samp, small, strike, strong, sub, sup, tt, var, b, u, i, center, dl, dt, dd, ol, ul, li, fieldset, form, label, legend, table, caption, tbody, tfoot, thead, tr, th, td, article, aside, canvas, details, embed, figure, figcaption, footer, header, hgroup, menu, nav, output, ruby, section, summary, time, mark, audio, video { margin: 0; padding: 0; border: 0; font-size: 100%; font: inherit; vertical-align: baseline; } article, aside, details, figcaption, figure, footer, header, hgroup, menu, nav, section { display: block; } body { line-height: 1; } ol, ul { list-style: none; } blockquote, q { quotes: none; } blockquote:before, blockquote:after, q:before, q:after { content: ''; content: none; } table { border-collapse: collapse; border-spacing: 0; } /* #Basic Styles ================================================== */ body { background: #ebe7d7 url(bg-body.png); font: 14px/21px "HelveticaNeue", "Helvetica Neue", Helvetica, Arial, sans-serif; color: #444; -webkit-font-smoothing: antialiased; /* Fix for webkit rendering */ } /* #Typography ================================================== */ h1, h2, h3, h4, h5, h6 { font-weight: normal; } h1 a, h2 a, h3 a, h4 a, h5 a, h6 a { font-weight: inherit; } h1 { font-size: 56px; line-height: 50px; font-family: "ExoBlack"; text-transform: uppercase; color: #8f4732; margin-bottom: 10px; text-shadow: 1px 1px 1px #a9a17c; } h2 { font-size: 18px; line-height: 40px; margin-top: -45px; font-family: "ExoBold"; color: #327a8e; float: right; } h3 { font-size: 24px; line-height: 34px; margin-top: 20px; margin-left: 10px; font-family: "ExoBold"; color: #327a8e; } h4 { font-size: 18px; line-height: 30px; margin-bottom: 4px; font-family: "ExoBold"; color: #444; } h5 { font-size: 17px; line-height: 24px; } h6 { font-size: 14px; line-height: 21px; } .subheader { color: #777; } p { margin: 0 0 20px 0; } p img { margin: 0; } p.lead { font-size: 21px; line-height: 27px; color: #777; } em { font-style: italic; } strong { font-weight: bold; color: #333; } small { font-size: 80%; } /* Blockquotes */ blockquote, blockquote p { font-size: 17px; line-height: 24px; color: #777; font-style: italic; } blockquote { margin: 0 0 20px; padding: 9px 20px 0 19px; border-left: 1px solid #ddd; } blockquote cite { display: block; font-size: 12px; color: #555; } blockquote cite:before { content: "\2014 \0020"; } blockquote cite a, blockquote cite a:visited, blockquote cite a:visited { color: #555; } hr { border: solid #ddd; border-width: 1px 0 0; clear: both; margin: 10px 0 30px; height: 0; } /* #Links ================================================== */ a, a:visited { color: #333; text-decoration: underline; outline: 0; } a:hover, a:focus { color: #000; } p a, p a:visited { line-height: inherit; } /* #Lists ================================================== */ ul, ol { margin-bottom: 20px; } ul { list-style: none outside; } ol { list-style: decimal; } ol, ul.square, ul.circle, ul.disc { margin-left: 30px; } ul.square { list-style: square outside; } ul.circle { list-style: circle outside; } ul.disc { list-style: disc outside; } ul ul, ul ol, ol ol, ol ul { margin: 4px 0 5px 30px; font-size: 90%; } ul ul li, ul ol li, ol ol li, ol ul li { margin-bottom: 6px; } li { line-height: 18px; margin-bottom: 12px; } ul.large li { line-height: 21px; } li p { line-height: 21px; } /* #Images ================================================== */ /* The purpose of the below declaration is to make sure images don't exceed the width of columns they are put into when resizing window. Unfortunately, this declaration breaks certain lightbox, slider or other plugins, so the best solution is to individually call these properties on images that are children of the grid that you want to resize with grid. img { max-width: 100%; height: auto; } */ /* #Forms ================================================== */ form { margin-bottom: 20px; } fieldset { margin-bottom: 20px; } input[type="text"], input[type="password"], input[type="email"], textarea, select { border: 1px solid #ccc; padding: 6px 4px; outline: none; -moz-border-radius: 2px; -webkit-border-radius: 2px; border-radius: 2px; font: 13px "HelveticaNeue", "Helvetica Neue", Helvetica, Arial, sans-serif; color: #777; margin: 0; width: 210px; max-width: 100%; display: block; margin-bottom: 20px; background: #fff; } select { padding: 0; } input[type="text"]:focus, input[type="password"]:focus, input[type="email"]:focus, textarea:focus { border: 1px solid #aaa; color: #444; -moz-box-shadow: 0 0 3px rgba(0,0,0,.2); -webkit-box-shadow: 0 0 3px rgba(0,0,0,.2); box-shadow: 0 0 3px rgba(0,0,0,.2); } textarea { min-height: 60px; } label, legend { display: block; font-weight: bold; font-size: 13px; } select { width: 220px; } input[type="checkbox"] { display: inline; } label span, legend span { font-weight: normal; font-size: 13px; color: #444; } /* #Misc ================================================== */ .remove-bottom { margin-bottom: 0 !important; } .half-bottom { margin-bottom: 10px !important; } .add-bottom { margin-bottom: 20px !important; } ================================================ FILE: docs/web/console.css ================================================ /* Outer console element */ #console { } /* The inner console element. */ .jqconsole { background-color: black;; } .jqconsole-prompt { color: #0d0; } .jqconsole-old-prompt { color: #0b0; font-weight: normal; } .jqconsole-input { color: #dd0; } .jqconsole-old-input { color: #bb0; font-weight: normal; } .jqconsole-output { font-weight: lighter; font-family:monospace; color: grey; } .jqconsole-return { font-weight: normal; font-family:monospace; color: white; } .jqconsole-error { font-weight: normal; font-family:monospace; color: red; } /* The cursor. */ .jqconsole-cursor { font-weight: normal; font-family:monospace; background-color: #BDB; } /* The cursor color when the console looses focus. */ .jqconsole-blurred .jqconsole-cursor { font-weight: normal; font-family:monospace; background-color: #444; } .brace { color: #00FFFF; } .paren { color: #FF00FF; } .bracket { color: #FFFF00; } .dquote { color: #FF8888; } .jqconsole-composition { background-color: red; } ================================================ FILE: docs/web/himera.css ================================================ /* Additional Classes --------------------------------------------- */ .source { font-family: "ExoRegular"; font-size: 18px; height: 31px; margin-top: 20px; text-align: right; } .source img { margin-left: 5px; vertical-align: sub; } .source a { text-decoration: none; } .rule { background: url(bg-rule.png); height: 12px; clear: both; margin-top: 20px; margin-bottom: 20px; } .cheat-box-container { background-color: rgba(213,207,180,0.4); border-radius: 5px; -moz-border-radius: 5px; margin-top: 20px; } .cheat-box { padding: 20px; } table { font-family: monospace; margin-top: 20px; width: 100%; } td { padding: 3px; } .row-one { background-color: #f2efe4; } .row-label { color: #666; font-family: "ExoBold"; text-transform: uppercase; } .footer-logo { font-size: 18px; font-family: "ExoBlack"; text-transform: uppercase; color: #8f4732; } ul.footer-links { float: right; } .footer-links li { font-family: "ExoRegular"; font-size: 14px; display: inline; list-style-type: none; margin-left: 10px; text-transform: uppercase; } .footer-links li a { color: #327a8e; text-decoration: none; } .footer-links li a:hover { color: #333; } .tiny-note { font-size: small; } /* Editor ---------------------------------------------- */ .CodeMirror { position: relative; height: 320px; background: #fbfbf8; border-radius: 5px; -moz-border-radius: 5px; border: 1px solid #d5ceb4; } /* Console --------------------------------------------- */ #console { position: relative; height: 220px; background: #fbfbf8; border-radius: 5px; -moz-border-radius: 5px; border: 1px solid #d5ceb4; } /* Console --------------------------------------------- */ /* The console container element */ #console { position: relative; height: 320px; background-color:#fbfbf8;; } /* The inner console element. */ .jqconsole { background: #fbfbf8; border-radius: 5px; -moz-border-radius: 5px; border: 1px solid #d5ceb4; padding: 10px; white-space: pre-wrap; word-wrap: break-word; } /* The cursor. */ .jqconsole-cursor { font-weight: normal; font-family:monospace; background-color: #000; } /* The cursor color when the console looses focus. */ .jqconsole-blurred .jqconsole-cursor { font-weight: normal; font-family:monospace; background-color: #7F7F7F; } /* The current prompt text color */ .jqconsole-prompt { font-weight: normal; font-family:monospace; color: #000; } /* The command history */ .jqconsole-old-prompt { font-weight: normal; font-family:monospace; color: #000; } /* The text color when in input mode. */ .jqconsole-input { font-weight: normal; font-family:monospace; color: #000; } /* Previously entered input. */ .jqconsole-old-input { color: #000; font-weight: normal; font-family:monospace; } /* The text color of the output. */ .jqconsole-output { font-weight: normal; font-family:monospace; color: #000; } .jqconsole-inner { /*width:580px;*/ height:200px; margin: 10px 10px; overflow:auto; text-align:left; } .jqconsole-message-value { color:#333; font-family:monospace; padding:0.1em; } .jqconsole-prompt-box { color:#444; font-family:monospace; } .jqconsole-focus span.jquery-console-cursor { background:#333; color:#eee; font-weight:bold; } .jqconsole-message-error { font-family:sans-serif; font-weight:bold; padding:0.1em; color:#ef0505; } .jqconsole-message-success { color:#187718; font-family:monospace; padding:0.1em; } .ebnf { color:#444; font-family:monospace; text-transform: uppercase; } .doc-link { font-size: 0.65em; text-decoration: none; } /* Synonym Styles */ #himera-synonym h1 { margin-left: 10px; } #himera-synonym h1 div { font-size: 16px; color: black; } #himera-synonym h4, #himera-synonym h5 { margin-left: 10px; } #himera-synonym .cheat-box-container { margin-top: 0px; background-color: rgb(255, 250, 240); border: 1px solid #ccc; box-sizing: border-box; -webkit-box-sizing: border-box; -moz-box-sizing: border-box; -webkit-box-shadow: inset 0 1px 2px rgba(0, 0, 0, .1); -moz-box-shadow: inset 0 1px 2px rgba(0, 0, 0, .1); -o-box-shadow: inset 0 1px 2px rgba(0, 0, 0, .1); -ms-box-shadow: inset 0 1px 2px rgba(0, 0, 0, .1); box-shadow: inset 0 1px 2px rgba(0, 0, 0, .1); } #himera-synonym pre { font-size: 13px; font-family: monospace; } .syn-section { clear: both; float: left; margin-bottom: 20px; } #himera-synonym table { margin: 0; padding: 0; } #himera-synonym .container { margin: 0; overflow-x: hidden !important; overflow-y: hidden !important; } h1 a { text-decoration: none; color: inherit; } h1 a:visited { text-decoration: none; color: inherit; } ================================================ FILE: docs/web/layout.css ================================================ /* * Skeleton V1.0.2 * Copyright 2011, Dave Gamache * www.getskeleton.com * Free to use under the MIT license. * http://www.opensource.org/licenses/mit-license.php * 5/20/2011 */ /* Table of Content ================================================== #Site Styles #Page Styles #Media Queries #Font-Face */ /* #Site Styles ================================================== */ /* #Page Styles ================================================== */ /* #Media Queries ================================================== */ /* iPad Portrait/Browser */ @media only screen and (min-width: 768px) and (max-width: 991px) {} /* Mobile/Browser */ @media only screen and (max-width: 767px) {} /* Mobile Landscape/Browser */ @media only screen and (min-width: 480px) and (max-width: 767px) {} /* Anything smaller than standard 960 */ @media only screen and (max-width: 959px) { h1 { font-size: 48px; } h2 { font-size: 16px; float: none; line-height: 150%; margin-top: -10px; } h3 { font-size: 18px; } h4 { font-size: 14px; } .source p { font-size: 16px; } } /* iPad Portrait Only */ @media only screen and (min-width: 768px) and (max-width: 991px) and (max-device-width: 1000px) {} /* Mobile Only */ @media only screen and (max-width: 767px) and (max-device-width: 1000px) {} /* Mobile Landscape Only */ @media only screen and (min-width: 480px) and (max-width: 767px) and (max-device-width: 1000px) {} /* Fonts --------------------------------------------- */ @font-face { font-family: 'ExoBold'; src: url('fonts/exo-bold-webfont.eot'); src: url('fonts/exo-bold-webfont.eot?#iefix') format('embedded-opentype'), url('fonts/exo-bold-webfont.woff') format('woff'), url('fonts/exo-bold-webfont.ttf') format('truetype'), url('fonts/exo-bold-webfont.svg#ExoBold') format('svg'); font-weight: normal; font-style: normal; } @font-face { font-family: 'ExoBlack'; src: url('fonts/exo-black-webfont.eot'); src: url('fonts/exo-black-webfont.eot?#iefix') format('embedded-opentype'), url('fonts/exo-black-webfont.woff') format('woff'), url('fonts/exo-black-webfont.ttf') format('truetype'), url('fonts/exo-black-webfont.svg#ExoBlack') format('svg'); font-weight: normal; font-style: normal; } @font-face { font-family: 'ExoRegular'; src: url('fonts/exo-regular-webfont.eot'); src: url('fonts/exo-regular-webfont.eot?#iefix') format('embedded-opentype'), url('fonts/exo-regular-webfont.woff') format('woff'), url('fonts/exo-regular-webfont.ttf') format('truetype'), url('fonts/exo-regular-webfont.svg#ExoRegular') format('svg'); font-weight: normal; font-style: normal; } ================================================ FILE: docs/web/mal.js ================================================ var max_history_length = 1000; function jq_load_history(jq) { if (localStorage['mal_history']) { var lines = JSON.parse(localStorage['mal_history']); if (lines.length > max_history_length) { lines = lines.slice(lines.length-max_history_length); } jq.SetHistory(lines); } } function jq_save_history(jq) { var lines = jq.GetHistory(); localStorage['mal_history'] = JSON.stringify(lines); } var readline = { 'readline': function(prompt_str) { return prompt(prompt_str); }}; // Node vs browser behavior var types = {}; if (typeof module === 'undefined') { var exports = types; } // General functions function _obj_type(obj) { if (_symbol_Q(obj)) { return 'symbol'; } else if (_list_Q(obj)) { return 'list'; } else if (_vector_Q(obj)) { return 'vector'; } else if (_hash_map_Q(obj)) { return 'hash-map'; } else if (_nil_Q(obj)) { return 'nil'; } else if (_true_Q(obj)) { return 'true'; } else if (_false_Q(obj)) { return 'false'; } else if (_atom_Q(obj)) { return 'atom'; } else { switch (typeof(obj)) { case 'number': return 'number'; case 'function': return 'function'; case 'string': return obj[0] == '\u029e' ? 'keyword' : 'string'; default: throw new Error("Unknown type '" + typeof(obj) + "'"); } } } function _sequential_Q(lst) { return _list_Q(lst) || _vector_Q(lst); } function _equal_Q (a, b) { var ota = _obj_type(a), otb = _obj_type(b); if (!(ota === otb || (_sequential_Q(a) && _sequential_Q(b)))) { return false; } switch (ota) { case 'symbol': return a.value === b.value; case 'list': case 'vector': if (a.length !== b.length) { return false; } for (var i=0; i 0 ? obj : null; } else if (types._vector_Q(obj)) { return obj.length > 0 ? Array.prototype.slice.call(obj, 0): null; } else if (types._string_Q(obj)) { return obj.length > 0 ? obj.split('') : null; } else if (obj === null) { return null; } else { throw new Error("seq: called on non-sequence"); } } function apply(f) { var args = Array.prototype.slice.call(arguments, 1); return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); } function map(f, lst) { return lst.map(function(el){ return f(el); }); } // Metadata functions function with_meta(obj, m) { var new_obj = types._clone(obj); new_obj.__meta__ = m; return new_obj; } function meta(obj) { // TODO: support symbols and atoms if ((!types._sequential_Q(obj)) && (!(types._hash_map_Q(obj))) && (!(types._function_Q(obj)))) { throw new Error("attempt to get metadata from: " + types._obj_type(obj)); } return obj.__meta__; } // Atom functions function deref(atm) { return atm.val; } function reset_BANG(atm, val) { return atm.val = val; } function swap_BANG(atm, f) { var args = [atm.val].concat(Array.prototype.slice.call(arguments, 2)); atm.val = f.apply(f, args); return atm.val; } function js_eval(str) { return interop.js_to_mal(eval(str.toString())); } function js_method_call(object_method_str) { var args = Array.prototype.slice.call(arguments, 1), r = interop.resolve_js(object_method_str), obj = r[0], f = r[1]; var res = f.apply(obj, args); return interop.js_to_mal(res); } // types.ns is namespace of type functions var ns = {'type': types._obj_type, '=': types._equal_Q, 'throw': mal_throw, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, 'number?': types._number_Q, 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, 'fn?': types._fn_Q, 'macro?': types._macro_Q, 'pr-str': pr_str, 'str': str, 'prn': prn, 'println': println, 'readline': readline.readline, 'read-string': reader.read_str, 'slurp': slurp, '<' : function(a,b){return a' : function(a,b){return a>b;}, '>=' : function(a,b){return a>=b;}, '+' : function(a,b){return a+b;}, '-' : function(a,b){return a-b;}, '*' : function(a,b){return a*b;}, '/' : function(a,b){return a/b;}, "time-ms": time_ms, 'list': types._list, 'list?': types._list_Q, 'vector': types._vector, 'vector?': types._vector_Q, 'hash-map': types._hash_map, 'map?': types._hash_map_Q, 'assoc': assoc, 'dissoc': dissoc, 'get': get, 'contains?': contains_Q, 'keys': keys, 'vals': vals, 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, 'nth': nth, 'first': first, 'rest': rest, 'empty?': empty_Q, 'count': count, 'apply': apply, 'map': map, 'conj': conj, 'seq': seq, 'with-meta': with_meta, 'meta': meta, 'atom': types._atom, 'atom?': types._atom_Q, "deref": deref, "reset!": reset_BANG, "swap!": swap_BANG, 'js-eval': js_eval, '.': js_method_call }; exports.ns = core.ns = ns; if (typeof module !== 'undefined') { } // read function READ(str) { return reader.read_str(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))]; } else { return [types._symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; } } function is_macro_call(ast, env) { return types._list_Q(ast) && types._symbol_Q(ast[0]) && env.find(ast[0]) && env.get(ast[0])._ismacro_; } function macroexpand(ast, env) { while (is_macro_call(ast, env)) { var mac = env.get(ast[0]); ast = mac.apply(mac, ast.slice(1)); } return ast; } function eval_ast(ast, env) { if (types._symbol_Q(ast)) { return env.get(ast); } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); } return new_hm; } else { return ast; } } function _EVAL(ast, env) { while (true) { //printer.println("EVAL:", printer._pr_str(ast, true)); if (!types._list_Q(ast)) { return eval_ast(ast, env); } // apply list ast = macroexpand(ast, env); if (!types._list_Q(ast)) { return eval_ast(ast, env); } if (ast.length === 0) { return ast; } var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; switch (a0.value) { case "def!": var res = EVAL(a2, env); return env.set(a1, res); case "let*": var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { let_env.set(a1[i], EVAL(a1[i+1], let_env)); } ast = a2; env = let_env; break; case "quote": return a1; case "quasiquote": ast = quasiquote(a1); break; case 'defmacro!': var func = EVAL(a2, env); func._ismacro_ = true; return env.set(a1, func); case 'macroexpand': return macroexpand(a1, env); case "try*": try { return EVAL(a1, env); } catch (exc) { if (a2 && a2[0].value === "catch*") { if (exc instanceof Error) { exc = exc.message; } return EVAL(a2[2], new Env(env, [a2[1]], [exc])); } else { throw exc; } } case "do": eval_ast(ast.slice(1, -1), env); ast = ast[ast.length-1]; break; case "if": var cond = EVAL(a1, env); if (cond === null || cond === false) { ast = (typeof a3 !== "undefined") ? a3 : null; } else { ast = a2; } break; case "fn*": return types._function(EVAL, Env, a2, env, a1); default: var el = eval_ast(ast, env), f = el[0]; if (f.__ast__) { ast = f.__ast__; env = f.__gen_env__(el.slice(1)); } else { return f.apply(f, el.slice(1)); } } } } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; // core.js: defined using javascript for (var n in core.ns) { repl_env.set(types._symbol(n), core.ns[n]); } repl_env.set(types._symbol('eval'), function(ast) { return EVAL(ast, repl_env); }); repl_env.set(types._symbol('*ARGV*'), []); // core.mal: defined using the language itself rep("(def! *host-language* \"javascript\")") rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); rep("(def! inc (fn* [x] (+ x 1)))"); rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"); rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode rep("(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: docs/web/skeleton.css ================================================ /* * Skeleton V1.0.2 * Copyright 2011, Dave Gamache * www.getskeleton.com * Free to use under the MIT license. * http://www.opensource.org/licenses/mit-license.php * 5/20/2011 */ /* Table of Contents ================================================== #Base 960 Grid #Tablet (Portrait) #Mobile (Portrait) #Mobile (Landscape) #Clearing */ /* #Base 960 Grid ================================================== */ .container { position: relative; width: 960px; margin: 30px auto; padding: 0; } .column, .columns { float: left; display: inline; margin-left: 10px; margin-right: 10px; } .row { margin-bottom: 20px; } /* Nested Column Classes */ .column.alpha, .columns.alpha { margin-left: 0; } .column.omega, .columns.omega { margin-right: 0; } /* Base Grid */ .container .one.column { width: 40px; } .container .two.columns { width: 100px; } .container .three.columns { width: 160px; } .container .four.columns { width: 220px; } .container .five.columns { width: 280px; } .container .six.columns { width: 340px; } .container .seven.columns { width: 400px; } .container .eight.columns { width: 460px; } .container .nine.columns { width: 520px; } .container .ten.columns { width: 580px; } .container .eleven.columns { width: 640px; } .container .twelve.columns { width: 700px; } .container .thirteen.columns { width: 760px; } .container .fourteen.columns { width: 820px; } .container .fifteen.columns { width: 880px; } .container .sixteen.columns { width: 940px; } .container .one-third.column { width: 300px; } .container .two-thirds.column { width: 620px; } /* Offsets */ .container .offset-by-one { padding-left: 60px; } .container .offset-by-two { padding-left: 120px; } .container .offset-by-three { padding-left: 180px; } .container .offset-by-four { padding-left: 240px; } .container .offset-by-five { padding-left: 300px; } .container .offset-by-six { padding-left: 360px; } .container .offset-by-seven { padding-left: 420px; } .container .offset-by-eight { padding-left: 480px; } .container .offset-by-nine { padding-left: 540px; } .container .offset-by-ten { padding-left: 600px; } .container .offset-by-eleven { padding-left: 660px; } .container .offset-by-twelve { padding-left: 720px; } .container .offset-by-thirteen { padding-left: 780px; } .container .offset-by-fourteen { padding-left: 840px; } .container .offset-by-fifteen { padding-left: 900px; } /* #Tablet (Portrait) ================================================== */ /* Note: Design for a width of 768px */ @media only screen and (min-width: 768px) and (max-width: 959px) { .container { width: 768px; } .container .column, .container .columns { margin-left: 10px; margin-right: 10px; } .column.alpha, .columns.alpha { margin-left: 0; margin-right: 10px; } .column.omega, .columns.omega { margin-right: 0; margin-left: 10px; } .container .one.column { width: 28px; } .container .two.columns { width: 76px; } .container .three.columns { width: 124px; } .container .four.columns { width: 172px; } .container .five.columns { width: 220px; } .container .six.columns { width: 268px; } .container .seven.columns { width: 316px; } .container .eight.columns { width: 364px; } .container .nine.columns { width: 412px; } .container .ten.columns { width: 460px; } .container .eleven.columns { width: 508px; } .container .twelve.columns { width: 556px; } .container .thirteen.columns { width: 604px; } .container .fourteen.columns { width: 652px; } .container .fifteen.columns { width: 700px; } .container .sixteen.columns { width: 748px; } .container .one-third.column { width: 236px; } .container .two-thirds.column { width: 492px; } /* Offsets */ .container .offset-by-one { padding-left: 48px; } .container .offset-by-two { padding-left: 96px; } .container .offset-by-three { padding-left: 144px; } .container .offset-by-four { padding-left: 192px; } .container .offset-by-five { padding-left: 288px; } .container .offset-by-six { padding-left: 336px; } .container .offset-by-seven { padding-left: 348px; } .container .offset-by-eight { padding-left: 432px; } .container .offset-by-nine { padding-left: 480px; } .container .offset-by-ten { padding-left: 528px; } .container .offset-by-eleven { padding-left: 576px; } .container .offset-by-twelve { padding-left: 624px; } .container .offset-by-thirteen { padding-left: 672px; } .container .offset-by-fourteen { padding-left: 720px; } .container .offset-by-fifteen { padding-left: 900px; } } /* #Mobile (Portrait) ================================================== */ /* Note: Design for a width of 320px */ @media only screen and (max-width: 767px) { .container { width: 300px; } .columns, .column { margin: 0; } .container .one.column, .container .two.columns, .container .three.columns, .container .four.columns, .container .five.columns, .container .six.columns, .container .seven.columns, .container .eight.columns, .container .nine.columns, .container .ten.columns, .container .eleven.columns, .container .twelve.columns, .container .thirteen.columns, .container .fourteen.columns, .container .fifteen.columns, .container .sixteen.columns, .container .one-third.column, .container .two-thirds.column { width: 300px; } /* Offsets */ .container .offset-by-one, .container .offset-by-two, .container .offset-by-three, .container .offset-by-four, .container .offset-by-five, .container .offset-by-six, .container .offset-by-seven, .container .offset-by-eight, .container .offset-by-nine, .container .offset-by-ten, .container .offset-by-eleven, .container .offset-by-twelve, .container .offset-by-thirteen, .container .offset-by-fourteen, .container .offset-by-fifteen { padding-left: 0; } } /* #Mobile (Landscape) ================================================== */ /* Note: Design for a width of 480px */ @media only screen and (min-width: 480px) and (max-width: 767px) { .container { width: 420px; } .columns, .column { margin: 0; } .container .one.column, .container .two.columns, .container .three.columns, .container .four.columns, .container .five.columns, .container .six.columns, .container .seven.columns, .container .eight.columns, .container .nine.columns, .container .ten.columns, .container .eleven.columns, .container .twelve.columns, .container .thirteen.columns, .container .fourteen.columns, .container .fifteen.columns, .container .sixteen.columns, .container .one-third.column, .container .two-thirds.column { width: 420px; } } /* #Clearing ================================================== */ /* Self Clearing Goodness */ .container:after { content: "\0020"; display: block; height: 0; clear: both; visibility: hidden; } /* Use clearfix class on parent to clear nested columns, or wrap each row of columns in a
*/ .clearfix:before, .clearfix:after, .row:before, .row:after { content: '\0020'; display: block; overflow: hidden; visibility: hidden; width: 0; height: 0; } .row:after, .clearfix:after { clear: both; } .row, .clearfix { zoom: 1; } /* You can also use a
to clear columns */ .clear { clear: both; display: block; overflow: hidden; visibility: hidden; width: 0; height: 0; } ================================================ FILE: examples/clojurewest2014.mal ================================================ ;; Mal Presentation (def! clear (fn* () (str ""))) (def! bold (fn* (s) (str "" s ""))) (def! blue (fn* (s) (str "" s ""))) (def! title (fn* (s) (bold (blue (str s "\n"))))) (def! title2 (fn* (s) (bold (blue s)))) (def! conj-slides (list (list (title2 " __ __ _ _") (title2 "| \\/ | / \\ | |") (title2 "| |\\/| | / _ \\ | | ") (title2 "| | | |/ ___ \\| |___ ") (title2 "|_| |_/_/ \\_\\_____|")) (list (title "gherkin") "- a lisp1 written in bash4") (list (title "mal - an interpreter for a subset of Clojure")) (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python" "- and Clojure") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python" "- and Clojure" "- and C and Java and PHP") (list (title "things it has") "- scalars: integers, strings, symbols, nil, true, false" "- immutable collections: lists, vectors, hash-maps" "- metadata, atoms" "- def!, fn*, let*" " - varargs: (fn* (x y & more) ...)" "- tail call optimization" " - except GNU make implementation (no iteration)" "- macros (quote, unquote, quasiquote, splice-quote)" "- almost 300 unit tests" "- REPL with readline (GNU readline or libedit)") (list (title "things it does not have") "- performance" "- namespaces" "- keywords" "- GC (in bash, make, C implementations)" "- lots of other things") (list (title "why?") "- because!") (list (title "why?") "- because!" "- gherkin was an inspiration to higher levels of crazy" "- evolved into learning tool" "- way to learn about Lisp and also the target language" "- each implementation broken into small 10 steps") (list (title "thanks to:") "- Peter Norvig: inspiration: lispy" " - http://norvig.com/lispy.html" "- Alan Dipert: gherkin, original gherkin slides" " - https://github.com/alandipert/gherkin") (list (title "mal - Make a Lisp") "https://github.com/kanaka/mal") (list (title "demo")))) (def! present (fn* (slides) (if (> (count slides) 0) (do ;;(py!* "import os; r = os.system('clear')") ;;(sh* "clear") ;;(make* "$(shell clear)") (println (clear)) ;;(prn (first slides)) (apply println (map (fn* (line) (str "\n " line)) (first slides))) (println "\n\n\n") (readline "") (present (rest slides)))))) (present conj-slides) ================================================ FILE: examples/exercises.mal ================================================ ;; These are the answers to the questions in ../docs/exercise.md. ;; In order to avoid unexpected circular dependencies among solutions, ;; this answer file attempts to be self-contained. (def! reduce (fn* (f init xs) (if (empty? xs) init (reduce f (f init (first xs)) (rest xs))))) (def! foldr (fn* [f init xs] (if (empty? xs) init (f (first xs) (foldr f init (rest xs)))))) ;; Reimplementations. (def! nil? (fn* [x] (= x nil ))) (def! true? (fn* [x] (= x true ))) (def! false? (fn* [x] (= x false))) (def! empty? (fn* [x] (= x [] ))) (def! sequential? (fn* [x] (if (list? x) true (vector? x)))) (def! > (fn* [a b] (< b a) )) (def! <= (fn* [a b] (not (< b a)))) (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)))) (def! count (fn* [xs] (if (nil? xs) 0 (reduce (fn* [acc _] (+ 1 acc)) 0 xs)))) (def! nth (fn* [xs index] (if (if (<= 0 index) (not (empty? xs))) ; logical and (if (= 0 index) (first xs) (nth (rest xs) (- index 1))) (throw "nth: index out of range")))) (def! map (fn* [f xs] (foldr (fn* [x acc] (cons (f x) acc)) () xs))) (def! concat (fn* [& xs] (foldr (fn* [x acc] (foldr cons acc x)) () xs))) (def! conj (fn* [xs & ys] (if (vector? xs) (vec (concat xs ys)) (reduce (fn* [acc x] (cons x acc)) xs ys)))) (def! do2 (fn* [& xs] (nth xs (- (count xs) 1)))) (def! do3 (fn* [& xs] (reduce (fn* [_ x] x) nil xs))) ;; do2 will probably be more efficient when lists are implemented as ;; arrays with direct indexing, but when they are implemented as ;; linked lists, do3 may win because it only does one traversal. (defmacro! quote2 (fn* [ast] (list (fn* [] ast)))) (def! _quasiquote_iter (fn* [x acc] (if (if (list? x) (= (first x) 'splice-unquote)) ; logical and (list 'concat (first (rest x)) acc) (list 'cons (list 'quasiquote2 x) acc)))) (defmacro! quasiquote2 (fn* [ast] (if (list? ast) (if (= (first ast) 'unquote) (first (rest ast)) (foldr _quasiquote_iter () ast)) (if (vector? ast) (list 'vec (foldr _quasiquote_iter () ast)) (list 'quote ast))))) ;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns ;; (f k1 v1 (f k2 v2 (f ... (f kn vn)))). (def! _foldr_pairs (fn* [f init kvs] (if (empty? kvs) init (let* [key (first kvs) rst (rest kvs) val (first rst) acc (_foldr_pairs f init (rest rst))] (f key val acc))))) (defmacro! let*A (fn* [binds form] (let* [formal (_foldr_pairs (fn* [key val acc] (cons key acc)) () binds) actual (_foldr_pairs (fn* [key val acc] (cons val acc)) () binds)] `((fn* ~formal ~form) ~@actual)))) ;; Fails for (let* [a 1 b (+ 1 a)] b) (defmacro! let*B (fn* [binds form] (let* [f (fn* [key val acc] `((fn* [~key] ~acc) ~val))] (_foldr_pairs f form binds)))) ;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) (def! _c_combinator (fn* [x] (x x))) (def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v)))))) (def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x)))) (defmacro! let*C (fn* [binds form] (let* [f (fn* [key val acc] `((fn* [~key] ~acc) (_Y_combinator (fn* [~key] ~val))))] (_foldr_pairs f form binds)))) ;; Fails for mutual recursion. ;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html ;; if you are motivated to implement solution D. (def! apply ;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the ;; resulting function call (the surrounding environment does not ;; matter when evaluating a function call). ;; Use nil as marker to detect deepest recursive call. (let* [q (fn* [x] (list 'quote x)) iter (fn* [x acc] (if (nil? acc) ; x is the last element (a sequence) (map q x) (cons (q x) acc)))] (fn* [& xs] (eval (foldr iter nil xs))))) ;; Folds (def! sum (fn* [xs] (reduce + 0 xs))) (def! product (fn* [xs] (reduce * 1 xs))) (def! conjunction (let* [and2 (fn* [acc x] (if acc x false))] (fn* [xs] (reduce and2 true xs)))) (def! disjunction (let* [or2 (fn* [acc x] (if acc true x))] (fn* [xs] (reduce or2 false xs)))) ;; It would be faster to stop the iteration on first failure ;; (conjunction) or success (disjunction). Even better, `or` in the ;; stepA and `and` in `core.mal` stop evaluating their arguments. ;; Yes, -2-3-4 means (((0-2)-3)-4). ;; `(reduce str "" xs)` is equivalent to `apply str xs` ;; and `(reduce concat () xs)` is equivalent to `apply concat xs`. ;; The built-in iterations are probably faster. ;; `(reduce (fn* [acc _] acc) nil xs)` is equivalent to `nil`. ;; For (reduce (fn* [acc x] x) nil xs))), see do3 above. ;; `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)` computes the ;; maximum of a list of non-negative integers. It is hard to find an ;; initial value fitting all purposes. (def! sum_len (let* [add_len (fn* [acc x] (+ acc (count x)))] (fn* [xs] (reduce add_len 0 xs)))) (def! max_len (let* [update_max (fn* [acc x] (let* [l (count x)] (if (< acc l) l acc)))] (fn* [xs] (reduce update_max 0 xs)))) ;; (fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs)) ;; computes the composition of an arbitrary number of functions. ;; The first anonymous function is the mathematical composition. ;; For practical purposes, `->` and `->>` in `core.mal` are more ;; efficient and general. ================================================ FILE: examples/hello.mal ================================================ (println "hello world\n\nanother line") (println "and another line") ================================================ FILE: examples/presentation.mal ================================================ ;; Mal Presentation (def! clear (fn* () (str ""))) (def! bold (fn* (s) (str "" s ""))) (def! blue (fn* (s) (str "" s ""))) (def! title (fn* (s) (bold (blue (str s "\n"))))) (def! title2 (fn* (s) (bold (blue s)))) (def! slides (list (list (title2 " __ __ _ _") (title2 "| \/ | / \ | |") (title2 "| |\/| | / _ \ | | ") (title2 "| | | |/ ___ \| |___ ") (title2 "|_| |_/_/ \_\_____|")) (list (title "gherkin") "- a lisp1 written in bash4") (list (title "mal - an interpreter for a subset of Clojure")) (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python" "- and Clojure") (list (title "mal - an interpreter for a subset of Clojure") "- written in GNU make" "- and Bash 4" "- and Javascript" "- and Python" "- and Clojure" "- and 17 other languages") (list (title "things it has") "- scalars: integers, strings, symbols, keywords, nil, true, false" "- immutable collections: lists, vectors, hash-maps" "- metadata, atoms" "- def!, fn*, let*" " - varargs: (fn* (x y & more) ...)" "- tail call optimization" " - except GNU make implementation (no iteration)" "- macros (quote, unquote, quasiquote, splice-quote)" "- over 500 unit tests" "- REPL with line editing (GNU readline/libedit/linenoise)") (list (title "things it does not have") "- performance" "- namespaces" "- GC (in bash, make, C implementations)" "- protocols :-(" "- lots of other things") (list (title "why?") "- because!") (list (title "why?") "- because!" "- gherkin was an inspiration to higher levels of crazy" "- evolved into learning tool" "- way to learn about Lisp and also the target language" "- each implementation broken into small 11 steps") (list (title "thanks to:") "- Peter Norvig: inspiration: lispy" " - http://norvig.com/lispy.html" "- Alan Dipert: gherkin, original gherkin slides" " - https://github.com/alandipert/gherkin") (list (title "mal - Make a Lisp") "https://github.com/kanaka/mal") (list (title "demo")))) (def! present (fn* (slides) (if (> (count slides) 0) (do (println (clear)) (apply println (map (fn* (line) (str "\n " line)) (first slides))) (println "\n\n\n") (readline "") (present (rest slides)))))) (present slides) ================================================ FILE: get-ci-matrix.py ================================================ #!/usr/bin/env python3 import json import os import re import sys import yaml IMPLS_FILE = "IMPLS.yml" RE_IGNORE = re.compile(r'(^LICENSE$|^README.md$|^docs/|^process/|^IMPLS.yml$|^Makefile.impls$)') RE_IMPL = re.compile(r'^impls/(?!lib|tests)([^/]*)/') OVERRIDE_IMPLS = os.environ.get('OVERRIDE_IMPLS', '').split() def eprint(*args, **kwargs): print(*args, file=sys.stderr, **kwargs) def impl_text(impl): s = "IMPL=%s" % impl['IMPL'] for k, v in impl.items(): if k == 'IMPL': continue s += " %s=%s" % (k, v) return s all_changes = sys.argv[1:] # code changes that are not just to docs or implementation lists code_changes = set([c for c in all_changes if not RE_IGNORE.search(c)]) # actual changes to implementations impl_changes = set([c for c in all_changes if RE_IMPL.search(c)]) # names of changed implementations run_impls = set([RE_IMPL.search(c).groups()[0] for c in impl_changes]) do_full = (len(code_changes) != len(impl_changes)) # If we have non-implementation code changes then we will add all # implementations to the test matrix if OVERRIDE_IMPLS: run_impls = OVERRIDE_IMPLS if 'all' in OVERRIDE_IMPLS: do_full = True eprint("OVERRIDE_IMPLS: %s" % OVERRIDE_IMPLS) eprint("code_changes: %s (%d)" % (code_changes, len(code_changes))) eprint("impl_changes: %s (%d)" % (impl_changes, len(impl_changes))) eprint("run_impls: %s (%d)" % (run_impls, len(run_impls))) eprint("do_full: %s" % do_full) # Load the full implementation description file all_impls = yaml.safe_load(open(IMPLS_FILE)) # Accumulate and output linux, macos & windows implementations separately linux_impls = [] macos_impls = [] windows_impls = [] for impl in all_impls['IMPL']: targ = linux_impls if 'OS' in impl and impl['OS'] == 'macos': targ = macos_impls if 'OS' in impl and impl['OS'] == 'windows': targ = windows_impls # Run implementations with actual changes first before running # other impls triggered by non-impl code changes if impl['IMPL'] in run_impls: targ.insert(0, impl_text(impl)) elif do_full: targ.append(impl_text(impl)) print("do_linux=%s" % json.dumps(len(linux_impls)>0)) print("do_macos=%s" % json.dumps(len(macos_impls)>0)) print("do_windows=%s" % json.dumps(len(windows_impls)>0)) print("linux={\"IMPL\":%s}" % json.dumps(linux_impls)) print("macos={\"IMPL\":%s}" % json.dumps(macos_impls)) print("windows={\"IMPL\":%s}" % json.dumps(windows_impls)) ================================================ FILE: impls/.gitignore ================================================ .DS_Store .bash_history .cache .cargo .config .mal-history .crystal .lein .m2 .ivy2 .sbt .npm .node-gyp .elm */experiments */node_modules *.o *.pyc */step0_repl */step1_read_print */step2_eval */step3_env */step4_if_fn_do */step5_tco */step6_file */step7_quote */step8_macros */step9_try */stepA_mal */mal */notes logs old ada/obj/ awk/mal.awk bash/mal.sh clojure/mal.jar clojure/target clojure/.lein-repl-history coffee/mal.coffee cs/*.exe cs/*.dll cs/*.mdb d/*.o elixir/_build elixir/deps elixir/erl_crash.dump elixir/*.ez erlang/ebin erlang/.rebar erlang/src/*.beam es6/mal.js es6/.esm-cache factor/mal.factor fantom/lib forth/mal.fs fsharp/*.exe fsharp/*.dll fsharp/*.mdb go/step* groovy/*.class groovy/mal.jar haskell/*.hi haskell/*.o haxe/*.n haxe/*.py haxe/cpp/ haxe/*.js java/mal.jar java/target/ java/dependency-reduced-pom.xml .npm/ .node-gyp/ js/mal.js js/web/mal.js kotlin/*.jar kotlin/.idea kotlin/*.iml lua/lib lua/linenoise.so lua/rex_pcre.so lua/mal.lua make/mal.mk mal/mal.mal matlab/octave-workspace miniMAL/mal.json nim/nimcache* objc/*.d ocaml/*.cmi ocaml/*.cmo ocaml/*.swp ocaml/*.cmx ocaml/*.o ocaml/mal_lib.* objpascal/*.o objpascal/*.ppu objpascal/pas-readline objpascal/regexpr/Source/RegExpr.ppu perl/mal.pl perl6/.precomp/ php/mal.php php/mal-web.php ps/mal.ps python/mal.pyz r/mal.r ruby/mal.rb .cargo/ rust/target/ rust/Cargo.lock rust/.cargo r/lib scala/mal.jar scala/target scala/project skew/*.js tcl/mal.tcl vb/*.exe vb/*.dll vimscript/mal.vim clisp/*.fas clisp/*.lib basic/step0_repl.bas basic/step1_read_print.bas basic/step2_eval.bas basic/step3_env.bas basic/step4_if_fn_do.bas basic/step5_tco.bas basic/step6_file.bas basic/step7_quote.bas basic/step8_macros.bas basic/step9_try.bas basic/stepA_mal.bas basic/*.prg common-lisp/*.fasl common-lisp/*.lib common-lisp/images/* common-lisp/hist/* livescript/*.js !livescript/node_readline.js livescript/node_modules elm/node_modules elm/elm-stuff elm/*.js !elm/node_readline.js !elm/bootstrap.js wasm/*.wat wasm/*.wasm ================================================ FILE: impls/ada/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: ada" ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # GNU Ada compiler RUN apt-get -y install gnat ================================================ FILE: impls/ada/Makefile ================================================ PROGS=step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ step5_tco step6_file step7_quote step8_macros step9_try all: ${PROGS} stepA_mal obj: mkdir -p $@ # stepA_mal is awkward because GNAT requires the filename to be lowercase ${PROGS} stepa_mal: force obj gnatmake -O3 -gnata $@.adb -D obj # so we make stepa_mal and just move it. stepA_mal: stepa_mal mv $< $@ clean: rm -f ${PROGS} rm -rf obj .PHONY: force force: ================================================ FILE: impls/ada/core.adb ================================================ with Ada.Calendar; with Ada.Characters.Latin_1; with Ada.Strings.Unbounded; with Ada.Text_IO; with Eval_Callback; with Reader; with Smart_Pointers; with Types; with Types.Hash_Map; with Types.Vector; package body Core is use Types; -- primitive functions on Smart_Pointer, function "+" is new Arith_Op ("+", "+"); function "-" is new Arith_Op ("-", "-"); function "*" is new Arith_Op ("*", "*"); function "/" is new Arith_Op ("/", "/"); function "<" is new Rel_Op ("<", "<"); function "<=" is new Rel_Op ("<=", "<="); function ">" is new Rel_Op (">", ">"); function ">=" is new Rel_Op (">=", ">="); function Eval_As_Boolean (MH : Types.Mal_Handle) return Boolean is use Types; Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => Res := False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Throw (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); Types.Mal_Exception_Value := First_Param; raise Mal_Exception; return First_Param; -- Keep the compiler happy. end Throw; function Is_True (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Bool and then Deref_Bool (First_Param).Get_Bool); end Is_True; function Is_False (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Bool and then not Deref_Bool (First_Param).Get_Bool); end Is_False; function Is_Nil (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Nil); end Is_Nil; function Meta (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Deref (First_Param).Get_Meta; end Meta; function With_Meta (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Meta_Param, Res : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; Meta_Param := Car (Rest_List); Res := Copy (First_Param); Deref (Res).Set_Meta (Meta_Param); return Res; end With_Meta; function New_Atom (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Atom_Mal_Type (First_Param); end New_Atom; function Is_Atom (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Atom); end Is_Atom; function Deref_Atm (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Deref_Atom (First_Param).Get_Atom; end Deref_Atm; function Reset (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Atom_Param, New_Val : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; Atom_Param := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; New_Val := Car (Rest_List); Deref_Atom (Atom_Param).Set_Atom (New_Val); return New_Val; end Reset; function Swap (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Atom_Param, Atom_Val, New_Val : Mal_Handle; Rest_List : Types.List_Mal_Type; Rest_List_Class : Types.List_Class_Ptr; Func_Param, Param_List : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; Atom_Param := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; Func_Param := Car (Rest_List); Param_List := Cdr (Rest_List); Rest_List_Class := Deref_List_Class (Param_List); Param_List := Rest_List_Class.Duplicate; Atom_Val := Deref_Atom (Atom_Param).Get_Atom; Param_List := Prepend (Atom_Val, Deref_List (Param_List).all); case Deref (Func_Param).Sym_Type is when Lambda => New_Val := Deref_Lambda (Func_Param).Apply (Param_List); when Func => New_Val := Deref_Func (Func_Param).Call_Func (Param_List); when others => raise Runtime_Exception with "Swap with bad func"; end case; Deref_Atom (Atom_Param).Set_Atom (New_Val); return New_Val; end Swap; function Is_List (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = List and then Deref_List (First_Param).Get_List_Type = List_List); end Is_List; function Is_Vector (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = List and then Deref_List (First_Param).Get_List_Type = Vector_List); end Is_Vector; function Is_Map (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = List and then Deref_List (First_Param).Get_List_Type = Hashed_List); end Is_Map; function Is_Sequential (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = List and then Deref_List (First_Param).Get_List_Type /= Hashed_List); end Is_Sequential; function Is_Empty (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; List : List_Class_Ptr; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); List := Deref_List_Class (First_Param); return New_Bool_Mal_Type (Is_Null (List.all)); end Is_Empty; function Eval_As_List (MH : Types.Mal_Handle) return List_Mal_Type is begin case Deref (MH).Sym_Type is when List => return Deref_List (MH).all; when Nil => return Null_List (List_List); when others => null; end case; raise Runtime_Exception with "Expecting a List"; return Null_List (List_List); end Eval_As_List; function Count (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Evaled_List : Mal_Handle; L : List_Mal_Type; Rest_List : Types.List_Mal_Type; N : Natural; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); if Deref (First_Param).Sym_Type = List and then Deref_List (First_Param).Get_List_Type = Vector_List then N := Deref_List_Class (First_Param).Length; else L := Eval_As_List (First_Param); N := L.Length; end if; return New_Int_Mal_Type (N); end Count; function Cons (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_Param, List_Handle : Mal_Handle; List : List_Mal_Type; List_Class : List_Class_Ptr; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); List_Handle := Cdr (Rest_List); List := Deref_List (List_Handle).all; List_Handle := Car (List); List_Class := Deref_List_Class (List_Handle); return Prepend (First_Param, List_Class.all); end Cons; function Concat (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; return Types.Concat (Rest_List); end Concat; function First (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_List : Types.List_Class_Ptr; First_Param : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); if Deref (First_Param).Sym_Type = Nil then return New_Nil_Mal_Type; end if; First_List := Deref_List_Class (First_Param); if Is_Null (First_List.all) then return New_Nil_Mal_Type; else return Types.Car (First_List.all); end if; end First; function Rest (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_Param, Container : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); if Deref (First_Param).Sym_Type = Nil then return New_List_Mal_Type (List_List); end if; Container := Deref_List_Class (First_Param).Cdr; return Deref_List_Class (Container).Duplicate; end Rest; function Nth (Rest_Handle : Mal_Handle) return Types.Mal_Handle is -- Rest_List, First_List : Types.List_Mal_Type; Rest_List : Types.List_Mal_Type; First_List : Types.List_Class_Ptr; First_Param, List_Handle, Num_Handle : Mal_Handle; List : List_Mal_Type; Index : Types.Int_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); First_List := Deref_List_Class (First_Param); List_Handle := Cdr (Rest_List); List := Deref_List (List_Handle).all; Num_Handle := Car (List); Index := Deref_Int (Num_Handle).all; return Types.Nth (First_List.all, Natural (Index.Get_Int_Val)); end Nth; function Apply (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Results_Handle, First_Param : Mal_Handle; Rest_List : List_Mal_Type; Results_List : List_Ptr; begin -- The rest of the line. Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; Results_Handle := New_List_Mal_Type (List_List); Results_List := Deref_List (Results_Handle); -- The last item is a list or a vector which gets flattened so that -- (apply f (A B) C (D E)) becomes (f (A B) C D E) while not Is_Null (Rest_List) loop declare Part_Handle : Mal_Handle; begin Part_Handle := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; -- Is Part_Handle the last item in the list? if Is_Null (Rest_List) then declare The_List : List_Class_Ptr; List_Item : Mal_Handle; Next_List : Mal_Handle; begin The_List := Deref_List_Class (Part_Handle); while not Is_Null (The_List.all) loop List_Item := Car (The_List.all); Append (Results_List.all, List_Item); Next_List := Cdr (The_List.all); The_List := Deref_List_Class (Next_List); end loop; end; else Append (Results_List.all, Part_Handle); end if; end; end loop; -- The apply part... if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Results_Handle); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Results_List.all) then return Eval_Callback.Eval.all (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end Apply; function Map (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List, Results_List : List_Mal_Type; Func_Handle, List_Handle, Results_Handle : Mal_Handle; begin -- The rest of the line. Rest_List := Deref_List (Rest_Handle).all; Func_Handle := Car (Rest_List); List_Handle := Nth (Rest_List, 1); Results_Handle := New_List_Mal_Type (List_List); Results_List := Deref_List (Results_Handle).all; while not Is_Null (Deref_List_Class (List_Handle).all) loop declare Parts_Handle : Mal_Handle; begin Parts_Handle := Make_New_List ((1 => Func_Handle, 2 => Make_New_List ((1 => Car (Deref_List_Class (List_Handle).all))))); List_Handle := Cdr (Deref_List_Class (List_Handle).all); Append (Results_List, Apply (Parts_Handle)); end; end loop; return New_List_Mal_Type (Results_List); end Map; function Symbol (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Sym_Handle : Mal_Handle; Rest_List : List_Mal_Type; begin -- The rest of the line. Rest_List := Deref_List (Rest_Handle).all; Sym_Handle := Car (Rest_List); return New_Symbol_Mal_Type (Deref_String (Sym_Handle).Get_String); end Symbol; function Is_Symbol (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Sym_Handle : Mal_Handle; Rest_List : List_Mal_Type; Res : Boolean; begin Rest_List := Deref_List (Rest_Handle).all; Sym_Handle := Car (Rest_List); if Deref (Sym_Handle).Sym_Type = Sym then Res := Deref_Sym (Sym_Handle).Get_Sym (1) /= ':'; else Res := False; end if; return New_Bool_Mal_Type (Res); end Is_Symbol; function Is_String (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; begin First_Param := Car (Deref_List (Rest_Handle).all); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Str); end Is_String; function Keyword (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Sym_Handle : Mal_Handle; Rest_List : List_Mal_Type; begin -- The rest of the line. Rest_List := Deref_List (Rest_Handle).all; Sym_Handle := Car (Rest_List); case Deref (Sym_Handle).Sym_Type is when Str => return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_String); when Sym => if Deref_Sym (Sym_Handle).Get_Sym (1) = ':' then return Sym_Handle; end if; when others => null; end case; raise Runtime_Exception with "keyword: expects a keyword or string"; end Keyword; function Is_Keyword (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Sym_Handle : Mal_Handle; Rest_List : List_Mal_Type; Res : Boolean; begin Rest_List := Deref_List (Rest_Handle).all; Sym_Handle := Car (Rest_List); if Deref (Sym_Handle).Sym_Type = Sym then Res := Deref_Sym (Sym_Handle).Get_Sym (1) = ':'; else Res := False; end if; return New_Bool_Mal_Type (Res); end Is_Keyword; function Is_Number (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; begin First_Param := Car (Deref_List (Rest_Handle).all); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Int); end Is_Number; function Is_Fn (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Res : Boolean; begin First_Param := Car (Deref_List (Rest_Handle).all); case Deref (First_Param).Sym_Type is when Func => Res := True; when Lambda => Res := not Deref_Lambda (First_Param).Get_Is_Macro; when others => Res := False; end case; return New_Bool_Mal_Type (Res); end Is_Fn; function Is_Macro (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; begin First_Param := Car (Deref_List (Rest_Handle).all); return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Lambda and then Deref_Lambda (First_Param).Get_Is_Macro); end Is_Macro; function New_List (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; return New_List_Mal_Type (The_List => Rest_List); end New_List; function New_Vector (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; Res : Mal_Handle; use Types.Vector; begin Res := New_Vector_Mal_Type; Rest_List := Deref_List (Rest_Handle).all; while not Is_Null (Rest_List) loop Deref_Vector (Res).Append (Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; 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; Res : Mal_Handle; begin Res := Hash_Map.New_Hash_Map_Mal_Type; Rest_List := Deref_List (Rest_Handle).all; while not Is_Null (Rest_List) loop Hash_Map.Deref_Hash (Res).Append (Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; end New_Map; function Assoc (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Mal_Handle; Map : Hash_Map.Hash_Map_Mal_Type; begin Rest_List := Rest_Handle; Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; Rest_List := Cdr (Deref_List (Rest_List).all); return Hash_Map.Assoc (Map, Rest_List); end Assoc; function Dis_Assoc (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Mal_Handle; Map : Hash_Map.Hash_Map_Mal_Type; begin Rest_List := Rest_Handle; Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; Rest_List := Cdr (Deref_List (Rest_List).all); return Hash_Map.Dis_Assoc (Map, Rest_List); end Dis_Assoc; function Get_Key (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; Map : Hash_Map.Hash_Map_Mal_Type; Map_Param, Key : Mal_Handle; The_Sym : Sym_Types; begin Rest_List := Deref_List (Rest_Handle).all; Map_Param := Car (Rest_List); The_Sym := Deref (Map_Param).Sym_Type; if The_Sym = Sym or The_Sym = Nil then -- Either its nil or its some other atom -- which makes no sense! return New_Nil_Mal_Type; end if; -- Assume a map from here on in. Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; Rest_List := Deref_List (Cdr (Rest_List)).all; Key := Car (Rest_List); return Map.Get (Key); end Get_Key; function Contains_Key (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; Map : Hash_Map.Hash_Map_Mal_Type; Key : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; Rest_List := Deref_List (Cdr (Rest_List)).all; Key := Car (Rest_List); return New_Bool_Mal_Type (Hash_Map.Contains (Map, Key)); end Contains_Key; function All_Keys (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; Map : Hash_Map.Hash_Map_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; return Hash_Map.All_Keys (Map); end All_Keys; function All_Values (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; Map : Hash_Map.Hash_Map_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; return Hash_Map.All_Values (Map); end All_Values; -- Take a list with two parameters and produce a single result -- using the Op access-to-function parameter. function Reduce2 (Op : Binary_Func_Access; LH : Mal_Handle) return Mal_Handle is Left, Right : Mal_Handle; L, Rest_List : List_Mal_Type; begin L := Deref_List (LH).all; Left := Car (L); Rest_List := Deref_List (Cdr (L)).all; Right := Car (Rest_List); return Op (Left, Right); end Reduce2; function Plus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("+"'Access, Rest_Handle); end Plus; function Minus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("-"'Access, Rest_Handle); end Minus; function Mult (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("*"'Access, Rest_Handle); end Mult; function Divide (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("/"'Access, Rest_Handle); end Divide; function LT (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("<"'Access, Rest_Handle); end LT; function LTE (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 ("<="'Access, Rest_Handle); end LTE; function GT (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (">"'Access, Rest_Handle); end GT; function GTE (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (">="'Access, Rest_Handle); end GTE; function EQ (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Types."="'Access, Rest_Handle); end EQ; function Pr_Str (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return New_String_Mal_Type (Deref_List (Rest_Handle).Pr_Str); end Pr_Str; function Prn (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str); return New_Nil_Mal_Type; end Prn; function Println (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str (False)); return New_Nil_Mal_Type; end Println; function Str (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return New_String_Mal_Type (Deref_List (Rest_Handle).Cat_Str (False)); end Str; function Read_String (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_Param : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Reader.Read_Str (Deref_String (First_Param).Get_String); end Read_String; function Read_Line (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_Param : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); -- Output the prompt. Ada.Text_IO.Put (Deref_String (First_Param).Get_String); -- Get the text. return New_String_Mal_Type (Ada.Text_IO.Get_Line); end Read_Line; function Slurp (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; First_Param : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); declare Unquoted_Str : String := Deref_String (First_Param).Get_String; use Ada.Text_IO; Fn : Ada.Text_IO.File_Type; File_Str : Ada.Strings.Unbounded.Unbounded_String := Ada.Strings.Unbounded.Null_Unbounded_String; I : Natural := 0; begin Ada.Text_IO.Open (Fn, In_File, Unquoted_Str); while not End_Of_File (Fn) loop declare Line_Str : constant String := Get_Line (Fn); begin if Line_Str'Length > 0 then Ada.Strings.Unbounded.Append (File_Str, Line_Str); Ada.Strings.Unbounded.Append (File_Str, Ada.Characters.Latin_1.LF); end if; end; end loop; Ada.Text_IO.Close (Fn); return New_String_Mal_Type (Ada.Strings.Unbounded.To_String (File_Str)); end; end Slurp; function Conj (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; First_Param, Res : Mal_Handle; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); Rest_List := Deref_List (Cdr (Rest_List)).all; -- Is this a List or a Vector? case Deref_List (First_Param).Get_List_Type is when List_List => Res := Copy (First_Param); while not Is_Null (Rest_List) loop Res := Prepend (To_List => Deref_List (Res).all, Op => Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; when Vector_List => Res := Copy (First_Param); while not Is_Null (Rest_List) loop Vector.Append (Vector.Deref_Vector (Res).all, Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; when Hashed_List => raise Runtime_Exception with "Conj on Hashed_Map"; end case; end Conj; function Seq (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param, Res : Mal_Handle; begin First_Param := Car (Deref_List (Rest_Handle).all); case Deref (First_Param).Sym_Type is when Nil => return First_Param; when List => case Deref_List (First_Param).Get_List_Type is when List_List => if Is_Null (Deref_List (First_Param).all) then return New_Nil_Mal_Type; else return First_Param; end if; when Vector_List => if Vector.Is_Null (Vector.Deref_Vector (First_Param).all) then return New_Nil_Mal_Type; else return Vector.Duplicate (Vector.Deref_Vector (First_Param).all); end if; when others => raise Runtime_Exception; end case; when Str => declare Param_Str : String := Deref_String (First_Param).Get_String; String1 : String (1 .. 1); L_Ptr : List_Ptr; begin if Param_Str'Length = 0 then return New_Nil_Mal_Type; -- "" else Res := New_List_Mal_Type (List_List); L_Ptr := Deref_List (Res); for I in Param_Str'First .. Param_Str'Last loop String1 (1) := Param_Str (I); Append (L_Ptr.all, New_String_Mal_Type (String1)); end loop; return Res; end if; end; when others => raise Runtime_Exception; end case; end Seq; Start_Time : Ada.Calendar.Time := Ada.Calendar.Clock; function Time_Ms (Rest_Handle : Mal_Handle) return Types.Mal_Handle is D : Duration; use Ada.Calendar; begin D := Clock - Start_Time; -- seconds D := D * 1000.0; -- milli-seconds return New_Int_Mal_Type (Integer (D)); -- ms rounded to the nearest one end Time_Ms; procedure Init (Repl_Env : Envs.Env_Handle) is begin Envs.Set (Repl_Env, "*host-language*", Types.New_String_Mal_Type ("Ada")); Envs.Set (Repl_Env, "true?", New_Func_Mal_Type ("true?", Is_True'access)); Envs.Set (Repl_Env, "false?", New_Func_Mal_Type ("false?", Is_False'access)); Envs.Set (Repl_Env, "meta", New_Func_Mal_Type ("meta", Meta'access)); Envs.Set (Repl_Env, "with-meta", New_Func_Mal_Type ("with-meta", With_Meta'access)); Envs.Set (Repl_Env, "nil?", New_Func_Mal_Type ("nil?", Is_Nil'access)); Envs.Set (Repl_Env, "throw", New_Func_Mal_Type ("throw", Throw'access)); Envs.Set (Repl_Env, "atom", New_Func_Mal_Type ("atom", New_Atom'access)); Envs.Set (Repl_Env, "atom?", New_Func_Mal_Type ("atom?", Is_Atom'access)); Envs.Set (Repl_Env, "deref", New_Func_Mal_Type ("deref", Deref_Atm'access)); Envs.Set (Repl_Env, "reset!", New_Func_Mal_Type ("reset!", Reset'access)); Envs.Set (Repl_Env, "swap!", New_Func_Mal_Type ("swap!", Swap'access)); Envs.Set (Repl_Env, "list", New_Func_Mal_Type ("list", New_List'access)); Envs.Set (Repl_Env, "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)); Envs.Set (Repl_Env, "vector?", New_Func_Mal_Type ("vector?", Is_Vector'access)); Envs.Set (Repl_Env, "hash-map", New_Func_Mal_Type ("hash-map", New_Map'access)); Envs.Set (Repl_Env, "assoc", New_Func_Mal_Type ("assoc", Assoc'access)); Envs.Set (Repl_Env, "dissoc", New_Func_Mal_Type ("dissoc", Dis_Assoc'access)); Envs.Set (Repl_Env, "get", New_Func_Mal_Type ("get", Get_Key'access)); Envs.Set (Repl_Env, "keys", New_Func_Mal_Type ("keys", All_Keys'access)); Envs.Set (Repl_Env, "vals", New_Func_Mal_Type ("vals", All_Values'access)); Envs.Set (Repl_Env, "map?", New_Func_Mal_Type ("map?", Is_Map'access)); Envs.Set (Repl_Env, "contains?", New_Func_Mal_Type ("contains?", Contains_Key'access)); Envs.Set (Repl_Env, "sequential?", New_Func_Mal_Type ("sequential?", Is_Sequential'access)); Envs.Set (Repl_Env, "empty?", New_Func_Mal_Type ("empty?", Is_Empty'access)); Envs.Set (Repl_Env, "count", New_Func_Mal_Type ("count", Count'access)); Envs.Set (Repl_Env, "cons", New_Func_Mal_Type ("cons", Cons'access)); Envs.Set (Repl_Env, "concat", New_Func_Mal_Type ("concat", Concat'access)); Envs.Set (Repl_Env, "first", New_Func_Mal_Type ("first", First'access)); Envs.Set (Repl_Env, "rest", New_Func_Mal_Type ("rest", Rest'access)); Envs.Set (Repl_Env, "nth", New_Func_Mal_Type ("nth", Nth'access)); Envs.Set (Repl_Env, "map", New_Func_Mal_Type ("map", Map'access)); Envs.Set (Repl_Env, "apply", New_Func_Mal_Type ("apply", Apply'access)); Envs.Set (Repl_Env, "symbol", New_Func_Mal_Type ("symbol", Symbol'access)); Envs.Set (Repl_Env, "symbol?", New_Func_Mal_Type ("symbol?", Is_Symbol'access)); Envs.Set (Repl_Env, "string?", New_Func_Mal_Type ("string?", Is_String'access)); Envs.Set (Repl_Env, "keyword", New_Func_Mal_Type ("keyword", Keyword'access)); Envs.Set (Repl_Env, "keyword?", New_Func_Mal_Type ("keyword?", Is_Keyword'access)); Envs.Set (Repl_Env, "number?", New_Func_Mal_Type ("number?", Is_Number'access)); Envs.Set (Repl_Env, "fn?", New_Func_Mal_Type ("fn?", Is_Fn'access)); Envs.Set (Repl_Env, "macro?", New_Func_Mal_Type ("macro?", Is_Macro'access)); Envs.Set (Repl_Env, "pr-str", New_Func_Mal_Type ("pr-str", Pr_Str'access)); Envs.Set (Repl_Env, "str", New_Func_Mal_Type ("str", Str'access)); Envs.Set (Repl_Env, "prn", New_Func_Mal_Type ("prn", Prn'access)); Envs.Set (Repl_Env, "println", New_Func_Mal_Type ("println", Println'access)); Envs.Set (Repl_Env, "read-string", New_Func_Mal_Type ("read-string", Read_String'access)); Envs.Set (Repl_Env, "readline", New_Func_Mal_Type ("readline", Read_Line'access)); Envs.Set (Repl_Env, "slurp", New_Func_Mal_Type ("slurp", Slurp'access)); Envs.Set (Repl_Env, "conj", New_Func_Mal_Type ("conj", Conj'access)); Envs.Set (Repl_Env, "seq", New_Func_Mal_Type ("seq", Seq'access)); Envs.Set (Repl_Env, "time-ms", New_Func_Mal_Type ("time-ms", Time_Ms'access)); Envs.Set (Repl_Env, "+", New_Func_Mal_Type ("+", Plus'access)); Envs.Set (Repl_Env, "-", New_Func_Mal_Type ("-", Minus'access)); Envs.Set (Repl_Env, "*", New_Func_Mal_Type ("*", Mult'access)); Envs.Set (Repl_Env, "/", New_Func_Mal_Type ("/", Divide'access)); Envs.Set (Repl_Env, "<", New_Func_Mal_Type ("<", LT'access)); Envs.Set (Repl_Env, "<=", New_Func_Mal_Type ("<=", LTE'access)); Envs.Set (Repl_Env, ">", New_Func_Mal_Type (">", GT'access)); Envs.Set (Repl_Env, ">=", New_Func_Mal_Type (">=", GTE'access)); Envs.Set (Repl_Env, "=", New_Func_Mal_Type ("=", EQ'access)); end Init; end Core; ================================================ FILE: impls/ada/core.ads ================================================ with Envs; package Core is -- Init puts core functions into a new Env. procedure Init (Repl_Env : Envs.Env_Handle); Evaluation_Error : exception; end Core; ================================================ FILE: impls/ada/envs.adb ================================================ with Ada.Text_IO; with Types; with Unchecked_Deallocation; package body Envs is function Is_Null (E : Env_Handle) return Boolean is use Smart_Pointers; begin return E = Null_Env_Handle; end Is_Null; function New_Env (Outer : Env_Handle := Null_Env_Handle) return Env_Handle is use Smart_Pointers; Level : Natural; begin if Is_Null (Outer) then Level := 0; else Level := Deref (Outer).Level + 1; end if; if Debug then Ada.Text_IO.Put_Line ("Envs: Creating at level " & Natural'Image (Level)); end if; return Env_Handle (Smart_Pointers.New_Ptr (new Env' (Base_Class with The_Map => String_Mal_Hash.Empty_Map, Outer_Env => Outer, Level => Level))); end New_Env; procedure Set (E : Env_Handle; Key : String; Elem : Smart_Pointers.Smart_Pointer) is begin if Debug then Ada.Text_IO.Put_Line ("Envs: Setting " & Key & " to " & Types.Deref (Elem).To_String & " at level " & Natural'Image (Deref (E).Level)); end if; String_Mal_Hash.Include (Container => Deref (E).The_Map, Key => Ada.Strings.Unbounded.To_Unbounded_String (Key), New_Item => Elem); end Set; function Get (E : Env_Handle; Key: String) return Smart_Pointers.Smart_Pointer is use String_Mal_Hash; C : Cursor; begin if Debug then Ada.Text_IO.Put_Line ("Envs: Finding " & Key & " at level " & Natural'Image (Deref (E).Level)); end if; C := Find (Deref (E).The_Map, Ada.Strings.Unbounded.To_Unbounded_String (Key)); if C = No_Element then if Is_Null (Deref (E).Outer_Env) then raise Not_Found; else return Get (Deref (E).Outer_Env, Key); end if; else return Element (C); end if; end Get; procedure Set_Outer (E : Env_Handle; Outer_Env : Env_Handle) is begin -- Attempt to avoid making loops. if Deref (E).Level /= 0 then Deref (E).Outer_Env := Outer_Env; end if; end Set_Outer; function To_String (E : Env_Handle) return String is use String_Mal_Hash, Ada.Strings.Unbounded; C : Cursor; Res : Unbounded_String; begin C := First (Deref (E).The_Map); while C /= No_Element loop Append (Res, Key (C) & " => " & Types.To_String (Types.Deref (Element (C)).all) & ", "); C := Next (C); end loop; return To_String (Res); end To_String; -- Sym and Exprs are lists. Bind Sets Keys in Syms to the corresponding -- expression in Exprs. Returns true if all the parameters were bound. function Bind (Env : Env_Handle; Syms, Exprs : Types.List_Mal_Type) return Boolean is use Types; S, Expr : List_Mal_Type; First_Sym : Sym_Ptr; begin S := Syms; Expr := Exprs; while not Is_Null (S) loop First_Sym := Deref_Sym (Car (S)); if First_Sym.Get_Sym = "&" then S := Deref_List (Cdr (S)).all; First_Sym := Deref_Sym (Car (S)); Set (Env, First_Sym.Get_Sym, New_List_Mal_Type (Expr)); return True; end if; Set (Env, First_Sym.Get_Sym, Car (Expr)); S := Deref_List (Cdr (S)).all; exit when Is_Null (Expr); Expr := Deref_List (Cdr (Expr)).all; end loop; return Is_Null (S); end Bind; function Deref (SP : Env_Handle) return Env_Ptr is begin return Env_Ptr (Smart_Pointers.Deref (Smart_Pointers.Smart_Pointer (SP))); end Deref; end Envs; ================================================ FILE: impls/ada/envs.ads ================================================ with Ada.Containers.Hashed_Maps; with Ada.Strings.Unbounded.Hash; with Smart_Pointers; limited with Types; package Envs is type Env_Handle is private; Null_Env_Handle : constant Env_Handle; function New_Env (Outer : Env_Handle := Null_Env_Handle) return Env_Handle; -- Set adds an element to the environment E. procedure Set (E : Env_Handle; Key : String; Elem : Smart_Pointers.Smart_Pointer); -- Get finds a key in the E env. If it can't be found it looks -- in an outer env. If it runs out of envs, Not Found is raised. function Get (E : Env_Handle; Key : String) return Smart_Pointers.Smart_Pointer; Not_Found : exception; procedure Set_Outer (E : Env_Handle; Outer_Env : Env_Handle); -- Sym and Exprs are lists. Bind Sets Keys in Syms to the corresponding -- expression in Exprs. Returns true if all the parameters were bound. function Bind (Env : Env_Handle; Syms, Exprs : Types.List_Mal_Type) return Boolean; function To_String (E : Env_Handle) return String; Debug : Boolean := False; private type Env_Handle is new Smart_Pointers.Smart_Pointer; Null_Env_Handle : constant Env_Handle := Env_Handle (Smart_Pointers.Null_Smart_Pointer); function Is_Null (E : Env_Handle) return Boolean; package String_Mal_Hash is new Ada.Containers.Hashed_Maps (Key_Type => Ada.Strings.Unbounded.Unbounded_String, Element_Type => Smart_Pointers.Smart_Pointer, Hash => Ada.Strings.Unbounded.Hash, Equivalent_Keys => Ada.Strings.Unbounded."=", "=" => Smart_Pointers."="); type Env is new Smart_Pointers.Base_Class with record The_Map : String_Mal_Hash.Map; Outer_Env : Env_Handle; Level: Natural; end record; type Env_Ptr is access all Env; function Deref (SP : Env_Handle) return Env_Ptr; end Envs; ================================================ FILE: impls/ada/eval_callback.ads ================================================ with Envs; with Types; package Eval_Callback is type Eval_Func is access function (MH : Types.Mal_Handle; Env : Envs.Env_Handle) return Types.Mal_Handle; Eval : Eval_Func; end Eval_Callback; ================================================ FILE: impls/ada/printer.adb ================================================ package body Printer is function Pr_Str (M : Types.Mal_Handle) return String is begin if Types.Is_Null (M) then return ""; else return Types.To_String (Types.Deref (M).all); end if; end Pr_Str; end Printer; ================================================ FILE: impls/ada/printer.ads ================================================ with Types; package Printer is function Pr_Str (M : Types.Mal_Handle) return String; end Printer; ================================================ FILE: impls/ada/reader.adb ================================================ with Ada.IO_Exceptions; with Ada.Characters.Latin_1; with Ada.Exceptions; with Ada.Strings.Maps.Constants; with Ada.Strings.Unbounded; with Ada.Text_IO; with Smart_Pointers; with Types.Vector; with Types.Hash_Map; package body Reader is use Types; package ACL renames Ada.Characters.Latin_1; type Lexemes is (Ignored_Tok, Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok, Meta_Tok, Deref_Tok, Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok, Int_Tok, Float_Tok, Str_Tok, Sym_Tok); type Token (ID : Lexemes := Ignored_Tok) is record case ID is when Int_Tok => Int_Val : Mal_Integer; when Float_Tok => Float_Val : Mal_Float; when Str_Tok | Sym_Tok => Start_Char, Stop_Char : Natural; when others => null; end case; end record; Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma); -- [^\s\[\]{}('"`,;)] Terminator_Syms : Ada.Strings.Maps.Character_Set := Ada.Strings.Maps."or" (Lisp_Whitespace, Ada.Strings.Maps.To_Set ("[]{}('""`,;)")); -- The unterminated string error String_Error : exception; function Convert_String (S : String) return String is use Ada.Strings.Unbounded; Res : Unbounded_String; I : Positive; Str_Last : Natural; begin Str_Last := S'Last; I := S'First; while I <= Str_Last loop if S (I) = '\' then if I+1 > Str_Last then Append (Res, S (I)); I := I + 1; elsif S (I+1) = 'n' then Append (Res, Ada.Characters.Latin_1.LF); I := I + 2; elsif S (I+1) = '"' then Append (Res, S (I+1)); I := I + 2; elsif S (I+1) = '\' then Append (Res, S (I+1)); I := I + 2; else Append (Res, S (I)); I := I + 1; end if; else Append (Res, S (I)); I := I + 1; end if; end loop; return To_String (Res); end Convert_String; Str_Len : Natural := 0; Saved_Line : Ada.Strings.Unbounded.Unbounded_String; Char_To_Read : Natural := 1; function Get_Token return Token is Res : Token; I, J : Natural; use Ada.Strings.Unbounded; begin <> -- Skip over whitespace... I := Char_To_Read; while I <= Str_Len and then Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop I := I + 1; end loop; -- Filter out lines consisting of only whitespace if I > Str_Len then return (ID => Ignored_Tok); end if; J := I; case Element (Saved_Line, J) is when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1; when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1; when '~' => -- Tilde if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then Res := (ID => Splice_Unq_Tok); Char_To_Read := J+2; else -- Just a Tilde Res := (ID => Unquote_Tok); Char_To_Read := J+1; end if; when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1; when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1; when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1; when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1; when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1; when ']' | '}' | ')' => Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J); Char_To_Read := J+1; when '"' => -- a string loop if Str_Len <= J then raise String_Error; end if; J := J + 1; exit when Element (Saved_Line, J) = '"'; if Element (Saved_Line, J) = '\' then J := J + 1; end if; end loop; Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J); Char_To_Read := J + 1; when ';' => -- a comment -- Read to the end of the line or until -- the saved_line string is exhausted. -- NB if we reach the end we don't care -- what the last char was. while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop J := J + 1; end loop; if J = Str_Len then Res := (ID => Ignored_Tok); else Char_To_Read := J + 1; -- was: Res := Get_Token; goto Tail_Call_Opt; end if; when others => -- an atom while J <= Str_Len and then not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop J := J + 1; end loop; -- Either we ran out of string or -- the one at J was the start of a new token Char_To_Read := J; J := J - 1; declare Dots : Natural; All_Digits : Boolean; begin -- check if all digits or . Dots := 0; All_Digits := True; for K in I .. J loop if (K = I and K /= J) and then Element (Saved_Line, K) = '-' then null; elsif Element (Saved_Line, K) = '.' then Dots := Dots + 1; elsif not (Element (Saved_Line, K) in '0' .. '9') then All_Digits := False; exit; end if; end loop; if All_Digits then if Dots = 0 then Res := (ID => Int_Tok, Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J))); elsif Dots = 1 then Res := (ID => Float_Tok, Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J))); else Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J); end if; else Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J); end if; end; end case; return Res; end Get_Token; function Read_List (LT : Types.List_Types) return Types.Mal_Handle is MTA : Mal_Handle; begin MTA := Read_Form; declare List_SP : Mal_Handle; List_P : List_Class_Ptr; Close : String (1..1) := (1 => Types.Closing (LT)); begin case LT is when List_List => List_SP := New_List_Mal_Type (List_Type => LT); when Vector_List => List_SP := Vector.New_Vector_Mal_Type; when Hashed_List => List_SP := Hash_Map.New_Hash_Map_Mal_Type; end case; -- Need to append to a variable so... List_P := Deref_List_Class (List_SP); loop if Is_Null (MTA) then return New_Error_Mal_Type (Str => "expected '" & Close & "', got EOF"); end if; exit when Deref (MTA).Sym_Type = Sym and then Symbol_Mal_Type (Deref (MTA).all).Get_Sym = Close; Append (List_P.all, MTA); MTA := Read_Form; end loop; return List_SP; end; end Read_List; function Read_Form return Types.Mal_Handle is Tok : Token; MTS : Mal_Handle; use Ada.Strings.Unbounded; begin Tok := Get_Token; case Tok.ID is when Ignored_Tok => return Smart_Pointers.Null_Smart_Pointer; when Int_Tok => return New_Int_Mal_Type (Tok.Int_Val); when Float_Tok => return New_Float_Mal_Type (Tok.Float_Val); when Start_List_Tok => return Read_List (List_List); when Start_Vector_Tok => return Read_List (Vector_List); when Start_Hash_Tok => return Read_List (Hashed_List); when Meta_Tok => declare Meta, Obj : Mal_Handle; begin Meta := Read_Form; Obj := Read_Form; return Make_New_List ((1 => New_Symbol_Mal_Type ("with-meta"), 2 => Obj, 3 => Meta)); end; when Deref_Tok => return Make_New_List ((1 => New_Symbol_Mal_Type ("deref"), 2 => Read_Form)); when Quote_Tok => return Make_New_List ((1 => New_Symbol_Mal_Type ("quote"), 2 => Read_Form)); when Quasi_Quote_Tok => return Make_New_List ((1 => New_Symbol_Mal_Type ("quasiquote"), 2 => Read_Form)); when Splice_Unq_Tok => return Make_New_List ((1 => New_Symbol_Mal_Type ("splice-unquote"), 2 => Read_Form)); when Unquote_Tok => return Make_New_List ((1 => New_Symbol_Mal_Type ("unquote"), 2 => Read_Form)); when Str_Tok => -- +/-1 strips out the double quotes. -- Convert_String converts backquoted charaters to raw format. return New_String_Mal_Type (Convert_String (Slice (Saved_Line, Tok.Start_Char + 1, Tok.Stop_Char - 1))); when Sym_Tok => -- Mal interpreter is required to know about true, false and nil. declare S : String := Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char); begin if S = "true" then return New_Bool_Mal_Type (True); elsif S = "false" then return New_Bool_Mal_Type (False); elsif S = "nil" then return New_Nil_Mal_Type; else return New_Symbol_Mal_Type (S); end if; end; end case; end Read_Form; procedure Lex_Init (S : String) is begin Str_Len := S'Length; Saved_Line := Ada.Strings.Unbounded.To_Unbounded_String (S); Char_To_Read := 1; end Lex_Init; function Read_Str (S : String) return Types.Mal_Handle is I, Str_Len : Natural := S'Length; begin Lex_Init (S); return Read_Form; exception when String_Error => return New_Error_Mal_Type (Str => "expected '""', got EOF"); end Read_Str; end Reader; ================================================ FILE: impls/ada/reader.ads ================================================ with Types; package Reader is -- This is the Parser (returns an AST) function Read_Str (S : String) return Types.Mal_Handle; private procedure Lex_Init (S : String); function Read_Form return Types.Mal_Handle; end Reader; ================================================ FILE: impls/ada/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/ada/smart_pointers.adb ================================================ with Ada.Unchecked_Deallocation; package body Smart_Pointers is function New_Ptr (Base_Class : Base_Class_Accessor) return Smart_Pointer is begin return Smart_Pointer' (Ada.Finalization.Controlled with Pointer => Base_Class); end New_Ptr; function Deref (Ptr : Smart_Pointer) return Base_Class_Accessor is begin return Ptr.Pointer; end Deref; overriding procedure Adjust (Object : in out Smart_Pointer) is begin if Object.Pointer /= null then Object.Pointer.Ref_Count := Object.Pointer.Ref_Count + 1; end if; end Adjust; procedure Free is new Ada.Unchecked_Deallocation (Base_Class'Class, Base_Class_Accessor); overriding procedure Finalize (Object : in out Smart_Pointer) is begin if Object.Pointer /= null then if Object.Pointer.Ref_Count > 0 then Object.Pointer.Ref_Count := Object.Pointer.Ref_Count - 1; if Object.Pointer.Ref_Count = 0 then Free (Object.Pointer); end if; end if; end if; end Finalize; function Is_Null (Ptr : Smart_Pointer) return Boolean is begin return Ptr = Null_Smart_Pointer; end Is_Null; end Smart_Pointers; ================================================ FILE: impls/ada/smart_pointers.ads ================================================ with Ada.Finalization; package Smart_Pointers is -- Classes we want to track derrive from Base Class. type Base_Class is abstract tagged private; type Base_Class_Accessor is access Base_Class'Class; type Smart_Pointer is private; function New_Ptr (Base_Class : Base_Class_Accessor) return Smart_Pointer; function Deref (Ptr : Smart_Pointer) return Base_Class_Accessor; Null_Smart_Pointer : constant Smart_Pointer; function Is_Null (Ptr : Smart_Pointer) return Boolean; private type Base_Class is abstract tagged record Ref_Count : Natural := 1; end record; type Smart_Pointer is new Ada.Finalization.Controlled with record Pointer : Base_Class_Accessor; end record; overriding procedure Adjust (Object : in out Smart_Pointer); overriding procedure Finalize (Object : in out Smart_Pointer); Null_Smart_Pointer : constant Smart_Pointer := (Ada.Finalization.Controlled with Pointer => null); end Smart_Pointers; ================================================ FILE: impls/ada/step0_repl.adb ================================================ with Ada.Text_IO; procedure Step0_Repl is function Read (Param : String) return String is begin return Param; end Read; function Eval (Param : String) return String is begin return Param; end Eval; function Print (Param : String) return String is begin return Param; end Print; function Rep (Param : String) return String is Read_Str : String := Read (Param); Eval_Str : String := Eval (Read_Str); Print_Str : String := Print (Eval_Str); begin return Print_Str; end Rep; begin loop Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line)); end loop; end Step0_Repl; ================================================ FILE: impls/ada/step1_read_print.adb ================================================ with Ada.Text_IO; with Printer; with Reader; with Types; procedure Step1_Read_Print is function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Eval (Param : Types.Mal_Handle) return Types.Mal_Handle is begin return Param; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST); return Print (Evaluated_AST); end if; end Rep; begin loop Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line)); end loop; end Step1_Read_Print; ================================================ FILE: impls/ada/step2_eval.adb ================================================ with Ada.Containers.Hashed_Maps; with Ada.Strings.Unbounded.Hash; with Ada.Text_IO; with Ada.Exceptions; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step2_Eval is use Types; -- primitive functions on Smart_Pointer, function "+" is new Arith_Op ("+", "+"); function "-" is new Arith_Op ("-", "-"); function "*" is new Arith_Op ("*", "*"); function "/" is new Arith_Op ("/", "/"); -- Take a list with two parameters and produce a single result -- using the Op access-to-function parameter. function Reduce2 (Op : Binary_Func_Access; LH : Mal_Handle) return Mal_Handle is Left, Right : Mal_Handle; L, Rest_List : List_Mal_Type; begin L := Deref_List (LH).all; Left := Car (L); Rest_List := Deref_List (Cdr (L)).all; Right := Car (Rest_List); return Op (Left, Right); end Reduce2; function Plus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step2_Eval."+"'Unrestricted_Access, Rest_Handle); end Plus; function Minus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step2_Eval."-"'Unrestricted_Access, Rest_Handle); end Minus; function Mult (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step2_Eval."*"'Unrestricted_Access, Rest_Handle); end Mult; function Divide (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step2_Eval."/"'Unrestricted_Access, Rest_Handle); end Divide; package String_Mal_Hash is new Ada.Containers.Hashed_Maps (Key_Type => Ada.Strings.Unbounded.Unbounded_String, Element_Type => Smart_Pointers.Smart_Pointer, Hash => Ada.Strings.Unbounded.Hash, Equivalent_Keys => Ada.Strings.Unbounded."=", "=" => Smart_Pointers."="); Not_Found : exception; function Get (M : String_Mal_Hash.Map; K : String) return Mal_Handle is use String_Mal_Hash; C : Cursor; begin C := Find (M, Ada.Strings.Unbounded.To_Unbounded_String (K)); if C = No_Element then raise Not_Found; else return Element (C); end if; end Get; Repl_Env : String_Mal_Hash.Map; function Eval (Param : Types.Mal_Handle; Env : String_Mal_Hash.Map) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Eval_Ast (Ast : Mal_Handle; Env : String_Mal_Hash.Map) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); end Eval_Ast; function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map) return Mal_Handle is First_Elem : Mal_Handle; Ast : Mal_Handle renames Param; -- Historic begin if Debug then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; case Deref (Ast).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Ast).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Ast; else return Get (Env, Sym); end if; exception when Not_Found => raise Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => declare Evaled_H, First_Param : Mal_Handle; Evaled_List : List_Mal_Type; Param_List : List_Mal_Type; begin Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; Evaled_H := Eval_Ast (Param, Env); Evaled_List := Deref_List (Evaled_H).all; First_Param := Car (Evaled_List); return Call_Func (Deref_Func (First_Param).all, Cdr (Evaled_List)); end; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : String_Mal_Hash.Map) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; begin String_Mal_Hash.Include (Container => Repl_Env, Key => Ada.Strings.Unbounded.To_Unbounded_String ("+"), New_Item => New_Func_Mal_Type ("+", Plus'Unrestricted_access)); String_Mal_Hash.Include (Container => Repl_Env, Key => Ada.Strings.Unbounded.To_Unbounded_String ("-"), New_Item => New_Func_Mal_Type ("-", Minus'Unrestricted_access)); String_Mal_Hash.Include (Container => Repl_Env, Key => Ada.Strings.Unbounded.To_Unbounded_String ("*"), New_Item => New_Func_Mal_Type ("*", Mult'Unrestricted_access)); String_Mal_Hash.Include (Container => Repl_Env, Key => Ada.Strings.Unbounded.To_Unbounded_String ("/"), New_Item => New_Func_Mal_Type ("/", Divide'Unrestricted_access)); loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Ada.Exceptions.Exception_Information (E)); end; end loop; end Step2_Eval; ================================================ FILE: impls/ada/step3_env.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step3_Env is use Types; -- primitive functions on Smart_Pointer, function "+" is new Arith_Op ("+", "+"); function "-" is new Arith_Op ("-", "-"); function "*" is new Arith_Op ("*", "*"); function "/" is new Arith_Op ("/", "/"); -- Take a list with two parameters and produce a single result -- using the Op access-to-function parameter. function Reduce2 (Op : Binary_Func_Access; LH : Mal_Handle) return Mal_Handle is Left, Right : Mal_Handle; L, Rest_List : List_Mal_Type; begin L := Deref_List (LH).all; Left := Car (L); Rest_List := Deref_List (Cdr (L)).all; Right := Car (Rest_List); return Op (Left, Right); end Reduce2; function Plus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step3_Env."+"'Unrestricted_Access, Rest_Handle); end Plus; function Minus (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step3_Env."-"'Unrestricted_Access, Rest_Handle); end Minus; function Mult (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step3_Env."*"'Unrestricted_Access, Rest_Handle); end Mult; function Divide (Rest_Handle : Mal_Handle) return Types.Mal_Handle is begin return Reduce2 (Step3_Env."/"'Unrestricted_Access, Rest_Handle); end Divide; function Eval (Param : Types.Mal_Handle; Env : Envs.Env_Handle) return Types.Mal_Handle; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected symbol as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Let_Processing (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Args); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Args)).all); Res := Eval (Expr, E); return Res; end Let_Processing; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); end Eval_Ast; function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is Ast : Mal_Handle renames Param; -- Historic begin declare M : Mal_Handle; B : Boolean; begin M := Envs.Get (Env, "DEBUG-EVAL"); case Deref (M).Sym_Type is when Bool => B := Deref_Bool (M).Get_Bool; when Nil => B := False; when others => B := True; end case; if B then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Ast).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Ast).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Ast; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => declare Evaled_H, First_Param, Rest_List : Mal_Handle; Param_List : List_Mal_Type; begin Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_List := Cdr (Param_List); if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Deref_List (Rest_List).all, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then return Let_Processing (Deref_List (Rest_List).all, Env); else -- The APPLY section. Evaled_H := Eval_Ast (Param, Env); Param_List := Deref_List (Evaled_H).all; First_Param := Car (Param_List); return Call_Func (Deref_Func (First_Param).all, Cdr (Param_List)); end if; end; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; procedure Init (Env : Envs.Env_Handle) is begin Envs.Set (Env, "+", New_Func_Mal_Type ("+", Plus'Unrestricted_Access)); Envs.Set (Env, "-", New_Func_Mal_Type ("-", Minus'Unrestricted_Access)); Envs.Set (Env, "*", New_Func_Mal_Type ("*", Mult'Unrestricted_Access)); Envs.Set (Env, "/", New_Func_Mal_Type ("/", Divide'Unrestricted_Access)); end Init; Repl_Env : Envs.Env_Handle; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; Init (Repl_Env); loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Ada.Exceptions.Exception_Information (E)); end; end loop; end Step3_Env; ================================================ FILE: impls/ada/step4_if_fn_do.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step4_If_Fn_Do is use Types; function Eval (Param : Types.Mal_Handle; Env : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected symbol as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Let_Processing (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Args); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Args)).all); Res := Eval (Expr, E); return Res; end Let_Processing; function Do_Processing (Do_List : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is D : List_Mal_Type; Res : Mal_Handle := Smart_Pointers.Null_Smart_Pointer; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Do_List)); end if; D := Do_List; while not Is_Null (D) loop Res := Eval (Car (D), Env); D := Deref_List (Cdr(D)).all; end loop; return Res; end Do_Processing; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); end Eval_Ast; function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; Ast : Mal_Handle renames Param; -- Historic begin begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Ast).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Ast).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Ast; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then return Let_Processing (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then return Do_Processing (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Rest_List) = 2 or Length (Rest_List) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Rest_List), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Rest_List)).all; return Eval (Car (L), Env); else if Length (Rest_List) = 3 then L := Deref_List (Cdr (Rest_List)).all; L := Deref_List (Cdr (L)).all; return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); else -- The APPLY section. declare Evaled_H : Mal_Handle; begin Evaled_H := Eval_Ast (Param, Env); Param_List := Deref_List (Evaled_H).all; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then return Apply (Deref_Lambda (First_Param).all, Rest_Params); else raise Mal_Exception; end if; end; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- This op uses Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; Cmd_Args : Natural; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Cmd_Args := 0; while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; end if; end loop; Repl_Env := Envs.New_Env; Core.Init (Repl_Env); RE ("(def! not (fn* (a) (if a false true)))"); loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end Step4_If_Fn_Do; ================================================ FILE: impls/ada/step5_tco.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step5_TCO is use Types; -- Forward declaration of Eval. function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); end Eval_Ast; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; Ast : Mal_Handle renames Param; -- Historic begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Ast).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Ast).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Ast; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); else -- The APPLY section. declare Evaled_H : Mal_Handle; begin Evaled_H := Eval_Ast (Param, Env); Param_List := Deref_List (Evaled_H).all; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Mal_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Mal_Exception; end if; end; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle; Env : Envs.Env_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args : Natural; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Cmd_Args := 0; while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; end if; end loop; Repl_Env := Envs.New_Env; Core.Init (Repl_Env); RE ("(def! not (fn* (a) (if a false true)))"); loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end Step5_TCO; ================================================ FILE: impls/ada/step6_file.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step6_File is use Types; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; -- Forward declaration of Eval. function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); end Eval_Ast; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; Ast : Mal_Handle renames Param; -- Historic begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Ast).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Ast).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Ast; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); else -- The APPLY section. declare Evaled_H : Mal_Handle; begin Evaled_H := Eval_Ast (Param, Env); Param_List := Deref_List (Evaled_H).all; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args, File_Param : Natural; Command_Args : Types.Mal_Handle; Command_List : Types.List_Ptr; File_Processed : Boolean := False; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; -- Core init also creates the first environment. -- This is needed for the def!'s below. Core.Init (Repl_Env); -- Register the eval command. This needs to be done here rather than Core.Init -- as it requires direct access to Repl_Env. Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); RE ("(def! not (fn* (a) (if a false true)))"); RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); -- Command line processing. Cmd_Args := 0; Command_Args := Types.New_List_Mal_Type (Types.List_List); Command_List := Types.Deref_List (Command_Args); while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; elsif not File_Processed then File_Param := Cmd_Args; File_Processed := True; else Command_List.Append (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); end if; end loop; Envs.Set (Repl_Env, "*ARGV*", Command_Args); if File_Processed then RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); else loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end if; end Step6_File; ================================================ FILE: impls/ada/step7_quote.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step7_Quote is use Types; function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); 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, Elt, New_Res : Mal_Handle; L : List_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; if Deref (Param).Sym_Type not in Sym | List then -- No need to quote, Eval would not affect these anyway. return Param; end if; if Deref (Param).Sym_Type /= List or else 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; -- if the first element of ast is a symbol named "unquote": if Starts_With (Param, "unquote") then -- return the second element of ast.` return Deref_List_Class (Param).Nth (1); end if; Res := New_List_Mal_Type (List_List); 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")); 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; return Res; end Quasi_Quote_Processing; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Param).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Param).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Param; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quote" then return Car (Rest_List); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then Param := Quasi_Quote_Processing (Car (Rest_List)); goto Tail_Call_Opt; else -- The APPLY section. declare Evaled_H : Mal_Handle; begin Evaled_H := Eval_Ast (Param, Env); Param_List := Deref_List (Evaled_H).all; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args, File_Param : Natural; Command_Args : Types.Mal_Handle; Command_List : Types.List_Ptr; File_Processed : Boolean := False; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; -- Core init also creates the first environment. -- This is needed for the def!'s below. Core.Init (Repl_Env); -- Register the eval command. This needs to be done here rather than Core.Init -- as it requires direct access to Repl_Env. Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); RE ("(def! not (fn* (a) (if a false true)))"); RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); -- Command line processing. Cmd_Args := 0; Command_Args := Types.New_List_Mal_Type (Types.List_List); Command_List := Types.Deref_List (Command_Args); while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; elsif not File_Processed then File_Param := Cmd_Args; File_Processed := True; else Command_List.Append (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); end if; end loop; Envs.Set (Repl_Env, "*ARGV*", Command_Args); if File_Processed then RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); else loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end if; end Step7_Quote; ================================================ FILE: impls/ada/step8_macros.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step8_Macros is use Types; function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; Lambda_P : Lambda_Ptr; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Macro: expected atom as name"); Fn_Body := Car (Deref_List (Cdr (Args)).all); Res := Eval (Fn_Body, Env); Lambda_P := Deref_Lambda (Res); Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, Expr => Lambda_P.all.Get_Expr, Env => Lambda_P.all.Get_Env); Deref_Lambda (Res).Set_Is_Macro (True); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Macro; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); 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, Elt, New_Res : Mal_Handle; L : List_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; if Deref (Param).Sym_Type not in Sym | List then -- No need to quote, Eval would not affect these anyway. return Param; end if; if Deref (Param).Sym_Type /= List or else 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; -- if the first element of ast is a symbol named "unquote": if Starts_With (Param, "unquote") then -- return the second element of ast.` return Deref_List_Class (Param).Nth (1); end if; Res := New_List_Mal_Type (List_List); 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")); 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; return Res; end Quasi_Quote_Processing; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Param).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Param).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Param; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "defmacro!" then return Def_Macro (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quote" then return Car (Rest_List); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then Param := Quasi_Quote_Processing (Car (Rest_List)); goto Tail_Call_Opt; else -- The APPLY section. First_Param := Eval (First_Param, Env); if Deref (First_Param).Sym_Type = Func then Rest_Params := Eval_Ast (Rest_Params, Env); return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; if L.Get_Is_Macro then -- Apply to *unevaluated* arguments Param := L.Apply (Rest_Params); -- then EVAL the result. goto Tail_Call_Opt; end if; Rest_Params := Eval_Ast (Rest_Params, Env); E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args, File_Param : Natural; Command_Args : Types.Mal_Handle; Command_List : Types.List_Ptr; File_Processed : Boolean := False; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; -- Core init also creates the first environment. -- This is needed for the def!'s below. Core.Init (Repl_Env); -- Register the eval command. This needs to be done here rather than Core.Init -- as it requires direct access to Repl_Env. Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); RE ("(def! not (fn* (a) (if a false true)))"); RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); -- Command line processing. Cmd_Args := 0; Command_Args := Types.New_List_Mal_Type (Types.List_List); Command_List := Types.Deref_List (Command_Args); while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; elsif not File_Processed then File_Param := Cmd_Args; File_Processed := True; else Command_List.Append (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); end if; end loop; Envs.Set (Repl_Env, "*ARGV*", Command_Args); if File_Processed then RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); else loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end if; end Step8_Macros; ================================================ FILE: impls/ada/step9_try.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure Step9_Try is use Types; function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; Lambda_P : Lambda_Ptr; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Macro: expected atom as name"); Fn_Body := Car (Deref_List (Cdr (Args)).all); Res := Eval (Fn_Body, Env); Lambda_P := Deref_Lambda (Res); Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, Expr => Lambda_P.all.Get_Expr, Env => Lambda_P.all.Get_Env); Deref_Lambda (Res).Set_Is_Macro (True); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Macro; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); 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, Elt, New_Res : Mal_Handle; L : List_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; if Deref (Param).Sym_Type not in Sym | List then -- No need to quote, Eval would not affect these anyway. return Param; end if; if Deref (Param).Sym_Type /= List or else 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; -- if the first element of ast is a symbol named "unquote": if Starts_With (Param, "unquote") then -- return the second element of ast.` return Deref_List_Class (Param).Nth (1); end if; Res := New_List_Mal_Type (List_List); 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")); 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; return Res; end Quasi_Quote_Processing; function Catch_Processing (Try_Line : Mal_Handle; ExStr : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is L, CL, CL2, CL3 : List_Mal_Type; C : Mal_Handle; New_Env : Envs.Env_Handle; begin L := Deref_List (Try_Line).all; C := Car (L); -- CL is the list with the catch in. CL := Deref_List (C).all; CL2 := Deref_List (Cdr (CL)).all; New_Env := Envs.New_Env (Env); Envs.Set (New_Env, Deref_Sym (Car (CL2)).Get_Sym, ExStr); CL3 := Deref_List (Cdr (CL2)).all; return Eval (Car (CL3), New_Env); end Catch_Processing; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Param).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Param).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Param; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "defmacro!" then return Def_Macro (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quote" then return Car (Rest_List); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then Param := Quasi_Quote_Processing (Car (Rest_List)); goto Tail_Call_Opt; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "try*" then if Length (Rest_List) = 1 then return Eval (Car (Rest_List), Env); end if; declare Res : Mal_Handle; begin return Eval (Car (Rest_List), Env); exception when Mal_Exception => Res := Catch_Processing (Cdr (Rest_List), Types.Mal_Exception_Value, Env); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; return Res; when E : others => return Catch_Processing (Cdr (Rest_List), New_String_Mal_Type (Ada.Exceptions.Exception_Message (E)), Env); end; else -- The APPLY section. First_Param := Eval (First_Param, Env); if Deref (First_Param).Sym_Type = Func then Rest_Params := Eval_Ast (Rest_Params, Env); return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; if L.Get_Is_Macro then -- Apply to *unevaluated* arguments Param := L.Apply (Rest_Params); -- then EVAL the result. goto Tail_Call_Opt; end if; Rest_Params := Eval_Ast (Rest_Params, Env); E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args, File_Param : Natural; Command_Args : Types.Mal_Handle; Command_List : Types.List_Ptr; File_Processed : Boolean := False; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; -- Core init also creates the first environment. -- This is needed for the def!'s below. Core.Init (Repl_Env); -- Register the eval command. This needs to be done here rather than Core.Init -- as it requires direct access to Repl_Env. Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); RE ("(def! not (fn* (a) (if a false true)))"); RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); -- Command line processing. Cmd_Args := 0; Command_Args := Types.New_List_Mal_Type (Types.List_List); Command_List := Types.Deref_List (Command_Args); while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; elsif not File_Processed then File_Param := Cmd_Args; File_Processed := True; else Command_List.Append (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); end if; end loop; Envs.Set (Repl_Env, "*ARGV*", Command_Args); if File_Processed then RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); else loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end if; end Step9_Try; ================================================ FILE: impls/ada/stepa_mal.adb ================================================ with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Core; with Envs; with Eval_Callback; with Printer; with Reader; with Smart_Pointers; with Types; procedure StepA_Mal is use Types; function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; Debug : Boolean := False; function Read (Param : String) return Types.Mal_Handle is begin return Reader.Read_Str (Param); end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Fn: expected atom as name"); Fn_Body := Nth (Args, 1); Res := Eval (Fn_Body, Env); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Fn; function Def_Macro (Args : List_Mal_Type; Env : Envs.Env_Handle) return Mal_Handle is Name, Fn_Body, Res : Mal_Handle; Lambda_P : Lambda_Ptr; begin Name := Car (Args); pragma Assert (Deref (Name).Sym_Type = Sym, "Def_Macro: expected atom as name"); Fn_Body := Car (Deref_List (Cdr (Args)).all); Res := Eval (Fn_Body, Env); Lambda_P := Deref_Lambda (Res); Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params, Expr => Lambda_P.all.Get_Expr, Env => Lambda_P.all.Get_Env); Deref_Lambda (Res).Set_Is_Macro (True); Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res); return Res; end Def_Macro; function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin case Deref (MH).Sym_Type is when Bool => Res := Deref_Bool (MH).Get_Bool; when Nil => return False; -- when List => -- declare -- L : List_Mal_Type; -- begin -- L := Deref_List (MH).all; -- Res := not Is_Null (L); -- end; when others => -- Everything else Res := True; end case; return Res; end Eval_As_Boolean; function Eval_Ast (Ast : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is function Call_Eval (A : Mal_Handle) return Mal_Handle is begin return Eval (A, Env); end Call_Eval; begin pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); 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, Elt, New_Res : Mal_Handle; L : List_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; if Deref (Param).Sym_Type not in Sym | List then -- No need to quote, Eval would not affect these anyway. return Param; end if; if Deref (Param).Sym_Type /= List or else 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; -- if the first element of ast is a symbol named "unquote": if Starts_With (Param, "unquote") then -- return the second element of ast.` return Deref_List_Class (Param).Nth (1); end if; Res := New_List_Mal_Type (List_List); 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")); 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; return Res; end Quasi_Quote_Processing; function Catch_Processing (Try_Line : Mal_Handle; ExStr : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is L, CL, CL2, CL3 : List_Mal_Type; C : Mal_Handle; New_Env : Envs.Env_Handle; begin L := Deref_List (Try_Line).all; C := Car (L); -- CL is the list with the catch in. CL := Deref_List (C).all; CL2 := Deref_List (Cdr (CL)).all; New_Env := Envs.New_Env (Env); Envs.Set (New_Env, Deref_Sym (Car (CL2)).Get_Sym, ExStr); CL3 := Deref_List (Cdr (CL2)).all; return Eval (Car (CL3), New_Env); end Catch_Processing; function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; begin Param := AParam; Env := AnEnv; <> begin if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); end if; exception when Envs.Not_Found => null; end; case Deref (Param).Sym_Type is when Sym => declare Sym : Mal_String := Deref_Sym (Param).Get_Sym; begin -- if keyword, return it. Otherwise look it up in the environment. if Sym(1) = ':' then return Param; else return Envs.Get (Env, Sym); end if; exception when Envs.Not_Found => raise Envs.Not_Found with ("'" & Sym & "' not found"); end; when List => case Deref_List (Param).Get_List_Type is when Hashed_List | Vector_List => return Eval_Ast (Param, Env); when List_List => Param_List := Deref_List (Param).all; -- Deal with empty list.. if Param_List.Length = 0 then return Param; end if; First_Param := Car (Param_List); Rest_Params := Cdr (Param_List); Rest_List := Deref_List (Rest_Params).all; if Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "def!" then return Def_Fn (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "defmacro!" then return Def_Macro (Rest_List, Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare Defs, Expr, Res : Mal_Handle; E : Envs.Env_Handle; begin E := Envs.New_Env (Env); Defs := Car (Rest_List); Deref_List_Class (Defs).Add_Defs (E); Expr := Car (Deref_List (Cdr (Rest_List)).all); Param := Expr; Env := E; goto Tail_Call_Opt; -- was: -- Res := Eval (Expr, E); -- return Res; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "do" then declare D : List_Mal_Type; E : Mal_Handle; begin if Debug then Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List)); end if; if Is_Null (Rest_List) then return Rest_Params; end if; -- Loop processes Evals all but last entry D := Rest_List; loop E := Car (D); D := Deref_List (Cdr (D)).all; exit when Is_Null (D); E := Eval (E, Env); end loop; Param := E; goto Tail_Call_Opt; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "if" then declare Args : List_Mal_Type := Rest_List; Cond, True_Part, False_Part : Mal_Handle; Cond_Bool : Boolean; pragma Assert (Length (Args) = 2 or Length (Args) = 3, "If_Processing: not 2 or 3 parameters"); L : List_Mal_Type; begin Cond := Eval (Car (Args), Env); Cond_Bool := Eval_As_Boolean (Cond); if Cond_Bool then L := Deref_List (Cdr (Args)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else if Length (Args) = 3 then L := Deref_List (Cdr (Args)).all; L := Deref_List (Cdr (L)).all; Param := Car (L); goto Tail_Call_Opt; -- was: return Eval (Car (L), Env); else return New_Nil_Mal_Type; end if; end if; end; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "fn*" then return New_Lambda_Mal_Type (Params => Car (Rest_List), Expr => Nth (Rest_List, 1), Env => Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quote" then return Car (Rest_List); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then Param := Quasi_Quote_Processing (Car (Rest_List)); goto Tail_Call_Opt; elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "try*" then if Length (Rest_List) = 1 then return Eval (Car (Rest_List), Env); end if; declare Res : Mal_Handle; begin return Eval (Car (Rest_List), Env); exception when Mal_Exception => Res := Catch_Processing (Cdr (Rest_List), Types.Mal_Exception_Value, Env); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; return Res; when E : others => return Catch_Processing (Cdr (Rest_List), New_String_Mal_Type (Ada.Exceptions.Exception_Message (E)), Env); end; else -- The APPLY section. First_Param := Eval (First_Param, Env); if Deref (First_Param).Sym_Type = Func then Rest_Params := Eval_Ast (Rest_Params, Env); return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare L : Lambda_Mal_Type; E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin L := Deref_Lambda (First_Param).all; if L.Get_Is_Macro then -- Apply to *unevaluated* arguments Param := L.Apply (Rest_Params); -- then EVAL the result. goto Tail_Call_Opt; end if; Rest_Params := Eval_Ast (Rest_Params, Env); E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then Param := L.Get_Expr; Env := E; goto Tail_Call_Opt; -- was: return Eval (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; end; else -- neither a Lambda or a Func raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; end if; end case; when others => -- not a list, map, symbol or vector return Param; end case; end Eval; function Print (Param : Types.Mal_Handle) return String is begin return Printer.Pr_Str (Param); end Print; function Rep (Param : String; Env : Envs.Env_Handle) return String is AST, Evaluated_AST : Types.Mal_Handle; begin AST := Read (Param); if Types.Is_Null (AST) then return ""; else Evaluated_AST := Eval (AST, Env); return Print (Evaluated_AST); end if; end Rep; Repl_Env : Envs.Env_Handle; -- These two ops use Repl_Env directly. procedure RE (Str : Mal_String) is Discarded : Mal_Handle; begin Discarded := Eval (Read (Str), Repl_Env); end RE; function Do_Eval (Rest_Handle : Mal_Handle) return Types.Mal_Handle is First_Param : Mal_Handle; Rest_List : Types.List_Mal_Type; begin Rest_List := Deref_List (Rest_Handle).all; First_Param := Car (Rest_List); return Eval_Callback.Eval.all (First_Param, Repl_Env); end Do_Eval; Cmd_Args, File_Param : Natural; Command_Args : Types.Mal_Handle; Command_List : Types.List_Ptr; File_Processed : Boolean := False; begin -- Save a function pointer back to the Eval function. -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK -- as we know Eval will be in scope for the lifetime of the program. Eval_Callback.Eval := Eval'Unrestricted_Access; Repl_Env := Envs.New_Env; -- Core init also creates the first environment. -- This is needed for the def!'s below. Core.Init (Repl_Env); -- Register the eval command. This needs to be done here rather than Core.Init -- as it requires direct access to Repl_Env. Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access)); RE ("(def! not (fn* (a) (if a false true)))"); RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"); RE ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))"); -- Command line processing. Cmd_Args := 0; Command_Args := Types.New_List_Mal_Type (Types.List_List); Command_List := Types.Deref_List (Command_Args); while Ada.Command_Line.Argument_Count > Cmd_Args loop Cmd_Args := Cmd_Args + 1; if Ada.Command_Line.Argument (Cmd_Args) = "-d" then Debug := True; elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then Envs.Debug := True; elsif not File_Processed then File_Param := Cmd_Args; File_Processed := True; else Command_List.Append (Types.New_String_Mal_Type (Ada.Command_Line.Argument (Cmd_Args))); end if; end loop; Envs.Set (Repl_Env, "*ARGV*", Command_Args); if File_Processed then RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)"); else RE("(println (str ""Mal ["" *host-language* ""]""))"); loop begin Ada.Text_IO.Put ("user> "); exit when Ada.Text_IO.End_Of_File; Ada.Text_IO.Put_Line (Rep (Ada.Text_IO.Get_Line, Repl_Env)); exception when E : others => Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, "Error: " & Ada.Exceptions.Exception_Information (E)); if Types.Mal_Exception_Value /= Smart_Pointers.Null_Smart_Pointer then Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Printer.Pr_Str (Types.Mal_Exception_Value)); Types.Mal_Exception_Value := Smart_Pointers.Null_Smart_Pointer; end if; end; end loop; end if; end StepA_Mal; ================================================ FILE: impls/ada/types-hash_map.adb ================================================ with Ada.Strings.Unbounded.Hash; with Smart_Pointers; package body Types.Hash_Map is function "=" (A, B : Hash_Map_Mal_Type) return Boolean is A_Key, A_Elem, B_Elem : Mal_Handle; use Mal_Mal_Hash; C : Cursor; begin if A.Length /= B.Length then return False; end if; C := A.Hash.First; while Has_Element (C) loop A_Key := Key (C); A_Elem := Element (C); B_Elem := Mal_Mal_Hash.Element (B.Hash, A_Key); if A_Elem /= B_Elem then return False; end if; Next (C); end loop; return True; end "="; function New_Hash_Map_Mal_Type return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Hash_Map_Mal_Type' (Mal_Type with List_Type => Hashed_List, The_List => Smart_Pointers.Null_Smart_Pointer, Last_Elem => Smart_Pointers.Null_Smart_Pointer, Is_Key_Expected => True, Next_Key => Smart_Pointers.Null_Smart_Pointer, Hash => Mal_Mal_Hash.Empty_Map)); end New_Hash_Map_Mal_Type; overriding function Prepend (Op : Mal_Handle; To_Vector : Hash_Map_Mal_Type) return Mal_Handle is begin raise Not_Appropriate; return Smart_Pointers.Null_Smart_Pointer; end Prepend; overriding procedure Append (V : in out Hash_Map_Mal_Type; E : Mal_Handle) is begin if V.Is_Key_Expected then V.Next_Key := E; else Mal_Mal_Hash.Include (Container => V.Hash, Key => V.Next_Key, New_Item => E); end if; V.Is_Key_Expected := not V.Is_Key_Expected; end Append; overriding function Length (L : Hash_Map_Mal_Type) return Natural is begin return Natural (L.Hash.Length); end Length; overriding function Is_Null (L : Hash_Map_Mal_Type) return Boolean is begin return L.Hash.Is_Empty; end Is_Null; overriding function Null_List (L : List_Types) return Hash_Map_Mal_Type is begin return Hash_Map_Mal_Type' (Mal_Type with List_Type => Hashed_List, The_List => Smart_Pointers.Null_Smart_Pointer, Last_Elem => Smart_Pointers.Null_Smart_Pointer, Is_Key_Expected => False, Next_Key => Smart_Pointers.Null_Smart_Pointer, Hash => Mal_Mal_Hash.Empty_Map); end Null_List; -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. overriding function Duplicate (The_List : Hash_Map_Mal_Type) return Mal_Handle is begin raise Not_Appropriate; return Smart_Pointers.Null_Smart_Pointer; end Duplicate; overriding function Nth (L :Hash_Map_Mal_Type; N : Natural) return Mal_Handle is begin raise Not_Appropriate; return Smart_Pointers.Null_Smart_Pointer; end Nth; overriding procedure Add_Defs (Defs : Hash_Map_Mal_Type; Env : Envs.Env_Handle) is begin raise Not_Appropriate; end Add_Defs; -- Get the first item in the list: overriding function Car (L : Hash_Map_Mal_Type) return Mal_Handle is begin raise Not_Appropriate; return Smart_Pointers.Null_Smart_Pointer; end Car; -- Get the rest of the list (second item onwards) overriding function Cdr (L : Hash_Map_Mal_Type) return Mal_Handle is begin raise Not_Appropriate; return Smart_Pointers.Null_Smart_Pointer; end Cdr; overriding function Map (Func_Ptr : Func_Access; L : Hash_Map_Mal_Type) return Mal_Handle is Res : Mal_Handle; use Mal_Mal_Hash; C : Cursor; begin Res := New_Hash_Map_Mal_Type; C := L.Hash.First; while Has_Element (C) loop -- Assuming we're not applying the func to the keys too. Deref_Hash (Res).Hash.Include (Key => Key (C), New_Item => Func_Ptr (Element (C))); Next (C); end loop; return Res; end Map; function Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is Res : Mal_Handle; Rest_List : List_Mal_Type; use Mal_Mal_Hash; C : Cursor; begin Res := New_Hash_Map_Mal_Type; Rest_List := Deref_List (List).all; -- Copy arg into result. Deref_Hash (Res).Hash := H.Hash; while not Is_Null (Rest_List) loop Deref_Hash (Res).Append (Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; end Assoc; function Dis_Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is Res : Mal_Handle; Rest_List : List_Mal_Type; use Mal_Mal_Hash; C : Cursor; begin Res := New_Hash_Map_Mal_Type; Rest_List := Deref_List (List).all; -- Copy arg into result. Deref_Hash (Res).Hash := H.Hash; while not Is_Null (Rest_List) loop Mal_Mal_Hash.Exclude (Deref_Hash (Res).Hash, Car (Rest_List)); Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res; end Dis_Assoc; function Get (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Mal_Handle is use Mal_Mal_Hash; C : Cursor; begin C := Mal_Mal_Hash.Find (H.Hash, Key); if Has_Element (C) then return Element (C); else return New_Nil_Mal_Type; end if; end Get; function All_Keys (H : Hash_Map_Mal_Type) return Mal_Handle is Res, Map_Key : Mal_Handle; use Mal_Mal_Hash; C : Cursor; begin Res := New_List_Mal_Type (List_List); C := H.Hash.First; while Has_Element (C) loop Map_Key := Key (C); Deref_List (Res).Append (Map_Key); Next (C); end loop; return Res; end All_Keys; function All_Values (H : Hash_Map_Mal_Type) return Mal_Handle is Res, Map_Val : Mal_Handle; use Mal_Mal_Hash; C : Cursor; begin Res := New_List_Mal_Type (List_List); C := H.Hash.First; while Has_Element (C) loop Map_Val := Element (C); Deref_List (Res).Append (Map_Val); Next (C); end loop; return Res; end All_Values; function Contains (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Boolean is begin return Mal_Mal_Hash.Contains (H.Hash, Key); end Contains; function Deref_Hash (SP : Mal_Handle) return Hash_Ptr is begin return Hash_Ptr (Deref (SP)); end Deref_Hash; function Hash (M : Mal_Handle) return Ada.Containers.Hash_Type is begin return Ada.Strings.Unbounded.Hash (Ada.Strings.Unbounded.To_Unbounded_String (Deref (M).To_String)); end Hash; overriding function To_Str (T : Hash_Map_Mal_Type; Print_Readably : Boolean := True) return Mal_String is use Ada.Containers; begin if (T.Hash.Length = 0) then return Opening (T.List_Type) & Closing (T.List_Type); else declare Res : Ada.Strings.Unbounded.Unbounded_String; use Mal_Mal_Hash; C : Cursor; begin C := First (T.Hash); Res := Ada.Strings.Unbounded."&" (Opening (T.List_Type), Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Key (C)).all, Print_Readably))); Res := Ada.Strings.Unbounded."&" (Res, " "); Res := Ada.Strings.Unbounded."&" (Res, Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Element (C)).all, Print_Readably))); Next (C); while Has_Element (C) loop Res := Ada.Strings.Unbounded."&" (Res, " "); Res := Ada.Strings.Unbounded."&" (Res, Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Key (C)).all, Print_Readably))); Res := Ada.Strings.Unbounded."&" (Res, " "); Res := Ada.Strings.Unbounded."&" (Res, Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Element (C)).all, Print_Readably))); Next (C); end loop; Res := Ada.Strings.Unbounded."&" (Res, Closing (T.List_Type)); return Ada.Strings.Unbounded.To_String (Res); end; end if; end To_Str; end Types.Hash_Map; ================================================ FILE: impls/ada/types-hash_map.ads ================================================ with Ada.Containers.Hashed_Maps; with Smart_Pointers; with Envs; package Types.Hash_Map is type Hash_Map_Mal_Type is new List_Mal_Type with private; function New_Hash_Map_Mal_Type return Mal_Handle; function "=" (A, B : Hash_Map_Mal_Type) return Boolean; overriding function Prepend (Op : Mal_Handle; To_Vector : Hash_Map_Mal_Type) return Mal_Handle; overriding procedure Append (V : in out Hash_Map_Mal_Type; E : Mal_Handle); overriding function Length (L : Hash_Map_Mal_Type) return Natural; overriding function Is_Null (L : Hash_Map_Mal_Type) return Boolean; overriding function Null_List (L : List_Types) return Hash_Map_Mal_Type; -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. overriding function Duplicate (The_List : Hash_Map_Mal_Type) return Mal_Handle; overriding function Nth (L :Hash_Map_Mal_Type; N : Natural) return Mal_Handle; overriding procedure Add_Defs (Defs : Hash_Map_Mal_Type; Env : Envs.Env_Handle); -- Get the first item in the list: overriding function Car (L : Hash_Map_Mal_Type) return Mal_Handle; -- Get the rest of the list (second item onwards) overriding function Cdr (L : Hash_Map_Mal_Type) return Mal_Handle; overriding function Map (Func_Ptr : Func_Access; L : Hash_Map_Mal_Type) return Mal_Handle; function Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle; function Dis_Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle; function Get (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Mal_Handle; function All_Keys (H : Hash_Map_Mal_Type) return Mal_Handle; function All_Values (H : Hash_Map_Mal_Type) return Mal_Handle; function Contains (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Boolean; type Hash_Ptr is access all Hash_Map_Mal_Type; function Deref_Hash (SP : Mal_Handle) return Hash_Ptr; Not_Appropriate : exception; private function Hash (M : Mal_Handle) return Ada.Containers.Hash_Type; package Mal_Mal_Hash is new Ada.Containers.Hashed_Maps (Key_Type => Mal_Handle, Element_Type => Mal_Handle, Hash => Hash, Equivalent_Keys => "=", "=" => "="); type Hash_Map_Mal_Type is new List_Mal_Type with record Is_Key_Expected : Boolean := True; Next_Key : Mal_Handle; Hash : Mal_Mal_Hash.Map; end record; overriding function To_Str (T : Hash_Map_Mal_Type; Print_Readably : Boolean := True) return Mal_String; end Types.Hash_Map; ================================================ FILE: impls/ada/types-vector.adb ================================================ with Ada.Strings.Unbounded; with Ada.Text_IO; with Eval_Callback; package body Types.Vector is function New_Vector_Mal_Type return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Vector_Mal_Type' (Mal_Type with List_Type => Vector_List, The_List => Smart_Pointers.Null_Smart_Pointer, Last_Elem => Smart_Pointers.Null_Smart_Pointer, Vec => Mal_Vectors.Empty_Vector)); end New_Vector_Mal_Type; overriding function Prepend (Op : Mal_Handle; To_Vector : Vector_Mal_Type) return Mal_Handle is begin return Types.Prepend (Op, Deref_List (To_Vector.Duplicate).all); end Prepend; overriding procedure Append (V : in out Vector_Mal_Type; E : Mal_Handle) is begin Mal_Vectors.Append (V.Vec, E); end Append; overriding function Is_Null (L : Vector_Mal_Type) return Boolean is use Ada.Containers; begin return L.Vec.Is_Empty; end Is_Null; overriding function Null_List (L : List_Types) return Vector_Mal_Type is begin return Vector_Mal_Type' (Mal_Type with List_Type => Vector_List, The_List => Smart_Pointers.Null_Smart_Pointer, Last_Elem => Smart_Pointers.Null_Smart_Pointer, Vec => Mal_Vectors.Empty_Vector); end Null_List; -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. overriding function Duplicate (The_List : Vector_Mal_Type) return Mal_Handle is Res : Mal_Handle; use Mal_Vectors; C : Cursor; begin Res := New_List_Mal_Type (List_List); C := First (The_List.Vec); while Has_Element (C) loop Deref_List (Res).Append (Element (C)); Next (C); end loop; return Res; end Duplicate; function Length (L : Vector_Mal_Type) return Natural is begin return Natural (L.Vec.Length); end Length; procedure Add_Defs (Defs : Vector_Mal_Type; Env : Envs.Env_Handle) is C, D : Cursor; begin C := Defs.Vec.First; while Has_Element (C) loop D := Next (C); exit when not Has_Element (D); Envs.Set (Env, Deref_Sym (Element (C)).Get_Sym, Eval_Callback.Eval.all (Element (D), Env)); C := Next (D); end loop; end Add_Defs; overriding function Nth (L : Vector_Mal_Type; N : Natural) return Mal_Handle is begin if N >= L.Length then raise Runtime_Exception with "Nth (vector): Index out of range"; else return Mal_Vectors.Element (L.Vec, Vec_Index (N)); end if; end Nth; -- Get the first item in the list: overriding function Car (L : Vector_Mal_Type) return Mal_Handle is begin return L.Vec.Element (0); end Car; -- Get the rest of the list (second item onwards) overriding function Cdr (L : Vector_Mal_Type) return Mal_Handle is Res : Mal_Handle; Vec_P : Vector_Ptr; C : Mal_Vectors.Cursor; I : Vec_Index; use Ada.Containers; begin Res := New_Vector_Mal_Type; if L.Vec.Length < 2 then return Res; end if; Vec_P := Deref_Vector (Res); Vec_P.Vec := To_Vector (L.Vec.Length - 1); -- Set C to second entry. C := L.Vec.First; Mal_Vectors.Next (C); I := 0; while Mal_Vectors.Has_Element (C) loop Mal_Vectors.Replace_Element (Vec_P.Vec, I, Mal_Vectors.Element (C)); Mal_Vectors.Next (C); I := I + 1; end loop; return Res; end Cdr; overriding function Map (Func_Ptr : Func_Access; L : Vector_Mal_Type) return Mal_Handle is Res : Mal_Handle; use Mal_Vectors; C : Cursor; begin Res := New_Vector_Mal_Type; C := First (L.Vec); while Has_Element (C) loop Deref_Vector (Res).Append (Func_Ptr.all (Element (C))); Next (C); end loop; return Res; end Map; function Deref_Vector (SP : Mal_Handle) return Vector_Ptr is begin return Vector_Ptr (Deref (SP)); end Deref_Vector; overriding function To_Str (T : Vector_Mal_Type; Print_Readably : Boolean := True) return Mal_String is use Ada.Containers; begin if (T.Vec.Length = 0) then return Opening (T.List_Type) & Closing (T.List_Type); else declare Res : Ada.Strings.Unbounded.Unbounded_String; use Mal_Vectors; C : Cursor; begin C := First (T.Vec); Res := Ada.Strings.Unbounded."&" (Opening (T.List_Type), Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Element (C)).all, Print_Readably))); Next (C); while Has_Element (C) loop Res := Ada.Strings.Unbounded."&" (Res, " "); Res := Ada.Strings.Unbounded."&" (Res, Ada.Strings.Unbounded.To_Unbounded_String (To_String (Deref (Element (C)).all, Print_Readably))); Next (C); end loop; Res := Ada.Strings.Unbounded."&" (Res, Closing (T.List_Type)); return Ada.Strings.Unbounded.To_String (Res); end; end if; end To_Str; end Types.Vector; ================================================ FILE: impls/ada/types-vector.ads ================================================ with Ada.Containers.Vectors; with Ada.Strings.Unbounded; with Smart_Pointers; with Envs; package Types.Vector is type Vector_Mal_Type is new List_Mal_Type with private; function New_Vector_Mal_Type return Mal_Handle; overriding function Prepend (Op : Mal_Handle; To_Vector : Vector_Mal_Type) return Mal_Handle; overriding procedure Append (V : in out Vector_Mal_Type; E : Mal_Handle); overriding function Length (L : Vector_Mal_Type) return Natural; overriding function Is_Null (L : Vector_Mal_Type) return Boolean; overriding function Null_List (L : List_Types) return Vector_Mal_Type; -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. overriding function Duplicate (The_List : Vector_Mal_Type) return Mal_Handle; overriding function Nth (L : Vector_Mal_Type; N : Natural) return Mal_Handle; overriding procedure Add_Defs (Defs : Vector_Mal_Type; Env : Envs.Env_Handle); -- Get the first item in the list: overriding function Car (L : Vector_Mal_Type) return Mal_Handle; -- Get the rest of the list (second item onwards) overriding function Cdr (L : Vector_Mal_Type) return Mal_Handle; overriding function Map (Func_Ptr : Func_Access; L : Vector_Mal_Type) return Mal_Handle; type Vector_Ptr is access all Vector_Mal_Type; function Deref_Vector (SP : Mal_Handle) return Vector_Ptr; private subtype Vec_Index is Integer range 0 .. 100; package Mal_Vectors is new Ada.Containers.Vectors (Index_Type => Vec_Index, Element_Type => Mal_Handle, "=" => "="); use Mal_Vectors; type Vector_Mal_Type is new List_Mal_Type with record Vec : Mal_Vectors.Vector; end record; overriding function To_Str (T : Vector_Mal_Type; Print_Readably : Boolean := True) return Mal_String; end Types.Vector; ================================================ FILE: impls/ada/types.adb ================================================ with Ada.Characters.Latin_1; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; with Ada.Text_IO; with Ada.Unchecked_Deallocation; with Envs; with Eval_Callback; with Smart_Pointers; with Types.Vector; with Types.Hash_Map; package body Types is package ACL renames Ada.Characters.Latin_1; function Nodes_Equal (A, B : Mal_Handle) return Boolean; function "=" (A, B : Mal_Handle) return Mal_Handle is begin return New_Bool_Mal_Type (A = B); end "="; function Compare_List_And_Vector (A : List_Mal_Type; B : List_Mal_Type'Class) return Boolean is First_Node, First_Index : Mal_Handle; I : Natural := 0; begin First_Node := A.The_List; loop if not Is_Null (First_Node) and I < B.Length then First_Index := B.Nth (I); if not "=" (Deref_Node (First_Node).Data, First_Index) then return False; end if; First_Node := Deref_Node (First_Node).Next; I := I + 1; else return Is_Null (First_Node) and I = B.Length; end if; end loop; end Compare_List_And_Vector; function "=" (A, B : Mal_Handle) return Boolean is use Types.Vector; use Types.Hash_Map; begin if (not Is_Null (A) and not Is_Null (B)) and then Deref (A).Sym_Type = Deref (B).Sym_Type then case Deref (A).Sym_Type is when Nil => return True; -- Both nil. when Int => return (Deref_Int (A).Get_Int_Val = Deref_Int (B).Get_Int_Val); when Floating => return (Deref_Float (A).Get_Float_Val = Deref_Float (B).Get_Float_Val); when Bool => return (Deref_Bool (A).Get_Bool = Deref_Bool (B).Get_Bool); when List => -- When Types.Vector was added, the choice was: -- 1) use interfaces (because you need a class hierachy for the containers -- and a corresponding hierarchy for the cursors and Ada is single dispatch -- + interfaces. -- 2) map out the combinations here and use nth to access vector items. case Deref_List (A).Get_List_Type is when List_List => case Deref_List (B).Get_List_Type is when List_List => return Nodes_Equal (Deref_List (A).The_List, Deref_List (B).The_List); when Vector_List => return Compare_List_And_Vector (Deref_List (A).all, Deref_List_Class (B).all); when Hashed_List => return False; -- Comparing a list and a hash end case; when Vector_List => case Deref_List (B).Get_List_Type is when List_List => return Compare_List_And_Vector (Deref_List (B).all, Deref_List_Class (A).all); when Vector_List => return Vector."=" (Deref_Vector (A).all, Deref_Vector (B).all); when Hashed_List => return False; -- Comparing a vector and a hash end case; when Hashed_List => case Deref_List (B).Get_List_Type is when List_List => return False; -- Comparing a list and a hash when Vector_List => return False; -- Comparing a vector and a hash when Hashed_List => return Hash_Map."=" (Deref_Hash (A).all, Deref_Hash (B).all); end case; end case; when Str => return (Deref_String (A).Get_String = Deref_String (B).Get_String); when Sym => return (Deref_Sym (A).Get_Sym = Deref_Sym (B).Get_Sym); when Atom => return (Deref_Atom (A).Get_Atom = Deref_Atom (B).Get_Atom); when Func => return (Deref_Func (A).Get_Func_Name = Deref_Func (B).Get_Func_Name); when Node => return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); when Lambda => return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); when Error => return (Deref_Int(A).Get_Int_Val = Deref_Int(B).Get_Int_Val); end case; elsif Is_Null (A) and Is_Null (B) then return True; else -- either one of the args is null or the sym_types don't match return False; end if; end "="; function Get_Meta (T : Mal_Type) return Mal_Handle is begin if T.Meta = Smart_Pointers.Null_Smart_Pointer then return New_Nil_Mal_Type; else return T.Meta; end if; end Get_Meta; procedure Set_Meta (T : in out Mal_Type'Class; SP : Mal_Handle) is begin T.Meta := SP; end Set_Meta; function Copy (M : Mal_Handle) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Mal_Type'Class'(Deref (M).all)); end Copy; function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True) return Mal_String is begin return To_Str (T, Print_Readably); end To_String; -- A helper function that just view converts the smart pointer. function Deref (S : Mal_Handle) return Mal_Ptr is begin return Mal_Ptr (Smart_Pointers.Deref (S)); end Deref; -- A helper function to detect null smart pointers. function Is_Null (S : Mal_Handle) return Boolean is use Smart_Pointers; begin return Smart_Pointers."="(S, Null_Smart_Pointer); end Is_Null; -- To_Str on the abstract type... function To_Str (T : Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin raise Constraint_Error; -- Tha'll teach 'ee return ""; -- Keeps the compiler happy. end To_Str; function New_Nil_Mal_Type return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Nil_Mal_Type'(Mal_Type with null record)); end New_Nil_Mal_Type; overriding function Sym_Type (T : Nil_Mal_Type) return Sym_Types is begin return Nil; end Sym_Type; overriding function To_Str (T : Nil_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin return "nil"; end To_Str; function New_Int_Mal_Type (Int : Mal_Integer) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Int_Mal_Type'(Mal_Type with Int_Val => Int)); end New_Int_Mal_Type; overriding function Sym_Type (T : Int_Mal_Type) return Sym_Types is begin return Int; end Sym_Type; function Get_Int_Val (T : Int_Mal_Type) return Mal_Integer is begin return T.Int_Val; end Get_Int_Val; overriding function To_Str (T : Int_Mal_Type; Print_Readably : Boolean := True) return Mal_String is Res : Mal_String := Mal_Integer'Image (T.Int_Val); begin return Ada.Strings.Fixed.Trim (Res, Ada.Strings.Left); end To_Str; function Deref_Int (SP : Mal_Handle) return Int_Ptr is begin return Int_Ptr (Deref (SP)); end Deref_Int; function New_Float_Mal_Type (Floating : Mal_Float) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Float_Mal_Type'(Mal_Type with Float_Val => Floating)); end New_Float_Mal_Type; overriding function Sym_Type (T : Float_Mal_Type) return Sym_Types is begin return Floating; end Sym_Type; function Get_Float_Val (T : Float_Mal_Type) return Mal_Float is begin return T.Float_Val; end Get_Float_Val; overriding function To_Str (T : Float_Mal_Type; Print_Readably : Boolean := True) return Mal_String is Res : Mal_String := Mal_Float'Image (T.Float_Val); begin return Ada.Strings.Fixed.Trim (Res, Ada.Strings.Left); end To_Str; function Deref_Float (SP : Mal_Handle) return Float_Ptr is begin return Float_Ptr (Deref (SP)); end Deref_Float; function New_Bool_Mal_Type (Bool : Boolean) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Bool_Mal_Type'(Mal_Type with Bool_Val => Bool)); end New_Bool_Mal_Type; overriding function Sym_Type (T : Bool_Mal_Type) return Sym_Types is begin return Bool; end Sym_Type; function Get_Bool (T : Bool_Mal_Type) return Boolean is begin return T.Bool_Val; end Get_Bool; overriding function To_Str (T : Bool_Mal_Type; Print_Readably : Boolean := True) return Mal_String is Res : Mal_String := Boolean'Image (T.Bool_Val); begin return Ada.Strings.Fixed.Translate (Res, Ada.Strings.Maps.Constants.Lower_Case_Map); end To_Str; function Deref_Bool (SP : Mal_Handle) return Bool_Ptr is begin return Bool_Ptr (Deref (SP)); end Deref_Bool; function New_String_Mal_Type (Str : Mal_String) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new String_Mal_Type' (Mal_Type with The_String => Ada.Strings.Unbounded.To_Unbounded_String (Str))); end New_String_Mal_Type; overriding function Sym_Type (T : String_Mal_Type) return Sym_Types is begin return Str; end Sym_Type; function Get_String (T : String_Mal_Type) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.The_String); end Get_String; function Deref_String (SP : Mal_Handle) return String_Ptr is begin return String_Ptr (Deref (SP)); end Deref_String; overriding function To_Str (T : String_Mal_Type; Print_Readably : Boolean := True) return Mal_String is use Ada.Strings.Unbounded; I : Positive := 1; Str_Len : Natural; Res : Unbounded_String; Ch : Character; begin if Print_Readably then Append (Res, '"'); Str_Len := Length (T.The_String); while I <= Str_Len loop Ch := Element (T.The_String, I); if Ch = '"' then Append (Res, "\"""); elsif Ch = '\' then Append (Res, "\\"); elsif Ch = Ada.Characters.Latin_1.LF then Append (Res, "\n"); else Append (Res, Ch); end if; I := I + 1; end loop; Append (Res, '"'); return To_String (Res); else return To_String (T.The_String); end if; end To_Str; function New_Symbol_Mal_Type (Str : Mal_String) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Symbol_Mal_Type'(Mal_Type with The_Symbol => Ada.Strings.Unbounded.To_Unbounded_String (Str))); end New_Symbol_Mal_Type; overriding function Sym_Type (T : Symbol_Mal_Type) return Sym_Types is begin return Sym; end Sym_Type; function Get_Sym (T : Symbol_Mal_Type) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.The_Symbol); end Get_Sym; function Deref_Sym (S : Mal_Handle) return Sym_Ptr is begin return Sym_Ptr (Deref (S)); end Deref_Sym; overriding function To_Str (T : Symbol_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.The_Symbol); end To_Str; function New_Atom_Mal_Type (MH : Mal_Handle) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Atom_Mal_Type'(Mal_Type with The_Atom => MH)); end New_Atom_Mal_Type; overriding function Sym_Type (T : Atom_Mal_Type) return Sym_Types is begin return Atom; end Sym_Type; function Get_Atom (T : Atom_Mal_Type) return Mal_Handle is begin return T.The_Atom; end Get_Atom; procedure Set_Atom (T : in out Atom_Mal_Type; New_Val : Mal_Handle) is begin T.The_Atom := New_Val; end Set_Atom; function Deref_Atom (S : Mal_Handle) return Atom_Ptr is begin return Atom_Ptr (Deref (S)); end Deref_Atom; overriding function To_Str (T : Atom_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin return "(atom " & To_String (Deref (T.The_Atom).all) & ')'; end To_Str; function New_Func_Mal_Type (Str : Mal_String; F : Builtin_Func) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Func_Mal_Type'(Mal_Type with Func_Name => Ada.Strings.Unbounded.To_Unbounded_String (Str), Func_P => F)); end New_Func_Mal_Type; overriding function Sym_Type (T : Func_Mal_Type) return Sym_Types is begin return Func; end Sym_Type; function Get_Func_Name (T : Func_Mal_Type) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.Func_Name); end Get_Func_Name; function Call_Func (FMT : Func_Mal_Type; Rest_List : Mal_Handle) return Mal_Handle is begin return FMT.Func_P (Rest_List); end Call_Func; function Deref_Func (S : Mal_Handle) return Func_Ptr is begin return Func_Ptr (Deref (S)); end Deref_Func; overriding function To_Str (T : Func_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.Func_Name); end To_Str; function New_Error_Mal_Type (Str : Mal_String) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Error_Mal_Type'(Mal_Type with Error_Msg => Ada.Strings.Unbounded.To_Unbounded_String (Str))); end New_Error_Mal_Type; overriding function Sym_Type (T : Error_Mal_Type) return Sym_Types is begin return Error; end Sym_Type; overriding function To_Str (T : Error_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin return Ada.Strings.Unbounded.To_String (T.Error_Msg); end To_Str; function Nodes_Equal (A, B : Mal_Handle) return Boolean is begin if (not Is_Null (A) and not Is_Null (B)) and then Deref (A).Sym_Type = Deref (B).Sym_Type then if Deref (A).Sym_Type = Node then return Nodes_Equal (Deref_Node (A).Data, Deref_Node (B).Data) and then Nodes_Equal (Deref_Node (A).Next, Deref_Node (B).Next); else return A = B; end if; elsif Is_Null (A) and Is_Null (B) then return True; else -- either one of the args is null or the sym_types don't match return False; end if; end Nodes_Equal; function New_Node_Mal_Type (Data : Mal_Handle; Next : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Node_Mal_Type' (Mal_Type with Data => Data, Next => Next)); end New_Node_Mal_Type; overriding function Sym_Type (T : Node_Mal_Type) return Sym_Types is begin return Node; end Sym_Type; -- Get the first item in the list: function Car (L : List_Mal_Type) return Mal_Handle is begin if Is_Null (L.The_List) then return Smart_Pointers.Null_Smart_Pointer; else return Deref_Node (L.The_List).Data; end if; end Car; -- Get the rest of the list (second item onwards) function Cdr (L : List_Mal_Type) return Mal_Handle is Res : Mal_Handle; LP : List_Ptr; begin Res := New_List_Mal_Type (L.List_Type); if Is_Null (L.The_List) or else Is_Null (Deref_Node (L.The_List).Next) then return Res; else LP := Deref_List (Res); LP.The_List := Deref_Node (L.The_List).Next; LP.Last_Elem := L.Last_Elem; return Res; end if; end Cdr; function Length (L : List_Mal_Type) return Natural is Res : Natural; NP : Node_Ptr; begin Res := 0; NP := Deref_Node (L.The_List); while NP /= null loop Res := Res + 1; NP := Deref_Node (NP.Next); end loop; return Res; end Length; function Is_Null (L : List_Mal_Type) return Boolean is use Smart_Pointers; begin return Smart_Pointers."="(L.The_List, Null_Smart_Pointer); end Is_Null; function Null_List (L : List_Types) return List_Mal_Type is begin return (Mal_Type with List_Type => L, The_List => Smart_Pointers.Null_Smart_Pointer, Last_Elem => Smart_Pointers.Null_Smart_Pointer); end Null_List; function Map (Func_Ptr : Func_Access; L : List_Mal_Type) return Mal_Handle is Res, Old_List, First_New_Node, New_List : Mal_Handle; LP : List_Ptr; begin Res := New_List_Mal_Type (List_Type => L.Get_List_Type); Old_List := L.The_List; if Is_Null (Old_List) then return Res; end if; First_New_Node := New_Node_Mal_Type (Func_Ptr.all (Deref_Node (Old_List).Data)); New_List := First_New_Node; Old_List := Deref_Node (Old_List).Next; while not Is_Null (Old_List) loop Deref_Node (New_List).Next := New_Node_Mal_Type (Func_Ptr.all (Deref_Node (Old_List).Data)); New_List := Deref_Node (New_List).Next; Old_List := Deref_Node (Old_List).Next; end loop; LP := Deref_List (Res); LP.The_List := First_New_Node; LP.Last_Elem := New_List; return Res; end Map; function Reduce (Func_Ptr : Binary_Func_Access; L : List_Mal_Type) return Mal_Handle is C_Node : Node_Ptr; Res : Mal_Handle; use Smart_Pointers; begin C_Node := Deref_Node (L.The_List); if C_Node = null then return Smart_Pointers.Null_Smart_Pointer; end if; Res := C_Node.Data; while not Is_Null (C_Node.Next) loop C_Node := Deref_Node (C_Node.Next); Res := Func_Ptr (Res, C_Node.Data); end loop; return Res; end Reduce; overriding function To_Str (T : Node_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin if Is_Null (T.Data) then -- Left is null and by implication so is right. return ""; elsif Is_Null (T.Next) then -- Left is not null but right is. return To_Str (Deref (T.Data).all, Print_Readably); else -- Left and right are both not null. return To_Str (Deref (T.Data).all, Print_Readably) & " " & To_Str (Deref (T.Next).all, Print_Readably); end if; end To_Str; function Cat_Str (T : Node_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin if Is_Null (T.Data) then -- Left is null and by implication so is right. return ""; elsif Is_Null (T.Next) then -- Left is not null but right is. return To_Str (Deref (T.Data).all, Print_Readably); -- Left and right are both not null. else return To_Str (Deref (T.Data).all, Print_Readably) & Cat_Str (Deref_Node (T.Next).all, Print_Readably); end if; end Cat_Str; function Deref_Node (SP : Mal_Handle) return Node_Ptr is begin return Node_Ptr (Deref (SP)); end Deref_Node; function "=" (A, B : List_Mal_Type) return Boolean is begin return Nodes_Equal (A.The_List, B.The_List); end "="; function New_List_Mal_Type (The_List : List_Mal_Type) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new List_Mal_Type'(Mal_Type with List_Type => The_List.List_Type, The_List => The_List.The_List, Last_Elem => The_List.Last_Elem)); end New_List_Mal_Type; function New_List_Mal_Type (List_Type : List_Types; The_First_Node : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new List_Mal_Type' (Mal_Type with List_Type => List_Type, The_List => The_First_Node, Last_Elem => The_First_Node)); end New_List_Mal_Type; function Make_New_List (Handle_List : Handle_Lists) return Mal_Handle is List_SP : Mal_Handle; List_P : List_Ptr; begin List_SP := New_List_Mal_Type (List_Type => List_List); List_P := Deref_List (List_SP); for I in Handle_List'Range loop Append (List_P.all, Handle_List (I)); end loop; return List_SP; end Make_New_List; overriding function Sym_Type (T : List_Mal_Type) return Sym_Types is begin return List; end Sym_Type; function Get_List_Type (L : List_Mal_Type) return List_Types is begin return L.List_Type; end Get_List_Type; function Prepend (Op : Mal_Handle; To_List : List_Mal_Type) return Mal_Handle is begin return New_List_Mal_Type (List_List, New_Node_Mal_Type (Op, To_List.The_List)); end Prepend; procedure Append (To_List : in out List_Mal_Type; Op : Mal_Handle) is begin if Is_Null (Op) then return; -- Say what end if; -- If the list is null just insert the new element -- else use the last_elem pointer to insert it and then update it. if Is_Null (To_List.The_List) then To_List.The_List := New_Node_Mal_Type (Op); To_List.Last_Elem := To_List.The_List; else Deref_Node (To_List.Last_Elem).Next := New_Node_Mal_Type (Op); To_List.Last_Elem := Deref_Node (To_List.Last_Elem).Next; end if; end Append; -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. function Duplicate (The_List : List_Mal_Type) return Mal_Handle is Res, Old_List, First_New_Node, New_List : Mal_Handle; LP : List_Ptr; begin Res := New_List_Mal_Type (List_List); Old_List := The_List.The_List; if Is_Null (Old_List) then return Res; end if; First_New_Node := New_Node_Mal_Type (Deref_Node (Old_List).Data); New_List := First_New_Node; Old_List := Deref_Node (Old_List).Next; while not Is_Null (Old_List) loop Deref_Node (New_List).Next := New_Node_Mal_Type (Deref_Node (Old_List).Data); New_List := Deref_Node (New_List).Next; Old_List := Deref_Node (Old_List).Next; end loop; LP := Deref_List (Res); LP.The_List := First_New_Node; LP.Last_Elem := New_List; return Res; end Duplicate; function Nth (L : List_Mal_Type; N : Natural) return Mal_Handle is C : Natural; Next : Mal_Handle; begin C := 0; Next := L.The_List; while not Is_Null (Next) loop if C >= N then return Deref_Node (Next).Data; end if; C := C + 1; Next := Deref_Node (Next).Next; end loop; raise Runtime_Exception with "Nth (list): Index out of range"; end Nth; function Concat (Rest_Handle : List_Mal_Type) return Types.Mal_Handle is Rest_List : Types.List_Mal_Type; List : Types.List_Class_Ptr; Res_List_Handle, Dup_List : Mal_Handle; Last_Node_P : Mal_Handle := Smart_Pointers.Null_Smart_Pointer; begin Rest_List := Rest_Handle; -- Set the result to the null list. Res_List_Handle := New_List_Mal_Type (List_List); while not Is_Null (Rest_List) loop -- Find the next list in the list... List := Deref_List_Class (Car (Rest_List)); -- Duplicate nodes to its contents. Dup_List := Duplicate (List.all); -- If we haven't inserted a list yet, then take the duplicated list whole. if Is_Null (Last_Node_P) then Res_List_Handle := Dup_List; else -- Note that the first inserted list may have been the null list -- and so may the newly duplicated one... Deref_Node (Last_Node_P).Next := Deref_List (Dup_List).The_List; if Is_Null (Deref_List (Res_List_Handle).The_List) then Deref_List (Res_list_Handle).The_List := Deref_List (Dup_List).The_List; end if; if not Is_Null (Deref_List (Dup_List).Last_Elem) then Deref_List (Res_List_Handle).Last_Elem := Deref_List (Dup_List).Last_Elem; end if; end if; Last_Node_P := Deref_List (Dup_List).Last_Elem; Rest_List := Deref_List (Cdr (Rest_List)).all; end loop; return Res_List_Handle; end Concat; procedure Add_Defs (Defs : List_Mal_Type; Env : Envs.Env_Handle) is D, L : List_Mal_Type; begin D := Defs; while not Is_Null (D) loop L := Deref_List (Cdr (D)).all; Envs.Set (Env, Deref_Sym (Car (D)).Get_Sym, Eval_Callback.Eval.all (Car (L), Env)); D := Deref_List (Cdr(L)).all; end loop; end Add_Defs; function Deref_List (SP : Mal_Handle) return List_Ptr is begin return List_Ptr (Deref (SP)); end Deref_List; function Deref_List_Class (SP : Mal_Handle) return List_Class_Ptr is begin return List_Class_Ptr (Deref (SP)); end Deref_List_Class; overriding function To_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin if Is_Null (T.The_List) then return Opening (T.List_Type) & Closing (T.List_Type); else return Opening (T.List_Type) & To_String (Deref (T.The_List).all, Print_Readably) & Closing (T.List_Type); end if; end To_Str; function Pr_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin if Is_Null (T.The_List) then return ""; else return To_String (Deref_Node (T.The_List).all, Print_Readably); end if; end Pr_Str; function Cat_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin if Is_Null (T.The_List) then return ""; else return Cat_Str (Deref_Node (T.The_List).all, Print_Readably); end if; end Cat_Str; function Opening (LT : List_Types) return Character is Res : Character; begin case LT is when List_List => Res := '('; when Vector_List => Res := '['; when Hashed_List => Res := '{'; end case; return Res; end Opening; function Closing (LT : List_Types) return Character is Res : Character; begin case LT is when List_List => Res := ')'; when Vector_List => Res := ']'; when Hashed_List => Res := '}'; end case; return Res; end Closing; function New_Lambda_Mal_Type (Params : Mal_Handle; Expr : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is begin return Smart_Pointers.New_Ptr (new Lambda_Mal_Type' (Mal_Type with Params => Params, Expr => Expr, Env => Env, Is_Macro => False)); end New_Lambda_Mal_Type; overriding function Sym_Type (T : Lambda_Mal_Type) return Sym_Types is begin return Lambda; end Sym_Type; function Get_Env (L : Lambda_Mal_Type) return Envs.Env_Handle is begin return L.Env; end Get_Env; procedure Set_Env (L : in out Lambda_Mal_Type; Env : Envs.Env_Handle) is begin L.Env := Env; end Set_Env; function Get_Params (L : Lambda_Mal_Type) return Mal_Handle is begin if Deref (L.Params).Sym_Type = List and then Deref_List (L.Params).Get_List_Type = Vector_List then -- Its a vector and we need a list... return Deref_List_Class (L.Params).Duplicate; else return L.Params; end if; end Get_Params; function Get_Expr (L : Lambda_Mal_Type) return Mal_Handle is begin return L.Expr; end Get_Expr; function Get_Is_Macro (L : Lambda_Mal_Type) return Boolean is begin return L.Is_Macro; end Get_Is_Macro; procedure Set_Is_Macro (L : in out Lambda_Mal_Type; B : Boolean) is begin L.Is_Macro := B; end Set_Is_Macro; function Apply (L : Lambda_Mal_Type; Param_List : Mal_Handle) return Mal_Handle is E : Envs.Env_Handle; Param_Names : List_Mal_Type; Res : Mal_Handle; begin E := Envs.New_Env (L.Env); Param_Names := Deref_List (L.Get_Params).all; if Envs.Bind (E, Param_Names, Deref_List (Param_List).all) then Res := Eval_Callback.Eval.all (L.Get_Expr, E); else raise Runtime_Exception with "Bind failed in Apply"; end if; return Res; end Apply; overriding function To_Str (T : Lambda_Mal_Type; Print_Readably : Boolean := True) return Mal_String is begin -- return "(lambda " & Ada.Strings.Unbounded.To_String (T.Rep) & ")"; return "#"; end To_Str; function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr is begin return Lambda_Ptr (Deref (SP)); end Deref_Lambda; function Arith_Op (A, B : Mal_Handle) return Mal_Handle is use Types; A_Sym_Type : Sym_Types; B_Sym_Type : Sym_Types; begin if Is_Null (A) then if Is_Null (B) then -- both null, gotta be zero. return New_Int_Mal_Type (0); else -- A is null but B is not. return Arith_Op (New_Int_Mal_Type (0), B); end if; elsif Is_Null (B) then -- A is not null but B is. return Arith_Op (A, New_Int_Mal_Type (0)); end if; -- else both A and B and not null.:wq A_Sym_Type := Deref (A).Sym_Type; B_Sym_Type := Deref (B).Sym_Type; if A_Sym_Type = Int and B_Sym_Type = Int then return New_Int_Mal_Type (Int_Op (Deref_Int (A).Get_Int_Val, Deref_Int (B).Get_Int_Val)); elsif A_Sym_Type = Int and B_Sym_Type = Floating then return New_Float_Mal_Type (Float_Op (Mal_Float (Deref_Int (A).Get_Int_Val), Deref_Float (B).Get_Float_Val)); elsif A_Sym_Type = Floating and B_Sym_Type = Int then return New_Float_Mal_Type (Float_Op (Deref_Float (A).Get_Float_Val, Mal_Float (Deref_Float (B).Get_Float_Val))); elsif A_Sym_Type = Floating and B_Sym_Type = Floating then return New_Float_Mal_Type (Float_Op (Deref_Float (A).Get_Float_Val, Deref_Float (B).Get_Float_Val)); else if A_Sym_Type = Error then return A; elsif B_Sym_Type = Error then return B; else return New_Error_Mal_Type ("Invalid operands"); end if; end if; end Arith_Op; function Rel_Op (A, B : Mal_Handle) return Mal_Handle is use Types; A_Sym_Type : Sym_Types := Deref (A).Sym_Type; B_Sym_Type : Sym_Types := Deref (B).Sym_Type; begin if A_Sym_Type = Int and B_Sym_Type = Int then return New_Bool_Mal_Type (Int_Rel_Op (Deref_Int (A).Get_Int_Val, Deref_Int (B).Get_Int_Val)); elsif A_Sym_Type = Int and B_Sym_Type = Floating then return New_Bool_Mal_Type (Float_Rel_Op (Mal_Float (Deref_Int (A).Get_Int_Val), Deref_Float (B).Get_Float_Val)); elsif A_Sym_Type = Floating and B_Sym_Type = Int then return New_Bool_Mal_Type (Float_Rel_Op (Deref_Float (A).Get_Float_Val, Mal_Float (Deref_Float (B).Get_Float_Val))); else return New_Bool_Mal_Type (Float_Rel_Op (Deref_Float (A).Get_Float_Val, Deref_Float (B).Get_Float_Val)); end if; end Rel_Op; end Types; ================================================ FILE: impls/ada/types.ads ================================================ -- This started out as a simple public variant record. -- Then smart pointers were added. They were part of the Mal_Type and -- were required to be public because of the dependencies and -- how the variant record was public. Not very Ada-like. -- The third version bites the bullet and delares Mal_Type as tagged. -- Smart pointers are an OO version in a separate package. -- The Doubly_Linked_Lists have been replaced with a tree-like list instead... -- The tree-like list has been replaced with a singly linked list. Sigh. -- WARNING! This code contains: -- Recursive data structures. -- Object-based smart pointers. -- Object-oriented code. -- And strong-typing! -- Chris M Moore 25/03/2015 with Ada.Strings.Unbounded; with Smart_Pointers; with Envs; package Types is -- Some simple types. Not supposed to use the standard types directly. subtype Mal_Float is Float; subtype Mal_Integer is Integer; subtype Mal_String is String; -- Start off with the top-level abstract type. subtype Mal_Handle is Smart_Pointers.Smart_Pointer; function "=" (A, B : Mal_Handle) return Mal_Handle; function "=" (A, B : Mal_Handle) return Boolean; type Sym_Types is (Nil, Bool, Int, Floating, Str, Sym, Atom, Node, List, Func, Lambda, Error); type Mal_Type is abstract new Smart_Pointers.Base_Class with private; function Sym_Type (T : Mal_Type) return Sym_Types is abstract; function Get_Meta (T : Mal_Type) return Mal_Handle; procedure Set_Meta (T : in out Mal_Type'Class; SP : Mal_Handle); function Copy (M : Mal_Handle) return Mal_Handle; function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True) return Mal_String; type Mal_Ptr is access all Mal_Type'Class; -- A helper function that just view converts the smart pointer to -- a Mal_Type'Class pointer. function Deref (S : Mal_Handle) return Mal_Ptr; -- A helper function to detect null smart pointers. function Is_Null (S : Mal_Handle) return Boolean; -- Derived types. All boilerplate from here. type Nil_Mal_Type is new Mal_Type with private; function New_Nil_Mal_Type return Mal_Handle; overriding function Sym_Type (T : Nil_Mal_Type) return Sym_Types; type Int_Mal_Type is new Mal_Type with private; function New_Int_Mal_Type (Int : Mal_Integer) return Mal_Handle; overriding function Sym_Type (T : Int_Mal_Type) return Sym_Types; function Get_Int_Val (T : Int_Mal_Type) return Mal_Integer; type Int_Ptr is access all Int_Mal_Type; function Deref_Int (SP : Mal_Handle) return Int_Ptr; type Float_Mal_Type is new Mal_Type with private; function New_Float_Mal_Type (Floating : Mal_Float) return Mal_Handle; overriding function Sym_Type (T : Float_Mal_Type) return Sym_Types; function Get_Float_Val (T : Float_Mal_Type) return Mal_Float; type Float_Ptr is access all Float_Mal_Type; function Deref_Float (SP : Mal_Handle) return Float_Ptr; type Bool_Mal_Type is new Mal_Type with private; function New_Bool_Mal_Type (Bool : Boolean) return Mal_Handle; overriding function Sym_Type (T : Bool_Mal_Type) return Sym_Types; function Get_Bool (T : Bool_Mal_Type) return Boolean; type Bool_Ptr is access all Bool_Mal_Type; function Deref_Bool (SP : Mal_Handle) return Bool_Ptr; type String_Mal_Type is new Mal_Type with private; function New_String_Mal_Type (Str : Mal_String) return Mal_Handle; overriding function Sym_Type (T : String_Mal_Type) return Sym_Types; function Get_String (T : String_Mal_Type) return Mal_String; type String_Ptr is access all String_Mal_Type; function Deref_String (SP : Mal_Handle) return String_Ptr; type Symbol_Mal_Type is new Mal_Type with private; function New_Symbol_Mal_Type (Str : Mal_String) return Mal_Handle; overriding function Sym_Type (T : Symbol_Mal_Type) return Sym_Types; function Get_Sym (T : Symbol_Mal_Type) return Mal_String; type Sym_Ptr is access all Symbol_Mal_Type; function Deref_Sym (S : Mal_Handle) return Sym_Ptr; type Atom_Mal_Type is new Mal_Type with private; function New_Atom_Mal_Type (MH : Mal_Handle) return Mal_Handle; overriding function Sym_Type (T : Atom_Mal_Type) return Sym_Types; function Get_Atom (T : Atom_Mal_Type) return Mal_Handle; procedure Set_Atom (T : in out Atom_Mal_Type; New_Val : Mal_Handle); type Atom_Ptr is access all Atom_Mal_Type; function Deref_Atom (S : Mal_Handle) return Atom_Ptr; type Error_Mal_Type is new Mal_Type with private; function New_Error_Mal_Type (Str : Mal_String) return Mal_Handle; overriding function Sym_Type (T : Error_Mal_Type) return Sym_Types; -- Lists. type List_Types is (List_List, Vector_List, Hashed_List); function Opening (LT : List_Types) return Character; function Closing (LT : List_Types) return Character; type List_Mal_Type is new Mal_Type with private; function "=" (A, B : List_Mal_Type) return Boolean; function New_List_Mal_Type (List_Type : List_Types; The_First_Node : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) return Mal_Handle; function New_List_Mal_Type (The_List : List_Mal_Type) return Mal_Handle; type Handle_Lists is array (Positive range <>) of Mal_Handle; -- Make a new list of the form: (Handle_List(1), Handle_List(2)...) function Make_New_List (Handle_List : Handle_Lists) return Mal_Handle; overriding function Sym_Type (T : List_Mal_Type) return Sym_Types; function Get_List_Type (L : List_Mal_Type) return List_Types; function Prepend (Op : Mal_Handle; To_List : List_Mal_Type) return Mal_Handle; procedure Append (To_List : in out List_Mal_Type; Op : Mal_Handle); function Length (L : List_Mal_Type) return Natural; function Nth (L : List_Mal_Type; N : Natural) return Mal_Handle; procedure Add_Defs (Defs : List_Mal_Type; Env : Envs.Env_Handle); -- Get the first item in the list: function Car (L : List_Mal_Type) return Mal_Handle; -- Get the rest of the list (second item onwards) function Cdr (L : List_Mal_Type) return Mal_Handle; type Func_Access is access function (Elem : Mal_Handle) return Mal_Handle; function Map (Func_Ptr : Func_Access; L : List_Mal_Type) return Mal_Handle; type Binary_Func_Access is access function (A, B : Mal_Handle) return Mal_Handle; function Reduce (Func_Ptr : Binary_Func_Access; L : List_Mal_Type) return Mal_Handle; function Is_Null (L : List_Mal_Type) return Boolean; function Null_List (L : List_Types) return List_Mal_Type; function Pr_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String; function Cat_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String; function Concat (Rest_Handle : List_Mal_Type) return Types.Mal_Handle; -- a new list -- Duplicate copies the list (logically). This is to allow concatenation, -- The result is always a List_List. function Duplicate (The_List : List_Mal_Type) return Mal_Handle; type List_Ptr is access all List_Mal_Type; function Deref_List (SP : Mal_Handle) return List_Ptr; type List_Class_Ptr is access all List_Mal_Type'Class; function Deref_List_Class (SP : Mal_Handle) return List_Class_Ptr; type Func_Mal_Type is new Mal_Type with private; type Builtin_Func is access function (MH : Mal_Handle) return Mal_Handle; function New_Func_Mal_Type (Str : Mal_String; F : Builtin_Func) return Mal_Handle; overriding function Sym_Type (T : Func_Mal_Type) return Sym_Types; function Get_Func_Name (T : Func_Mal_Type) return Mal_String; function Call_Func (FMT : Func_Mal_Type; Rest_List : Mal_Handle) return Mal_Handle; type Func_Ptr is access all Func_Mal_Type; function Deref_Func (S : Mal_Handle) return Func_Ptr; type Lambda_Mal_Type is new Mal_Type with private; function New_Lambda_Mal_Type (Params : Mal_Handle; Expr : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle; overriding function Sym_Type (T : Lambda_Mal_Type) return Sym_Types; function Get_Env (L : Lambda_Mal_Type) return Envs.Env_Handle; procedure Set_Env (L : in out Lambda_Mal_Type; Env : Envs.Env_Handle); function Get_Params (L : Lambda_Mal_Type) return Mal_Handle; function Get_Expr (L : Lambda_Mal_Type) return Mal_Handle; function Get_Is_Macro (L : Lambda_Mal_Type) return Boolean; procedure Set_Is_Macro (L : in out Lambda_Mal_Type; B : Boolean); function Apply (L : Lambda_Mal_Type; Param_List : Mal_Handle) return Mal_Handle; type Lambda_Ptr is access all Lambda_Mal_Type; function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr; generic with function Int_Op (A, B : Mal_Integer) return Mal_Integer; with function Float_Op (A, B : Mal_Float) return Mal_Float; function Arith_Op (A, B : Mal_Handle) return Mal_Handle; generic with function Int_Rel_Op (A, B : Mal_Integer) return Boolean; with function Float_Rel_Op (A, B : Mal_Float) return Boolean; function Rel_Op (A, B : Mal_Handle) return Mal_Handle; Runtime_Exception : exception; Mal_Exception : exception; -- So tempting to call this Mal_Function but... Mal_Exception_Value : Mal_Handle; -- Used by mal's throw command private type Mal_Type is abstract new Smart_Pointers.Base_Class with record Meta : Mal_Handle; end record; -- Not allowed to be abstract and private. RM 3.9.3(10) -- So if you call this it'll just raise an exception. function To_Str (T : Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Nil_Mal_Type is new Mal_Type with null record; overriding function To_Str (T : Nil_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Int_Mal_Type is new Mal_Type with record Int_Val : Mal_Integer; end record; overriding function To_Str (T : Int_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Float_Mal_Type is new Mal_Type with record Float_Val : Mal_Float; end record; overriding function To_Str (T : Float_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Bool_Mal_Type is new Mal_Type with record Bool_Val : Boolean; end record; overriding function To_Str (T : Bool_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type String_Mal_Type is new Mal_Type with record The_String : Ada.Strings.Unbounded.Unbounded_String; end record; overriding function To_Str (T : String_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Symbol_Mal_Type is new Mal_Type with record The_Symbol : Ada.Strings.Unbounded.Unbounded_String; end record; overriding function To_Str (T : Symbol_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Atom_Mal_Type is new Mal_Type with record The_Atom : Mal_Handle; end record; overriding function To_Str (T : Atom_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Func_Mal_Type is new Mal_Type with record Func_Name : Ada.Strings.Unbounded.Unbounded_String; Func_P : Builtin_Func; end record; overriding function To_Str (T : Func_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Error_Mal_Type is new Mal_Type with record Error_Msg : Ada.Strings.Unbounded.Unbounded_String; end record; overriding function To_Str (T : Error_Mal_Type; Print_Readably : Boolean := True) return Mal_String; -- Nodes have to be a differnt type from a List; -- otherwise how do you represent a list within a list? type Node_Mal_Type is new Mal_Type with record Data : Mal_Handle; Next : Mal_Handle; -- This is always a Node_Mal_Type handle end record; function New_Node_Mal_Type (Data : Mal_Handle; Next : Mal_Handle := Smart_Pointers.Null_Smart_Pointer) return Mal_Handle; overriding function Sym_Type (T : Node_Mal_Type) return Sym_Types; overriding function To_Str (T : Node_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Node_Ptr is access all Node_Mal_Type; function Deref_Node (SP : Mal_Handle) return Node_Ptr; type List_Mal_Type is new Mal_Type with record List_Type : List_Types; The_List : Mal_Handle; Last_Elem : Mal_Handle; end record; overriding function To_Str (T : List_Mal_Type; Print_Readably : Boolean := True) return Mal_String; type Container_Cursor is tagged record The_Node : Node_Ptr := null; end record; type Lambda_Mal_Type is new Mal_Type with record Params, Expr : Mal_Handle; Env : Envs.Env_Handle; Is_Macro : Boolean; end record; overriding function To_Str (T : Lambda_Mal_Type; Print_Readably : Boolean := True) return Mal_String; end Types; ================================================ FILE: impls/ada.2/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # GNU Ada compiler RUN apt-get -y install gnat libreadline-dev ================================================ FILE: impls/ada.2/Makefile ================================================ ifdef DEBUG ADAFLAGS := -Wall -Wextra -gnatw.eH.Y -gnatySdouxy -gnatVa -g -gnataEfoqQ \ -fstack-check -pg LDFLAGS := -pg else # -O3 is not recommended as the default by the GCC documentation, # and -O2 seems to produce slightly better performances. ADAFLAGS := -O2 -gnatnp endif # Compiler arguments. CARGS = $(ADAFLAGS) # Linker arguments. LARGS = $(LDFLAGS) -lreadline step0 := step0_repl step13 := step1_read_print \ step2_eval \ step3_env step49 := step4_if_fn_do \ step5_tco \ step6_file \ step7_quote \ step8_macros \ step9_try stepa := stepA_mal steps := $(step0) $(step13) $(step49) $(stepa) .PHONY: all clean all: $(steps) clean: $(RM) *~ *.adt *.ali *.o b~*.ad[bs] gmon.out $(steps) # Tell Make how to detect out-of-date executables, and let gnatmake do # the rest when it must be executed. sources = $(foreach unit,$1,$(unit).adb $(unit).ads) TYPES := $(call sources,\ envs \ err \ garbage_collected \ printer \ reader \ readline \ types \ types-atoms \ types-builtins \ types-fns \ types-maps \ types-sequences \ types-strings \ ) CORE := $(call sources,\ core \ ) $(step0) : %: %.adb $(step13): %: %.adb $(TYPES) $(step49): %: %.adb $(TYPES) $(CORE) $(stepa) : stepA%: stepa%.adb $(TYPES) $(CORE) $(steps) : gnatmake $< -o $@ -cargs $(CARGS) -largs $(LARGS) .PHONY: steps.diff steps.diff: diff -u step0_*.adb step1_*.adb || true diff -u step1_*.adb step2_*.adb || true diff -u step2_*.adb step3_*.adb || true diff -u step3_*.adb step4_*.adb || true diff -u step4_*.adb step5_*.adb || true diff -u step5_*.adb step6_*.adb || true diff -u step6_*.adb step7_*.adb || true diff -u step7_*.adb step8_*.adb || true diff -u step8_*.adb step9_*.adb || true diff -u step9_*.adb stepa_*.adb || true ================================================ FILE: impls/ada.2/README ================================================ Comparison with the first Ada implementation. -- The first implementation was deliberately compatible with all Ada compilers, while this one illustrates various Ada 2012 features: assertions, preconditions, invariants, initial assignment for limited types, limited imports... The variant MAL type is implemented with a discriminant instead of object-style dispatching. This allows more static and dynamic checks, but also two crucial performance improvements: * Nil, boolean, integers and pointers to built-in functions are passed by value without dynamic allocation. * Lists are implemented as C-style arrays, and can often be allocated on the stack. Another difference is that a minimal form of garbage collecting is implemented, removing objects not referenced from the main environment. Reference counting does not seem efficient even for symbols, and never deallocates cyclic structures. The implementation collects garbage after each Read-Eval-Print cycle. It would be much more difficult to collect garbage inside scripts. If this is ever done, it would be better to reimplement load-file in Ada and run a cycle after each root evaluation. It is possible to execute the recursion marking references in parallel with the recursion printing the result, which does not modify anything and ignores the reference marking. This works but is less performant than sequential execution even with Linux threads and a single task initialized at startup. Each pointer type goes on using its own memory pool, enabling better performance when the designated subtype has a fixed size. The eventual performances compete with C-style languages, allthough all user input is checked (implicit language-defined checks like array bounds and discriminant consistency are only enabled during tests). Debugging -- Uncaught exceptions are reported with an execution trace (excluding TCO cycles). This has become possible in step9, but has been backported to former steps as this is really handy for debugging. Some environment variables increase verbosity. # dbgread= ./stepAmal trace reader recursion # dbgeval= ./stepAmal trace eval recursion (including TCO) ================================================ FILE: impls/ada.2/core.adb ================================================ with Ada.Calendar; with Ada.Characters.Latin_1; with Ada.Strings.Unbounded; with Ada.Text_IO.Unbounded_IO; with Err; with Printer; with Reader; with Types.Atoms; with Types.Builtins; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; package body Core is package ASU renames Ada.Strings.Unbounded; use all type Types.Kind_Type; -- Used by time_ms. Start_Time : constant Ada.Calendar.Time := Ada.Calendar.Clock; generic Kind : in Types.Kind_Type; function Generic_Kind_Test (Args : in Types.T_Array) return Types.T; function Generic_Kind_Test (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return (Kind_Boolean, Args (Args'First).Kind = Kind); end Generic_Kind_Test; generic with function Ada_Operator (Left, Right : in Integer) return Integer; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Number and then Args (Args'Last).Kind = Kind_Number, "expected two numbers"); return (Kind_Number, Ada_Operator (Args (Args'First).Number, Args (Args'Last).Number)); end Generic_Mal_Operator; generic with function Ada_Operator (Left, Right : in Integer) return Boolean; function Generic_Comparison (Args : in Types.T_Array) return Types.T; function Generic_Comparison (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Number and then Args (Args'Last).Kind = Kind_Number, "expected two numbers"); return (Kind_Boolean, Ada_Operator (Args (Args'First).Number, Args (Args'Last).Number)); end Generic_Comparison; function Addition is new Generic_Mal_Operator ("+"); function Apply (Args : in Types.T_Array) return Types.T; function Division is new Generic_Mal_Operator ("/"); function Equals (Args : in Types.T_Array) return Types.T; function Greater_Equal is new Generic_Comparison (">="); function Greater_Than is new Generic_Comparison (">"); function Is_Atom is new Generic_Kind_Test (Kind_Atom); function Is_False (Args : in Types.T_Array) return Types.T; function Is_Function (Args : in Types.T_Array) return Types.T; function Is_Keyword is new Generic_Kind_Test (Kind_Keyword); function Is_List is new Generic_Kind_Test (Kind_List); function Is_Macro is new Generic_Kind_Test (Kind_Macro); function Is_Map is new Generic_Kind_Test (Kind_Map); function Is_Nil is new Generic_Kind_Test (Kind_Nil); function Is_Number is new Generic_Kind_Test (Kind_Number); function Is_Sequential (Args : in Types.T_Array) return Types.T; function Is_String is new Generic_Kind_Test (Kind_String); function Is_Symbol is new Generic_Kind_Test (Kind_Symbol); function Is_True (Args : in Types.T_Array) return Types.T; function Is_Vector is new Generic_Kind_Test (Kind_Vector); function Keyword (Args : in Types.T_Array) return Types.T; function Less_Equal is new Generic_Comparison ("<="); function Less_Than is new Generic_Comparison ("<"); function Meta (Args : in Types.T_Array) return Types.T; function Pr_Str (Args : in Types.T_Array) return Types.T; function Println (Args : in Types.T_Array) return Types.T; function Prn (Args : in Types.T_Array) return Types.T; function Product is new Generic_Mal_Operator ("*"); function Read_String (Args : in Types.T_Array) return Types.T; function Readline (Args : in Types.T_Array) return Types.T; function Seq (Args : in Types.T_Array) return Types.T; function Slurp (Args : in Types.T_Array) return Types.T; function Str (Args : in Types.T_Array) return Types.T; function Subtraction is new Generic_Mal_Operator ("-"); function Symbol (Args : in Types.T_Array) return Types.T; function Time_Ms (Args : in Types.T_Array) return Types.T; function With_Meta (Args : in Types.T_Array) return Types.T; ---------------------------------------------------------------------- function Apply (Args : in Types.T_Array) return Types.T is begin Err.Check (2 <= Args'Length and then Args (Args'Last).Kind in Types.Kind_Sequence, "expected a function, optional arguments then a sequence"); declare use type Types.T_Array; F : Types.T renames Args (Args'First); A : constant Types.T_Array := Args (Args'First + 1 .. Args'Last - 1) & Args (Args'Last).Sequence.all.Data; begin case F.Kind is when Kind_Builtin => return F.Builtin.all (A); when Kind_Builtin_With_Meta => return F.Builtin_With_Meta.all.Builtin.all (A); when Kind_Fn | Kind_Macro => return F.Fn.all.Apply (A); when others => Err.Raise_With ("parameter 1 must be a function or macro"); end case; end; end Apply; function Equals (Args : in Types.T_Array) return Types.T is use type Types.T; begin Err.Check (Args'Length = 2, "expected 2 parameters"); return (Kind_Boolean, Args (Args'First) = Args (Args'Last)); end Equals; function Is_False (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return (Kind_Boolean, Args (Args'First).Kind = Kind_Boolean and then not Args (Args'First).Ada_Boolean); end Is_False; function Is_Function (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return (Kind_Boolean, Args (Args'First).Kind in Types.Kind_Function); end Is_Function; function Is_Sequential (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return (Kind_Boolean, Args (Args'First).Kind in Types.Kind_Sequence); end Is_Sequential; function Is_True (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return (Kind_Boolean, Args (Args'First).Kind = Kind_Boolean and then Args (Args'First).Ada_Boolean); end Is_True; function Keyword (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind in Types.Kind_Key, "expected a keyword or a string"); return (Kind_Keyword, Args (Args'First).Str); end Keyword; function Meta (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); declare A1 : Types.T renames Args (Args'First); begin case A1.Kind is when Types.Kind_Sequence => return A1.Sequence.all.Meta; when Kind_Map => return A1.Map.all.Meta; when Kind_Fn => return A1.Fn.all.Meta; when Kind_Builtin_With_Meta => return A1.Builtin_With_Meta.all.Meta; when Kind_Builtin => return Types.Nil; when others => Err.Raise_With ("expected a function, map or sequence"); end case; end; end Meta; procedure NS_Add_To_Repl (Repl : in Envs.Ptr) is procedure P (S : in String; B : in Types.Builtin_Ptr) with Inline; procedure P (S : in String; B : in Types.Builtin_Ptr) is begin Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc (S)), (Kind_Builtin, B)); end P; begin P ("+", Addition'Access); P ("apply", Apply'Access); P ("assoc", Types.Maps.Assoc'Access); P ("atom", Types.Atoms.Atom'Access); P ("concat", Types.Sequences.Concat'Access); P ("conj", Types.Sequences.Conj'Access); P ("cons", Types.Sequences.Cons'Access); P ("contains?", Types.Maps.Contains'Access); P ("count", Types.Sequences.Count'Access); P ("deref", Types.Atoms.Deref'Access); P ("dissoc", Types.Maps.Dissoc'Access); P ("/", Division'Access); P ("=", Equals'Access); P ("first", Types.Sequences.First'Access); P ("get", Types.Maps.Get'Access); P (">=", Greater_Equal'Access); P (">", Greater_Than'Access); P ("hash-map", Types.Maps.Hash_Map'Access); P ("atom?", Is_Atom'Access); P ("empty?", Types.Sequences.Is_Empty'Access); P ("false?", Is_False'Access); P ("fn?", Is_Function'Access); P ("keyword?", Is_Keyword'Access); P ("list?", Is_List'Access); P ("macro?", Is_Macro'Access); P ("map?", Is_Map'Access); P ("nil?", Is_Nil'Access); P ("number?", Is_Number'Access); P ("sequential?", Is_Sequential'Access); P ("string?", Is_String'Access); P ("symbol?", Is_Symbol'Access); P ("true?", Is_True'Access); P ("vector?", Is_Vector'Access); P ("keys", Types.Maps.Keys'Access); P ("keyword", Keyword'Access); P ("<=", Less_Equal'Access); P ("<", Less_Than'Access); P ("list", Types.Sequences.List'Access); P ("map", Types.Sequences.Map'Access); P ("meta", Meta'Access); P ("nth", Types.Sequences.Nth'Access); P ("pr-str", Pr_Str'Access); P ("println", Println'Access); P ("prn", Prn'Access); P ("*", Product'Access); P ("read-string", Read_String'Access); P ("readline", Readline'Access); P ("reset!", Types.Atoms.Reset'Access); P ("rest", Types.Sequences.Rest'Access); P ("seq", Seq'Access); P ("slurp", Slurp'Access); P ("str", Str'Access); P ("-", Subtraction'Access); P ("swap!", Types.Atoms.Swap'Access); P ("symbol", Symbol'Access); 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; function Pr_Str (Args : in Types.T_Array) return Types.T is R : ASU.Unbounded_String; Started : Boolean := False; begin for A of Args loop if Started then ASU.Append (R, ' '); else Started := True; end if; Printer.Pr_Str (R, A); end loop; return (Kind_String, Types.Strings.Alloc (ASU.To_String (R))); end Pr_Str; function Println (Args : in Types.T_Array) return Types.T is Started : Boolean := False; Buffer : ASU.Unbounded_String; begin for A of Args loop if Started then ASU.Append (Buffer, ' '); else Started := True; end if; Printer.Pr_Str (Buffer, A, Readably => False); end loop; Ada.Text_IO.Unbounded_IO.Put_Line (Buffer); return Types.Nil; end Println; function Prn (Args : in Types.T_Array) return Types.T is -- Calling Pr_Str would create an intermediate copy. Buffer : ASU.Unbounded_String; Started : Boolean := False; begin for A of Args loop if Started then ASU.Append (Buffer, ' '); else Started := True; end if; Printer.Pr_Str (Buffer, A); end loop; Ada.Text_IO.Unbounded_IO.Put_Line (Buffer); return Types.Nil; end Prn; function Readline (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, "expected a string"); Ada.Text_IO.Put (Args (Args'First).Str.all.To_String); if Ada.Text_IO.End_Of_File then return Types.Nil; else return (Kind_String, Types.Strings.Alloc (Ada.Text_IO.Get_Line)); end if; end Readline; function Read_String (Args : in Types.T_Array) return Types.T is Result : Types.T; procedure Process (Element : in String); procedure Process (Element : in String) is R : constant Types.T_Array := Reader.Read_Str (Element); begin Err.Check (R'Length = 1, "parameter must contain 1 expression"); Result := R (R'First); end Process; begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, "expected a string"); Args (Args'First).Str.all.Query_Element (Process'Access); return Result; end Read_String; function Seq (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); case Args (Args'First).Kind is when Kind_Nil => return Types.Nil; when Kind_String => declare Result : Types.T; procedure Process (S : in String); procedure Process (S : in String) is begin if S'Length = 0 then Result := Types.Nil; else Result := (Kind_List, Types.Sequences.Constructor (S'Length)); for I in S'Range loop Result.Sequence.all.Data (S'First - 1 + I) := (Kind_String, Types.Strings.Alloc (S (I .. I))); end loop; end if; end Process; begin Args (Args'First).Str.all.Query_Element (Process'Access); return Result; end; when Types.Kind_Sequence => if Args (Args'First).Sequence.all.Length = 0 then return Types.Nil; else return (Kind_List, Args (Args'First).Sequence); end if; when others => Err.Raise_With ("expected nil, a sequence or a string"); end case; end Seq; function Slurp (Args : in Types.T_Array) return Types.T is use Ada.Text_IO; File : File_Type; Buffer : ASU.Unbounded_String; begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, "expected a string"); Open (File, In_File, Args (Args'First).Str.all.To_String); while not End_Of_File (File) loop ASU.Append (Buffer, Get_Line (File)); ASU.Append (Buffer, Ada.Characters.Latin_1.LF); end loop; Close (File); return (Kind_String, Types.Strings.Alloc (ASU.To_String (Buffer))); exception -- Catch I/O errors, but not Err.Error... when E : Status_Error | Name_Error | Use_Error | Mode_Error => if Is_Open (File) then Close (File); end if; Err.Raise_In_Mal (E); end Slurp; function Str (Args : in Types.T_Array) return Types.T is R : ASU.Unbounded_String; begin for Arg of Args loop Printer.Pr_Str (R, Arg, Readably => False); end loop; return (Kind_String, Types.Strings.Alloc (ASU.To_String (R))); end Str; function Symbol (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String, "expected a string"); return (Kind_Symbol, Args (Args'First).Str); end Symbol; function Time_Ms (Args : in Types.T_Array) return Types.T is use type Ada.Calendar.Time; begin Err.Check (Args'Length = 0, "expected no parameter"); return (Kind_Number, Integer (1000.0 * (Ada.Calendar.Clock - Start_Time))); end Time_Ms; function With_Meta (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 2, "expected 2 parameters"); declare A1 : Types.T renames Args (Args'First); A2 : Types.T renames Args (Args'Last); begin case A1.Kind is when Kind_Builtin_With_Meta => return A1.Builtin_With_Meta.all.With_Meta (A2); when Kind_Builtin => return Types.Builtins.With_Meta (A1.Builtin, A2); when Kind_List => return R : constant Types.T := Types.Sequences.List (A1.Sequence.all.Data) do R.Sequence.all.Meta := A2; end return; when Kind_Vector => return R : constant Types.T := Types.Sequences.Vector (A1.Sequence.all.Data) do R.Sequence.all.Meta := A2; end return; when Kind_Map => return A1.Map.all.With_Meta (A2); when Kind_Fn => return (Kind_Fn, Types.Fns.New_Function (A1.Fn.all.Params, A1.Fn.all.Ast, A1.Fn.all.Env, A2)); when others => Err.Raise_With ("parameter 1 must be a function, map or sequence"); end case; end; end With_Meta; end Core; ================================================ FILE: impls/ada.2/core.ads ================================================ with Envs; package Core is procedure NS_Add_To_Repl (Repl : in Envs.Ptr); -- Add built-in functions. end Core; ================================================ FILE: impls/ada.2/envs.adb ================================================ with Ada.Text_IO.Unbounded_IO; with Err; with Printer; with Types.Sequences; package body Envs is use all type Types.Kind_Type; use type Types.Strings.Instance; ---------------------------------------------------------------------- procedure Dump_Stack (Env : in Instance) is use Ada.Text_IO; begin Put ("environment:"); for P in Env.Data.Iterate loop -- Do not print builtins for repl. if HM.Element (P).Kind /= Kind_Builtin or Env.Outer /= null then Put (" "); HM.Key (P).all.Query_Element (Put'Access); Put (':'); Unbounded_IO.Put (Printer.Pr_Str (HM.Element (P))); New_Line; end if; end loop; if Env.Outer /= null then Put ("outer is "); Env.Outer.all.Dump_Stack; end if; end Dump_Stack; function Get (Env : in Instance; Key : in Types.String_Ptr) return Types.T is Position : HM.Cursor := Env.Data.Find (Key); Ref : Link; begin if not HM.Has_Element (Position) then Ref := Env.Outer; loop if Ref = null then -- Not using Err.Check, which would compute the -- argument even if the assertion holds... Err.Raise_With ("'" & Key.To_String & "' not found"); end if; Position := Ref.all.Data.Find (Key); exit when HM.Has_Element (Position); Ref := Ref.all.Outer; end loop; end if; return HM.Element (Position); end Get; function Get_Or_Nil (Env : Instance; Key : Types.String_Ptr) return Types.T is Position : HM.Cursor := Env.Data.Find (Key); Ref : Link; begin if not HM.Has_Element (Position) then Ref := Env.Outer; loop if Ref = null then return Types.Nil; end if; Position := Ref.all.Data.Find (Key); exit when HM.Has_Element (Position); Ref := Ref.all.Outer; end loop; end if; return HM.Element (Position); end Get_Or_Nil; procedure Keep_References (Object : in out Instance) is begin for Position in Object.Data.Iterate loop HM.Key (Position).all.Keep; Types.Keep (HM.Element (Position)); end loop; if Object.Outer /= null then Object.Outer.all.Keep; end if; end Keep_References; function New_Env (Outer : in Link := null) return Ptr is Ref : constant Ptr := new Instance; begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); Ref.all.Outer := Outer; return Ref; end New_Env; procedure Set_Binds (Env : in out Instance; Binds : in Types.T_Array; Exprs : in Types.T_Array) is begin if 2 <= Binds'Length and then Binds (Binds'Last - 1).Str.all = "&" then Err.Check (Binds'Length - 2 <= Exprs'Length, "not enough actual parameters for vararg function"); for I in 0 .. Binds'Length - 3 loop Env.Data.Include (Key => Binds (Binds'First + I).Str, New_Item => Exprs (Exprs'First + I)); end loop; Env.Data.Include (Key => Binds (Binds'Last).Str, New_Item => Types.Sequences.List (Exprs (Exprs'First + Binds'Length - 2 .. Exprs'Last))); else Err.Check (Binds'Length = Exprs'Length, "wrong parameter count for (not vararg) function"); for I in 0 .. Binds'Length - 1 loop Env.Data.Include (Key => Binds (Binds'First + I).Str, New_Item => Exprs (Exprs'First + I)); end loop; end if; end Set_Binds; procedure Set (Env : in out Instance; Key : in Types.T; New_Item : in Types.T) is begin Err.Check (Key.Kind = Kind_Symbol, "environment keys must be symbols"); Env.Data.Include (Key.Str, New_Item); end Set; end Envs; ================================================ FILE: impls/ada.2/envs.ads ================================================ private with Ada.Containers.Hashed_Maps; with Garbage_Collected; with Types.Strings; package Envs is -- This package should be named Env, but Ada does not allow formal -- parameters to be named like a package dependency, and it seems -- that readability inside Eval is more important. type Instance (<>) is abstract new Garbage_Collected.Instance with private; type Link is access Instance; subtype Ptr is not null Link; function New_Env (Outer : in Link := null) return Ptr with Inline; procedure Set_Binds (Env : in out Instance; Binds : in Types.T_Array; Exprs : in Types.T_Array); -- Equivalent to successive calls to Set, except that if Binds -- ends with "&" followed by a symbol, the trailing symbol -- receives all remaining values as a list. function Get (Env : in Instance; Key : in Types.String_Ptr) return Types.T; function Get_Or_Nil (Env : Instance; Key : Types.String_Ptr) return Types.T; procedure Set (Env : in out Instance; Key : in Types.T; New_Item : in Types.T) with Inline; -- Raises an exception if Key is not a symbol. -- Debug. procedure Dump_Stack (Env : in Instance); private package HM is new Ada.Containers.Hashed_Maps (Key_Type => Types.String_Ptr, Element_Type => Types.T, Hash => Types.Strings.Hash, Equivalent_Keys => Types.Strings.Same_Contents, "=" => Types."="); -- It may be tempting to subclass Types.Map, but this would not -- simplify the code much. And adding metadata to a structure that -- is allocated very often has a cost. type Instance is new Garbage_Collected.Instance with record Outer : Link; Data : HM.Map; end record; overriding procedure Keep_References (Object : in out Instance) with Inline; end Envs; ================================================ FILE: impls/ada.2/err.adb ================================================ with Ada.Characters.Latin_1; with Printer; with Types.Strings; package body Err is use Ada.Strings.Unbounded; ---------------------------------------------------------------------- procedure Add_Trace_Line (Action : in String; Ast : in Types.T) is begin Append (Trace, " in "); Append (Trace, Action); Append (Trace, ": "); Printer.Pr_Str (Trace, Ast); Append (Trace, Ada.Characters.Latin_1.LF); end Add_Trace_Line; procedure Check (Condition : in Boolean; Message : in String) is begin if not Condition then Raise_With (Message); end if; end Check; procedure Raise_In_Mal (E : in Ada.Exceptions.Exception_Occurrence) is Message : String renames Ada.Exceptions.Exception_Information (E); procedure Process (S : in String); procedure Process (S : in String) is begin Append (Trace, S); end Process; begin Data := (Types.Kind_String, Types.Strings.Alloc (Message)); Set_Unbounded_String (Trace, "Uncaught exception: "); Data.Str.all.Query_Element (Process'Access); raise Error; end Raise_In_Mal; procedure Raise_With (Message : in String) is begin Data := (Types.Kind_String, Types.Strings.Alloc (Message)); Set_Unbounded_String (Trace, "Uncaught exception: "); Append (Trace, Message); Append (Trace, Ada.Characters.Latin_1.LF); raise Error; end Raise_With; function Throw (Args : in Types.T_Array) return Types.T is begin Check (Args'Length = 1, "expected 1 parameter"); Data := Args (Args'First); Set_Unbounded_String (Trace, "Uncaught exception: "); Printer.Pr_Str (Trace, Data); Append (Trace, Ada.Characters.Latin_1.LF); -- A raise value is equivalent to a raise statement, but -- silents a compiler warning. return raise Error; end Throw; end Err; ================================================ FILE: impls/ada.2/err.ads ================================================ with Ada.Exceptions; with Ada.Strings.Unbounded; with Types; -- We declare a variable of type Types.T. pragma Elaborate (Types); package Err is -- Error handling. -- Built-in function. function Throw (Args : in Types.T_Array) return Types.T; -- Ada exceptions can only carry an immutable String in each -- occurence, so we require a global variable to store the last -- exception as a Mal object anyway, and may as well use it for -- simple string messages. Error : exception; Data : Types.T; Trace : Ada.Strings.Unbounded.Unbounded_String; -- Convenient shortcuts. procedure Raise_With (Message : in String) with No_Return; -- Similar to a "raise with Message" Ada statement. -- Store the message into Data, -- store the message and "Uncaught exception: " into Trace, -- then raise Error. procedure Raise_In_Mal (E : in Ada.Exceptions.Exception_Occurrence) with No_Return; -- Raise_With (Ada.Exceptions.Exception_Information (E)) procedure Add_Trace_Line (Action : in String; Ast : in Types.T); -- Appends a line like "Action: Ast" to Trace. procedure Check (Condition : in Boolean; Message : in String) with Inline; -- Raise_With if Condition fails. -- It is probably more efficient to construct a boolean and call -- this procedure once, as "inline" is only a recommendation. -- Beware of the classical performance issue that the Message is -- formatted even if the Condition does not hold. end Err; ================================================ FILE: impls/ada.2/garbage_collected.adb ================================================ with Ada.Unchecked_Deallocation; package body Garbage_Collected is procedure Free is new Ada.Unchecked_Deallocation (Class, Link); Top : Link := null; ---------------------------------------------------------------------- procedure Clean is Current : Link := Top; Previous : Link; begin while Current /= null and then not Current.all.Kept loop Previous := Current; Current := Current.all.Next; Free (Previous); end loop; Top := Current; while Current /= null loop if Current.all.Kept then Current.all.Kept := False; Previous := Current; else Previous.all.Next := Current.all.Next; Free (Current); end if; Current := Previous.all.Next; end loop; end Clean; procedure Keep (Object : in out Class) is begin if not Object.Kept then Object.Kept := True; Object.Keep_References; -- dispatching end if; end Keep; procedure Check_Allocations is begin pragma Assert (Top = null); end Check_Allocations; procedure Register (Ref : in Pointer) is begin pragma Assert (Ref.all.Kept = False); pragma Assert (Ref.all.Next = null); Ref.all.Next := Top; Top := Ref; end Register; end Garbage_Collected; ================================================ FILE: impls/ada.2/garbage_collected.ads ================================================ package Garbage_Collected is -- A generic would not be convenient for lists. We want the -- extended type to be able to have a discriminant. -- However, we keep the dispatching in a single enumeration for -- efficiency and clarity of the source. type Instance is abstract tagged limited private; subtype Class is Instance'Class; type Link is access all Class; subtype Pointer is not null Link; procedure Keep_References (Object : in out Instance) is null with Inline; -- A dispatching call in Keep allows subclasses to override this -- in order to Keep each of the internal reference they maintain. -- The following methods have no reason to be overridden. procedure Keep (Object : in out Class) with Inline; -- Mark this object so that it is not deleted by next clean, -- then make a dispatching call to Keep_References. -- Does nothing if it has already been called for this object -- since startup or last Clean. procedure Register (Ref : in Pointer) with Inline; -- Each subclass defines its own allocation pool, but every call -- to new must be followed by a call to Register. procedure Clean; -- For each object for which Keep has not been called since -- startup or last clean, make a dispatching call to Finalize, -- then deallocate the memory for the object. -- Debug. procedure Check_Allocations; -- Does nothing if assertions are disabled. private type Instance is abstract tagged limited record Kept : Boolean := False; Next : Link := null; end record; end Garbage_Collected; ================================================ FILE: impls/ada.2/printer.adb ================================================ with Ada.Characters.Latin_1; with Types.Atoms; with Types.Fns; with Types.Maps; pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced"); with Types.Sequences; pragma Warnings (On, "unit ""Types.Sequences"" is not referenced"); package body Printer is use Ada.Strings.Unbounded; use all type Types.Kind_Type; procedure Pr_Str (Buffer : in out Unbounded_String; Ast : in Types.T; Readably : in Boolean := True) is procedure Print_Form (Form_Ast : in Types.T); -- The recursive function traversing Ast for Pr_Str. -- Form_Ast is the current node. -- Helpers for Print_Form. procedure Print_Number (Number : in Integer); procedure Print_List (List : in Types.T_Array); procedure Print_Map (Map : in Types.Maps.Instance); procedure Print_Readably (S : in String); procedure Print_String (S : in String); ---------------------------------------------------------------------- procedure Print_Form (Form_Ast : in Types.T) is begin case Form_Ast.Kind is when Kind_Nil => Append (Buffer, "nil"); when Kind_Boolean => if Form_Ast.Ada_Boolean then Append (Buffer, "true"); else Append (Buffer, "false"); end if; when Kind_Symbol => Form_Ast.Str.all.Query_Element (Print_String'Access); when Kind_Number => Print_Number (Form_Ast.Number); when Kind_Keyword => Append (Buffer, ':'); Form_Ast.Str.all.Query_Element (Print_String'Access); when Kind_String => if Readably then Append (Buffer, '"'); Form_Ast.Str.all.Query_Element (Print_Readably'Access); Append (Buffer, '"'); else Form_Ast.Str.all.Query_Element (Print_String'Access); end if; when Kind_List => Append (Buffer, '('); Print_List (Form_Ast.Sequence.all.Data); Append (Buffer, ')'); when Kind_Vector => Append (Buffer, '['); Print_List (Form_Ast.Sequence.all.Data); Append (Buffer, ']'); when Kind_Map => Append (Buffer, '{'); Print_Map (Form_Ast.Map.all); Append (Buffer, '}'); when Kind_Builtin | Kind_Builtin_With_Meta => Append (Buffer, "#"); when Kind_Fn => Append (Buffer, "# "); Print_Form (Form_Ast.Fn.all.Ast); Append (Buffer, '>'); when Kind_Macro => Append (Buffer, "# "); Print_Form (Form_Ast.Fn.all.Ast); Append (Buffer, '>'); when Kind_Atom => Append (Buffer, "(atom "); Print_Form (Form_Ast.Atom.all.Deref); Append (Buffer, ')'); end case; end Print_Form; procedure Print_List (List : in Types.T_Array) is begin if 0 < List'Length then Print_Form (List (List'First)); for I in List'First + 1 .. List'Last loop Append (Buffer, ' '); Print_Form (List (I)); end loop; end if; end Print_List; procedure Print_Map (Map : in Types.Maps.Instance) is use all type Types.Maps.Cursor; Position : Types.Maps.Cursor := Map.First; begin if Has_Element (Position) then loop Print_Form (Key (Position)); Append (Buffer, ' '); Print_Form (Element (Position)); Next (Position); exit when not Has_Element (Position); Append (Buffer, ' '); end loop; end if; end Print_Map; procedure Print_Number (Number : in Integer) is Image : constant String := Integer'Image (Number); First : Positive := Image'First; begin if Image (First) = ' ' then First := First + 1; end if; Append (Buffer, Image (First .. Image'Last)); end Print_Number; procedure Print_Readably (S : in String) is begin for C of S loop case C is when '"' | '\' => Append (Buffer, '\'); Append (Buffer, C); when Ada.Characters.Latin_1.LF => Append (Buffer, "\n"); when others => Append (Buffer, C); end case; end loop; end Print_Readably; procedure Print_String (S : in String) is begin Append (Buffer, S); end Print_String; ---------------------------------------------------------------------- begin -- Pr_Str Print_Form (Ast); end Pr_Str; function Pr_Str (Ast : in Types.T; Readably : in Boolean := True) return Unbounded_String is begin return Buffer : Unbounded_String do Pr_Str (Buffer, Ast, Readably); end return; end Pr_Str; end Printer; ================================================ FILE: impls/ada.2/printer.ads ================================================ with Ada.Strings.Unbounded; with Types; package Printer is procedure Pr_Str (Buffer : in out Ada.Strings.Unbounded.Unbounded_String; Ast : in Types.T; Readably : in Boolean := True); -- Append the text to Buffer. function Pr_Str (Ast : in Types.T; Readably : in Boolean := True) return Ada.Strings.Unbounded.Unbounded_String; -- Return a freshly created unbounded string. -- Convenient, but inefficient. end Printer; ================================================ FILE: impls/ada.2/reader.adb ================================================ with Ada.Characters.Handling; with Ada.Characters.Latin_1; with Ada.Environment_Variables; with Ada.Strings.Maps.Constants; with Ada.Strings.Unbounded; with Ada.Text_IO.Unbounded_IO; with Err; with Printer; with Types.Maps; with Types.Sequences; with Types.Strings; package body Reader is Debug : constant Boolean := Ada.Environment_Variables.Exists ("dbgread"); use all type Types.Kind_Type; use all type Ada.Strings.Maps.Character_Set; Ignored_Set : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.Constants.Control_Set or To_Set (" ,;"); Symbol_Set : constant Ada.Strings.Maps.Character_Set := not (Ignored_Set or To_Set ("""'()@[]^`{}~")); function Read_Str (Source : in String) return Types.T_Array is I : Positive := Source'First; -- Index in Source of the currently read character. -- Big arrays on the stack are faster than repeated dynamic -- reallocations. This single buffer is used by all Read_List -- recursive invocations, and by Read_Str. Buffer : Types.T_Array (1 .. Source'Length); B_Last : Natural := Buffer'First - 1; -- Index in Buffer of the currently written MAL expression. function Read_Form return Types.T; -- The recursive part of Read_Str. -- Helpers for Read_Form: procedure Skip_Ignored; -- Check if the current character is ignorable or a comment. -- Increment I until it exceeds Source'Last or designates -- an interesting character. procedure Skip_Digits with Inline; -- Increment I at least once, until I exceeds Source'Last or -- designates something else than a decimal digit. procedure Skip_Symbol with Inline; -- Check if the current character is allowed in a symbol name. -- Increment I until it exceeds Source'Last or stops -- designating an allowed character. -- Read_Atom has been merged into the same case/switch -- statement, for clarity and efficiency. function Read_List (Ending : in Character) return Natural; -- Returns the index of the last elements in Buffer. -- The elements have been stored in Buffer (B_Last .. result). function Read_Quote (Symbol : in String) return Types.T; function Read_String return Types.T; function Read_With_Meta return Types.T; ---------------------------------------------------------------------- function Read_List (Ending : in Character) return Natural is Opening : constant Character := Source (I); Old : constant Natural := B_Last; Result : Positive; begin I := I + 1; -- Skip (, [ or {. loop Skip_Ignored; Err.Check (I <= Source'Last, "unbalanced '" & Opening & "'"); exit when Source (I) = Ending; B_Last := B_Last + 1; Buffer (B_Last) := Read_Form; end loop; I := I + 1; -- Skip ), ] or }. Result := B_Last; B_Last := Old; return Result; end Read_List; function Read_Quote (Symbol : in String) return Types.T is R : constant Types.Sequence_Ptr := Types.Sequences.Constructor (2); begin I := I + 1; -- Skip the initial ' or similar. R.all.Data (1) := (Kind_Symbol, Types.Strings.Alloc (Symbol)); Skip_Ignored; Err.Check (I <= Source'Last, "Incomplete '" & Symbol & "'"); R.all.Data (2) := Read_Form; return (Kind_List, R); end Read_Quote; function Read_Form return Types.T is -- After I has been increased, current token is be -- Source (F .. I - 1). F : Positive; R : Types.T; -- The result of this function. begin case Source (I) is when ')' | ']' | '}' => Err.Raise_With ("unbalanced '" & Source (I) & "'"); when '"' => R := Read_String; when ':' => I := I + 1; F := I; Skip_Symbol; R := (Kind_Keyword, Types.Strings.Alloc (Source (F .. I - 1))); when '-' => F := I; Skip_Digits; if F + 1 < I then R := (Kind_Number, Integer'Value (Source (F .. I - 1))); else Skip_Symbol; R := (Kind_Symbol, Types.Strings.Alloc (Source (F .. I - 1))); end if; when '~' => if I < Source'Last and then Source (I + 1) = '@' then I := I + 1; R := Read_Quote ("splice-unquote"); else R := Read_Quote ("unquote"); end if; when '0' .. '9' => F := I; Skip_Digits; R := (Kind_Number, Integer'Value (Source (F .. I - 1))); when ''' => R := Read_Quote ("quote"); when '`' => R := Read_Quote ("quasiquote"); when '@' => R := Read_Quote ("deref"); when '^' => R := Read_With_Meta; when '(' => R := Types.Sequences.List (Buffer (B_Last + 1 .. Read_List (')'))); when '[' => R := Types.Sequences.Vector (Buffer (B_Last + 1 .. Read_List (']'))); when '{' => R := Types.Maps.Hash_Map (Buffer (B_Last + 1 .. Read_List ('}'))); when others => F := I; Skip_Symbol; if Source (F .. I - 1) = "false" then R := (Kind_Boolean, False); elsif Source (F .. I - 1) = "nil" then R := Types.Nil; elsif Source (F .. I - 1) = "true" then R := (Kind_Boolean, True); else R := (Kind_Symbol, Types.Strings.Alloc (Source (F .. I - 1))); end if; end case; if Debug then Ada.Text_IO.Put ("reader: "); Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (R)); end if; return R; end Read_Form; function Read_String return Types.T is use Ada.Strings.Unbounded; Result : Unbounded_String; begin loop I := I + 1; Err.Check (I <= Source'Last, "unbalanced '""'"); case Source (I) is when '"' => exit; when '\' => I := I + 1; Err.Check (I <= Source'Last, "unbalanced '""'"); case Source (I) is when '\' | '"' => Append (Result, Source (I)); when 'n' => Append (Result, Ada.Characters.Latin_1.LF); when others => Append (Result, Source (I - 1 .. I)); end case; when others => Append (Result, Source (I)); end case; end loop; I := I + 1; -- Skip closing double quote. return (Kind_String, Types.Strings.Alloc (To_String (Result))); end Read_String; function Read_With_Meta return Types.T is List : constant Types.Sequence_Ptr := Types.Sequences.Constructor (3); begin I := I + 1; -- Skip the initial ^. List.all.Data (1) := (Kind_Symbol, Types.Strings.Alloc ("with-meta")); for I in reverse 2 .. 3 loop Skip_Ignored; Err.Check (I <= Source'Last, "Incomplete 'with-meta'"); List.all.Data (I) := Read_Form; end loop; return (Kind_List, List); end Read_With_Meta; procedure Skip_Digits is use Ada.Characters.Handling; begin loop I := I + 1; exit when Source'Last < I; exit when not Is_Digit (Source (I)); end loop; end Skip_Digits; procedure Skip_Ignored is use Ada.Characters.Handling; begin Ignored : while I <= Source'Last and then Is_In (Source (I), Ignored_Set) loop if Source (I) = ';' then Comment : loop I := I + 1; exit Ignored when Source'Last < I; exit Comment when Is_Line_Terminator (Source (I)); end loop Comment; end if; I := I + 1; end loop Ignored; end Skip_Ignored; procedure Skip_Symbol is begin while I <= Source'Last and then Is_In (Source (I), Symbol_Set) loop I := I + 1; end loop; end Skip_Symbol; ---------------------------------------------------------------------- begin -- Read_Str loop Skip_Ignored; exit when Source'Last < I; B_Last := B_Last + 1; Buffer (B_Last) := Read_Form; end loop; return Buffer (Buffer'First .. B_Last); end Read_Str; end Reader; ================================================ FILE: impls/ada.2/reader.ads ================================================ with Types; package Reader is function Read_Str (Source : in String) return Types.T_Array; -- The language does not explicitly define what happens when the -- input string contains more than one expression. -- This implementation returns all of them. end Reader; ================================================ FILE: impls/ada.2/readline.adb ================================================ with Interfaces.C.Strings; package body Readline is function Input (Prompt : in String) return String is use Interfaces.C; use Interfaces.C.Strings; function C_Readline (Prompt : in char_array) return chars_ptr with Import, Convention => C, External_Name => "readline"; procedure Add_History (Line : in chars_ptr) with Import, Convention => C, External_Name => "add_history"; procedure Free (Line : in chars_ptr) with Import, Convention => C, External_Name => "free"; C_Line : constant chars_ptr := C_Readline (To_C (Prompt)); begin if C_Line = Null_Ptr then raise End_Of_File; end if; return Ada_Line : constant String := Value (C_Line) do if Ada_Line /= "" then Add_History (C_Line); end if; Free (C_Line); end return; end Input; end Readline; ================================================ FILE: impls/ada.2/readline.ads ================================================ package Readline is function Input (Prompt : in String) return String; End_Of_File : exception; end Readline; ================================================ FILE: impls/ada.2/run ================================================ #!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/ada.2/step0_repl.adb ================================================ with Ada.Text_IO; with Readline; procedure Step0_Repl is function Read return String with Inline; function Eval (Ast : in String) return String; procedure Print (Ast : in String) with Inline; procedure Rep with Inline; ---------------------------------------------------------------------- function Eval (Ast : in String) return String is (Ast); procedure Print (Ast : in String) is begin Ada.Text_IO.Put_Line (Ast); end Print; function Read return String is (Readline.Input ("user> ")); procedure Rep is begin Print (Eval (Read)); end Rep; ---------------------------------------------------------------------- begin loop begin Rep; exception when Readline.End_Of_File => exit; end; -- Other exceptions are really unexpected. end loop; Ada.Text_IO.New_Line; end Step0_Repl; ================================================ FILE: impls/ada.2/step1_read_print.adb ================================================ with Ada.Text_IO.Unbounded_IO; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types; procedure Step1_Read_Print is function Read return Types.T_Array with Inline; function Eval (Ast : in Types.T) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep with Inline; ---------------------------------------------------------------------- function Eval (Ast : in Types.T) return Types.T is (Ast); procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep is begin for Expression of Read loop Print (Eval (Expression)); end loop; end Rep; ---------------------------------------------------------------------- begin loop begin Rep; exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; -- No data survives at this stage, Repl only contains static -- pointers to built-in functions. Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step1_Read_Print; ================================================ FILE: impls/ada.2/step2_eval.adb ================================================ with Ada.Containers.Indefinite_Hashed_Maps; with Ada.Strings.Hash; with Ada.Text_IO.Unbounded_IO; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step2_Eval is use type Types.T; use all type Types.Kind_Type; package Envs is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => String, Element_Type => Types.Builtin_Ptr, Hash => Ada.Strings.Hash, Equivalent_Keys => "=", "=" => Types."="); function Read return Types.T_Array with Inline; function Eval (Ast : in Types.T; Env : in Envs.Map) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Map) with Inline; generic with function Ada_Operator (Left, Right : in Integer) return Integer; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Map) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Map) return Types.T; -- Helpers for the Eval function. ---------------------------------------------------------------------- function Eval (Ast : in Types.T; Env : in Envs.Map) return Types.T is First : Types.T; begin -- Ada.Text_IO.Put ("EVAL: "); -- Print (Ast); case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => declare S : constant String := Ast.Str.all.To_String; C : constant Envs.Cursor := Env.Find (S); begin -- The predefined error message does not pass tests. Err.Check (Envs.Has_Element (C), "'" & S & "' not found"); return (Kind_Builtin, Envs.Element (C)); end; when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Ast is a non-empty list, First is its first element. First := Eval (First, Env); -- Apply phase. -- Ast is a non-empty list, -- First is its evaluated first element. Err.Check (First.Kind = Kind_Builtin, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; return First.Builtin.all (Args); end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Map) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Map) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T is (Kind_Number, Ada_Operator (Args (Args'First).Number, Args (Args'Last).Number)); procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Map) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- function Addition is new Generic_Mal_Operator ("+"); function Subtraction is new Generic_Mal_Operator ("-"); function Product is new Generic_Mal_Operator ("*"); function Division is new Generic_Mal_Operator ("/"); Repl : Envs.Map; begin Repl.Insert ("+", Addition 'Unrestricted_Access); Repl.Insert ("-", Subtraction'Unrestricted_Access); Repl.Insert ("*", Product 'Unrestricted_Access); Repl.Insert ("/", Division 'Unrestricted_Access); loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; -- No data survives at this stage, Repl only contains static -- pointers to built-in functions. Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step2_Eval; ================================================ FILE: impls/ada.2/step3_env.adb ================================================ with Ada.Text_IO.Unbounded_IO; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step3_Env is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; function Read return Types.T_Array with Inline; function Eval (Ast : in Types.T; Env : in Envs.Ptr) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; generic with function Ada_Operator (Left, Right : in Integer) return Integer; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. ---------------------------------------------------------------------- function Eval (Ast : in Types.T; Env : in Envs.Ptr) return Types.T is First : Types.T; begin if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env); begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); for I in 0 .. Bindings'Length / 2 - 1 loop New_Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), New_Env)); -- This call checks key kind. end loop; return Eval (Ast.Sequence.all.Data (3), New_Env); end; elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; else First := Eval (First, Env); end if; when others => First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. Err.Check (First.Kind = Kind_Builtin, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; return First.Builtin.all (Args); end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; function Generic_Mal_Operator (Args : in Types.T_Array) return Types.T is (Kind_Number, Ada_Operator (Args (Args'First).Number, Args (Args'Last).Number)); procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- function Addition is new Generic_Mal_Operator ("+"); function Subtraction is new Generic_Mal_Operator ("-"); function Product is new Generic_Mal_Operator ("*"); function Division is new Generic_Mal_Operator ("/"); Repl : constant Envs.Ptr := Envs.New_Env; begin -- Add Core functions into the top environment. Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("+")), (Kind_Builtin, Addition 'Unrestricted_Access)); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("-")), (Kind_Builtin, Subtraction'Unrestricted_Access)); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*")), (Kind_Builtin, Product 'Unrestricted_Access)); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("/")), (Kind_Builtin, Division 'Unrestricted_Access)); -- Execute user commands. loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step3_Env; ================================================ FILE: impls/ada.2/step4_if_fn_do.adb ================================================ with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step4_If_Fn_Do is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; function Read return Types.T_Array with Inline; function Eval (Ast : in Types.T; Env : in Envs.Ptr) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast : in Types.T; Env : in Envs.Ptr) return Types.T is First : Types.T; begin if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then return Eval (Ast.Sequence.all.Data (3), Env); elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else return Eval (Ast.Sequence.all.Data (4), Env); end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env); begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); for I in 0 .. Bindings'Length / 2 - 1 loop New_Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), New_Env)); -- This call checks key kind. end loop; return Eval (Ast.Sequence.all.Data (3), New_Env); end; elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; return Result; end; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; else First := Eval (First, Env); end if; when others => First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. Err.Check (First.Kind in Types.Kind_Function, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; return First.Fn.all.Apply (Args); end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))"; Repl : constant Envs.Ptr := Envs.New_Env; begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); -- Native startup procedure. Exec (Startup, Repl); -- Execute user commands. loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step4_If_Fn_Do; ================================================ FILE: impls/ada.2/step5_tco.adb ================================================ with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step5_Tco is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. Err.Check (First.Kind in Types.Kind_Function, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))"; Repl : constant Envs.Ptr := Envs.New_Env; begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); -- Native startup procedure. Exec (Startup, Repl); -- Execute user commands. loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step5_Tco; ================================================ FILE: impls/ada.2/step6_file.adb ================================================ with Ada.Command_Line; with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step6_File is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; function Eval_Builtin (Args : in Types.T_Array) return Types.T; -- The built-in variant needs to see the Repl variable. procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. Err.Check (First.Kind in Types.Kind_Function, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))" & "(def! load-file (fn* (f)" & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"; Repl : constant Envs.Ptr := Envs.New_Env; function Eval_Builtin (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return Eval (Args (Args'First), Repl); end Eval_Builtin; Script : constant Boolean := 0 < ACL.Argument_Count; Argv : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); -- Native startup procedure. Exec (Startup, Repl); -- Define ARGV from command line arguments. for I in 2 .. ACL.Argument_Count loop Argv.all.Data (I - 1) := (Kind_String, Types.Strings.Alloc (ACL.Argument (I))); end loop; Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), (Kind_List, Argv)); -- Execute user commands. if Script then Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); else loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; end if; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step6_File; ================================================ FILE: impls/ada.2/step7_quote.adb ================================================ with Ada.Command_Line; with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step7_Quote is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; 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) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "quote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); 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. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. Err.Check (First.Kind in Types.Kind_Function, "first element must be a function"); -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Quasiquote (Ast : in Types.T) return Types.T is function Qq_Seq return Types.T; function Starts_With (Sequence : Types.T_Array; Symbol : String) return Boolean; function Qq_Seq return Types.T is Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin 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"); Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("concat")), Elt.Sequence.all.Data (2), Result)); else Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("cons")), Quasiquote (Elt), Result)); end if; end loop; return Result; end Qq_Seq; 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_List => if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); else 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; exception when Err.Error => Err.Add_Trace_Line ("quasiquote", Ast); raise; end Quasiquote; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))" & "(def! load-file (fn* (f)" & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"; Repl : constant Envs.Ptr := Envs.New_Env; function Eval_Builtin (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return Eval (Args (Args'First), Repl); end Eval_Builtin; Script : constant Boolean := 0 < ACL.Argument_Count; Argv : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); -- Native startup procedure. Exec (Startup, Repl); -- Define ARGV from command line arguments. for I in 2 .. ACL.Argument_Count loop Argv.all.Data (I - 1) := (Kind_String, Types.Strings.Alloc (ACL.Argument (I))); end loop; Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), (Kind_List, Argv)); -- Execute user commands. if Script then Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); else loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; end if; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step7_Quote; ================================================ FILE: impls/ada.2/step8_macros.adb ================================================ with Ada.Command_Line; with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step8_Macros is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; 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) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "quote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "defmacro!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); Val : Types.T; begin Err.Check (Fun.Kind = Kind_Fn, "expected a function"); Val := (Kind_Macro, Types.Fns.New_Function (Params => Fun.Fn.all.Params, Ast => Fun.Fn.all.Ast, Env => Fun.Fn.all.Env)); Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); 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. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. Ast := First.Fn.all.Apply (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); -- Then evaluate the result with TCO. goto Restart; when Types.Kind_Function => null; when others => Err.Raise_With ("first element must be a function or macro"); end case; -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Quasiquote (Ast : in Types.T) return Types.T is function Qq_Seq return Types.T; function Starts_With (Sequence : Types.T_Array; Symbol : String) return Boolean; function Qq_Seq return Types.T is Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin 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"); Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("concat")), Elt.Sequence.all.Data (2), Result)); else Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("cons")), Quasiquote (Elt), Result)); end if; end loop; return Result; end Qq_Seq; 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_List => if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); else 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; exception when Err.Error => Err.Add_Trace_Line ("quasiquote", Ast); raise; end Quasiquote; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))" & "(def! load-file (fn* (f)" & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" & "(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)))))))"; Repl : constant Envs.Ptr := Envs.New_Env; function Eval_Builtin (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return Eval (Args (Args'First), Repl); end Eval_Builtin; Script : constant Boolean := 0 < ACL.Argument_Count; Argv : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); -- Native startup procedure. Exec (Startup, Repl); -- Define ARGV from command line arguments. for I in 2 .. ACL.Argument_Count loop Argv.all.Data (I - 1) := (Kind_String, Types.Strings.Alloc (ACL.Argument (I))); end loop; Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), (Kind_List, Argv)); -- Execute user commands. if Script then Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); else loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; end if; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step8_Macros; ================================================ FILE: impls/ada.2/step9_try.adb ================================================ with Ada.Command_Line; with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure Step9_Try is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; 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) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "quote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "defmacro!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); Val : Types.T; begin Err.Check (Fun.Kind = Kind_Fn, "expected a function"); Val := (Kind_Macro, Types.Fns.New_Function (Params => Fun.Fn.all.Params, Ast => Fun.Fn.all.Ast, Env => Fun.Fn.all.Env)); Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); 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); goto Restart; end if; Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (3).Kind = Kind_List, "expected 1 parameter, maybe followed by a list"); declare A3 : Types.T_Array renames Ast.Sequence.all.Data (3).Sequence.all.Data; begin Err.Check (A3'Length = 3 and then A3 (A3'First).Kind = Kind_Symbol and then A3 (A3'First).Str.all = "catch*", "3rd parameter if present must be a catch* list"); begin return Eval (Ast.Sequence.all.Data (2), Env); exception when Err.Error => null; end; Env := Envs.New_Env (Outer => Env); Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind Ast := A3 (A3'Last); goto Restart; end; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. Ast := First.Fn.all.Apply (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); -- Then evaluate the result with TCO. goto Restart; when Types.Kind_Function => null; when others => Err.Raise_With ("first element must be a function or macro"); end case; -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; if First.Kind = Kind_Builtin then return First.Builtin.all (Args); end if; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Quasiquote (Ast : in Types.T) return Types.T is function Qq_Seq return Types.T; function Starts_With (Sequence : Types.T_Array; Symbol : String) return Boolean; function Qq_Seq return Types.T is Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin 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"); Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("concat")), Elt.Sequence.all.Data (2), Result)); else Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("cons")), Quasiquote (Elt), Result)); end if; end loop; return Result; end Qq_Seq; 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_List => if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); else 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; exception when Err.Error => Err.Add_Trace_Line ("quasiquote", Ast); raise; end Quasiquote; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))" & "(def! load-file (fn* (f)" & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" & "(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)))))))"; Repl : constant Envs.Ptr := Envs.New_Env; function Eval_Builtin (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return Eval (Args (Args'First), Repl); end Eval_Builtin; Script : constant Boolean := 0 < ACL.Argument_Count; Argv : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); -- Native startup procedure. Exec (Startup, Repl); -- Define ARGV from command line arguments. for I in 2 .. ACL.Argument_Count loop Argv.all.Data (I - 1) := (Kind_String, Types.Strings.Alloc (ACL.Argument (I))); end loop; Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), (Kind_List, Argv)); -- Execute user commands. if Script then Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); else loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; end if; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end Step9_Try; ================================================ FILE: impls/ada.2/stepa_mal.adb ================================================ with Ada.Command_Line; with Ada.Text_IO.Unbounded_IO; with Core; with Envs; with Err; with Garbage_Collected; with Printer; with Reader; with Readline; with Types.Builtins; with Types.Fns; with Types.Maps; with Types.Sequences; with Types.Strings; procedure StepA_Mal is Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; function Read return Types.T_Array with Inline; function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T; 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) return Types.T; procedure Print (Ast : in Types.T) with Inline; procedure Rep (Env : in Envs.Ptr) with Inline; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T; -- Helpers for the Eval function. procedure Exec (Script : in String; Env : in Envs.Ptr) with Inline; -- Read the script, eval its elements, but ignore the result. ---------------------------------------------------------------------- function Eval (Ast0 : in Types.T; Env0 : in Envs.Ptr) return Types.T is -- Use local variables, that can be rewritten when tail call -- optimization goes to <>. Ast : Types.T := Ast0; Env : Envs.Ptr := Env0; First : Types.T; begin <> if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); end if; case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => return Ast; when Kind_Symbol => return Env.all.Get (Ast.Str); when Kind_Map => return Eval_Map (Ast.Map.all, Env); when Kind_Vector => return Eval_Vector (Ast.Sequence.all, Env); when Kind_List => null; end case; -- Ast is a list. if Ast.Sequence.all.Length = 0 then return Ast; end if; First := Ast.Sequence.all.Data (1); -- Special forms -- Ast is a non-empty list, First is its first element. case First.Kind is when Kind_Symbol => if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then Ast := Ast.Sequence.all.Data (3); goto Restart; elsif Ast.Sequence.all.Length = 3 then return Types.Nil; else Ast := Ast.Sequence.all.Data (4); goto Restart; end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, "expected a sequence then a value"); declare Bindings : Types.T_Array renames Ast.Sequence.all.Data (2).Sequence.all.Data; begin Err.Check (Bindings'Length mod 2 = 0, "expected even binds"); Env := Envs.New_Env (Outer => Env); for I in 0 .. Bindings'Length / 2 - 1 loop Env.all.Set (Bindings (Bindings'First + 2 * I), Eval (Bindings (Bindings'First + 2 * I + 1), Env)); -- This call checks key kind. end loop; Ast := Ast.Sequence.all.Data (3); goto Restart; end; elsif First.Str.all = "quote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); elsif First.Str.all = "def!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Val : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); begin Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "defmacro!" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Key : Types.T renames Ast.Sequence.all.Data (2); Fun : constant Types.T := Eval (Ast.Sequence.all.Data (3), Env); Val : Types.T; begin Err.Check (Fun.Kind = Kind_Fn, "expected a function"); Val := (Kind_Macro, Types.Fns.New_Function (Params => Fun.Fn.all.Params, Ast => Fun.Fn.all.Ast, Env => Fun.Fn.all.Env)); Env.all.Set (Key, Val); -- Check key kind. return Val; end; elsif First.Str.all = "do" then Err.Check (1 < Ast.Sequence.all.Length, "do expects arguments"); declare Result : Types.T; begin for I in 2 .. Ast.Sequence.all.Length - 1 loop Result := Eval (Ast.Sequence.all.Data (I), Env); end loop; pragma Unreferenced (Result); end; Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length); goto Restart; elsif First.Str.all = "fn*" then Err.Check (Ast.Sequence.all.Length = 3, "expected 2 parameters"); declare Params : Types.T renames Ast.Sequence.all.Data (2); begin Err.Check (Params.Kind in Types.Kind_Sequence, "first argument of fn* must be a sequence"); return (Kind_Fn, Types.Fns.New_Function (Params => Params.Sequence, Ast => Ast.Sequence.all.Data (3), Env => Env)); end; elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); 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); goto Restart; end if; Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (3).Kind = Kind_List, "expected 1 parameter, maybe followed by a list"); declare A3 : Types.T_Array renames Ast.Sequence.all.Data (3).Sequence.all.Data; begin Err.Check (A3'Length = 3 and then A3 (A3'First).Kind = Kind_Symbol and then A3 (A3'First).Str.all = "catch*", "3rd parameter if present must be a catch* list"); begin return Eval (Ast.Sequence.all.Data (2), Env); exception when Err.Error => null; end; Env := Envs.New_Env (Outer => Env); Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind Ast := A3 (A3'Last); goto Restart; end; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. First := Env.all.Get (First.Str); end if; when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. null; when Types.Kind_Sequence | Kind_Map => -- Lists are definitely worth a recursion, and the two other -- cases should be rare (they will report an error later). First := Eval (First, Env); end case; -- Apply phase. -- Ast is a non-empty list, -- First is its non-special evaluated first element. case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. Ast := First.Fn.all.Apply (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); -- Then evaluate the result with TCO. goto Restart; when Types.Kind_Function => null; when others => Err.Raise_With ("first element must be a function or macro"); end case; -- We are applying a function. Evaluate its arguments. declare Args : Types.T_Array (2 .. Ast.Sequence.all.Length); begin for I in Args'Range loop Args (I) := Eval (Ast.Sequence.all.Data (I), Env); end loop; case First.Kind is when Kind_Builtin => return First.Builtin.all (Args); when Kind_Builtin_With_Meta => return First.Builtin_With_Meta.all.Builtin.all (Args); when others => null; end case; -- Like Types.Fns.Apply, except that we use TCO. Env := Envs.New_Env (Outer => First.Fn.all.Env); Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data, Exprs => Args); Ast := First.Fn.all.Ast; goto Restart; end; exception when Err.Error => Err.Add_Trace_Line ("eval", Ast); raise; end Eval; function Eval_Map (Source : in Types.Maps.Instance; Env : in Envs.Ptr) return Types.T is use all type Types.Maps.Cursor; -- Copy the whole map so that keys are not hashed again. Result : constant Types.T := Types.Maps.New_Map (Source); Position : Types.Maps.Cursor := Result.Map.all.First; begin while Has_Element (Position) loop Result.Map.all.Replace_Element (Position, Eval (Element (Position), Env)); Next (Position); end loop; return Result; end Eval_Map; function Eval_Vector (Source : in Types.Sequences.Instance; Env : in Envs.Ptr) return Types.T is Ref : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Source.Length); begin for I in Source.Data'Range loop Ref.all.Data (I) := Eval (Source.Data (I), Env); end loop; return (Kind_Vector, Ref); end Eval_Vector; procedure Exec (Script : in String; Env : in Envs.Ptr) is Result : Types.T; begin for Expression of Reader.Read_Str (Script) loop Result := Eval (Expression, Env); end loop; pragma Unreferenced (Result); end Exec; procedure Print (Ast : in Types.T) is begin Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; function Quasiquote (Ast : in Types.T) return Types.T is function Qq_Seq return Types.T; function Starts_With (Sequence : Types.T_Array; Symbol : String) return Boolean; function Qq_Seq return Types.T is Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin 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"); Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("concat")), Elt.Sequence.all.Data (2), Result)); else Result := Types.Sequences.List (((Kind_Symbol, Types.Strings.Alloc ("cons")), Quasiquote (Elt), Result)); end if; end loop; return Result; end Qq_Seq; 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_List => if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); return Ast.Sequence.all.Data (2); else 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; exception when Err.Error => Err.Add_Trace_Line ("quasiquote", Ast); raise; end Quasiquote; function Read return Types.T_Array is (Reader.Read_Str (Readline.Input ("user> "))); procedure Rep (Env : in Envs.Ptr) is begin for Expression of Read loop Print (Eval (Expression, Env)); end loop; end Rep; ---------------------------------------------------------------------- Startup : constant String := "(def! not (fn* (a) (if a false true)))" & "(def! load-file (fn* (f)" & " (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" & "(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)))))))" & "(def! *host-language* ""ada.2"")"; Repl : constant Envs.Ptr := Envs.New_Env; function Eval_Builtin (Args : in Types.T_Array) return Types.T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); return Eval (Args (Args'First), Repl); end Eval_Builtin; Script : constant Boolean := 0 < ACL.Argument_Count; Argv : constant Types.Sequence_Ptr := Types.Sequences.Constructor (Integer'Max (0, ACL.Argument_Count - 1)); begin -- Show the Eval function to other packages. Types.Fns.Eval_Cb := Eval'Unrestricted_Access; -- Add Core functions into the top environment. Core.NS_Add_To_Repl (Repl); Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("eval")), (Kind_Builtin, Eval_Builtin'Unrestricted_Access)); -- Native startup procedure. Exec (Startup, Repl); -- Define ARGV from command line arguments. for I in 2 .. ACL.Argument_Count loop Argv.all.Data (I - 1) := (Kind_String, Types.Strings.Alloc (ACL.Argument (I))); end loop; Repl.all.Set ((Kind_Symbol, Types.Strings.Alloc ("*ARGV*")), (Kind_List, Argv)); -- Execute user commands. if Script then Exec ("(load-file """ & ACL.Argument (1) & """)", Repl); else Exec ("(println (str ""Mal ["" *host-language* ""]""))", Repl); loop begin Rep (Repl); exception when Readline.End_Of_File => exit; when Err.Error => Ada.Text_IO.Unbounded_IO.Put (Err.Trace); end; -- Other exceptions are really unexpected. -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; end if; -- If assertions are enabled, check deallocations. -- Normal runs do not need to deallocate before termination. -- Beware that all pointers are now dangling. pragma Debug (Garbage_Collected.Clean); Garbage_Collected.Check_Allocations; end StepA_Mal; ================================================ FILE: impls/ada.2/types-atoms.adb ================================================ with Err; with Types.Builtins; with Types.Fns; package body Types.Atoms is function Atom (Args : in T_Array) return T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); declare Ref : constant Atom_Ptr := new Instance; begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); Ref.all.Data := Args (Args'First); return (Kind_Atom, Ref); end; end Atom; function Deref (Args : in T_Array) return T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Atom, "expected an atom"); return Args (Args'First).Atom.all.Data; end Deref; function Deref (Item : in Instance) return T is (Item.Data); procedure Keep_References (Object : in out Instance) is begin Keep (Object.Data); end Keep_References; function Reset (Args : in T_Array) return T is begin Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom, "expected an atom then a value"); Args (Args'First).Atom.all.Data := Args (Args'Last); return Args (Args'Last); end Reset; function Swap (Args : in T_Array) return T is begin Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom, "expected an atom, a function, then optional arguments"); declare X : T renames Args (Args'First).Atom.all.Data; F : T renames Args (Args'First + 1); A : constant T_Array := X & Args (Args'First + 2 .. Args'Last); begin case F.Kind is when Kind_Builtin => X := F.Builtin.all (A); when Kind_Builtin_With_Meta => X := F.Builtin_With_Meta.all.Builtin.all (A); when Kind_Fn => X := F.Fn.all.Apply (A); when others => Err.Raise_With ("parameter 2 must be a function"); end case; return X; end; end Swap; end Types.Atoms; ================================================ FILE: impls/ada.2/types-atoms.ads ================================================ with Garbage_Collected; package Types.Atoms is type Instance (<>) is abstract new Garbage_Collected.Instance with private; -- Built-in functions. function Atom (Args : in T_Array) return T; function Deref (Args : in T_Array) return T; function Reset (Args : in T_Array) return T; function Swap (Args : in T_Array) return T; -- Helper for print. function Deref (Item : in Instance) return T with Inline; private type Instance is new Garbage_Collected.Instance with record Data : T; end record; overriding procedure Keep_References (Object : in out Instance) with Inline; end Types.Atoms; ================================================ FILE: impls/ada.2/types-builtins.adb ================================================ package body Types.Builtins is function Builtin (Item : in Instance) return Builtin_Ptr is (Item.F_Builtin); procedure Keep_References (Object : in out Instance) is begin Keep (Object.F_Meta); end Keep_References; function Meta (Item : in Instance) return T is (Item.F_Meta); function With_Meta (Builtin : in Builtin_Ptr; Metadata : in T) return T is -- Builtin is not null and requires an immediate initialization. Ref : constant Builtin_With_Meta_Ptr := new Instance'(Garbage_Collected.Instance with F_Builtin => Builtin, F_Meta => Metadata); begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); return (Kind_Builtin_With_Meta, Ref); end With_Meta; function With_Meta (Builtin : in Instance; Metadata : in T) return T is (With_Meta (Builtin.F_Builtin, Metadata)); end Types.Builtins; ================================================ FILE: impls/ada.2/types-builtins.ads ================================================ with Garbage_Collected; package Types.Builtins is -- Types.Mal.Builtin_Ptr is efficient and sufficient for most -- purposes, as native function need no deallocation. The type -- below is only useful to add metadata to a built-in. type Instance (<>) is abstract new Garbage_Collected.Instance with private; function With_Meta (Builtin : in Builtin_Ptr; Metadata : in T) return T with Inline; function With_Meta (Builtin : in Instance; Metadata : in T) return T with Inline; function Meta (Item : in Instance) return T with Inline; function Builtin (Item : in Instance) return Builtin_Ptr with Inline; private type Instance is new Garbage_Collected.Instance with record F_Builtin : Builtin_Ptr; F_Meta : T; end record; overriding procedure Keep_References (Object : in out Instance) with Inline; end Types.Builtins; ================================================ FILE: impls/ada.2/types-fns.adb ================================================ with Err; pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced"); with Types.Sequences; pragma Warnings (On, "unit ""Types.Sequences"" is not referenced"); package body Types.Fns is function Apply (Item : in Instance; Args : in T_Array) return T is Env : constant Envs.Ptr := Envs.New_Env (Outer => Item.F_Env); begin Env.all.Set_Binds (Binds => Item.F_Params.all.Data, Exprs => Args); return Eval_Cb.all (Ast => Item.F_Ast, Env => Env); end Apply; function Ast (Item : in Instance) return T is (Item.F_Ast); function Env (Item : in Instance) return Envs.Ptr is (Item.F_Env); procedure Keep_References (Object : in out Instance) is begin Keep (Object.F_Ast); Object.F_Params.all.Keep; Object.F_Env.all.Keep; Keep (Object.F_Meta); end Keep_References; function Meta (Item : in Instance) return T is (Item.F_Meta); function New_Function (Params : in Sequence_Ptr; Ast : in T; Env : in Envs.Ptr; Metadata : in T := Nil) return Fn_Ptr is -- Env and Params are not null and require an immediate -- initialization. Ref : constant Fn_Ptr := new Instance'(Garbage_Collected.Instance with F_Ast => Ast, F_Env => Env, F_Meta => Metadata, F_Params => Params); begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); Err.Check ((for all P of Params.all.Data => P.Kind = Kind_Symbol), "formal parameters must be symbols"); return Ref; end New_Function; function Params (Item : in Instance) return Sequence_Ptr is (Item.F_Params); end Types.Fns; ================================================ FILE: impls/ada.2/types-fns.ads ================================================ with Envs; with Garbage_Collected; package Types.Fns is Eval_Cb : access function (Ast : in T; Env : in Envs.Ptr) return T; -- The main program must register this global callback to the main -- eval function before Apply is called. type Instance (<>) is abstract new Garbage_Collected.Instance with private; function New_Function (Params : in Sequence_Ptr; Ast : in T; Env : in Envs.Ptr; Metadata : in T := Nil) return Fn_Ptr with Inline; -- Raise an exception if Params contains something else than symbols. function Params (Item : in Instance) return Sequence_Ptr with Inline; function Ast (Item : in Instance) return T with Inline; -- Useful to print. function Apply (Item : in Instance; Args : in T_Array) return T with Inline; -- Duplicated in the step files because of TCO. function Env (Item : in Instance) return Envs.Ptr with Inline; -- Required for TCO, instead of Apply. function Meta (Item : in Instance) return T with Inline; private type Instance is new Garbage_Collected.Instance with record F_Ast : T; F_Env : Envs.Ptr; F_Meta : T; F_Params : Sequence_Ptr; end record; overriding procedure Keep_References (Object : in out Instance) with Inline; end Types.Fns; ================================================ FILE: impls/ada.2/types-maps.adb ================================================ with Err; with Types.Sequences; with Types.Strings; package body Types.Maps is use type HM.Map; function Assoc (Initial : in HM.Map; Bind : in T_Array) return T; function Constructor return Map_Ptr with Inline; ---------------------------------------------------------------------- function "=" (Left, Right : in Instance) return Boolean is (Left.Data = Right.Data); function Assoc (Initial : in HM.Map; Bind : in T_Array) return T is begin Err.Check (Bind'Length mod 2 = 0, "expected an even bind count"); declare Len : constant Natural := Bind'Length / 2; Ref : constant Map_Ptr := Constructor; begin Ref.all.Data := Initial; for I in 0 .. Len - 1 loop Ref.all.Data.Include (Bind (Bind'First + 2 * I), Bind (Bind'First + 2 * I + 1)); end loop; return (Kind_Map, Ref); end; end Assoc; function Assoc (Args : in T_Array) return T is begin Err.Check (0 < Args'Length and then Args (Args'First).Kind = Kind_Map, "first parameter must be a map"); return Assoc (Args (Args'First).Map.all.Data, Args (Args'First + 1 .. Args'Last)); end Assoc; function Constructor return Map_Ptr is Ref : constant Map_Ptr := new Instance; begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); return Ref; end Constructor; function Contains (Args : in T_Array) return T is begin Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Map, "expected a map then a key"); return (Kind_Boolean, Args (Args'First).Map.all.Data.Contains (Args (Args'Last))); end Contains; function Dissoc (Args : in T_Array) return T is begin Err.Check (0 < Args'Length and then Args (Args'First).Kind = Kind_Map, "expected a map then keys"); declare Ref : constant Map_Ptr := Constructor; begin Ref.all.Data := Args (Args'First).Map.all.Data; for I in Args'First + 1 .. Args'Last loop Ref.all.Data.Exclude (Args (I)); -- This call checks the kind of the key. end loop; return (Kind_Map, Ref); end; end Dissoc; function Element (Position : in Cursor) return T is (HM.Element (HM.Cursor (Position))); function First (Container : in Instance) return Cursor is (Cursor (Container.Data.First)); function Get (Args : in T_Array) return T is begin Err.Check (Args'Length = 2, "expected 2 parameters"); case Args (Args'First).Kind is when Kind_Nil => Err.Check (Args (Args'Last).Kind in Kind_Key, "key must be a keyword or string"); return Nil; when Kind_Map => declare Position : constant HM.Cursor := Args (Args'First).Map.all.Data.Find (Args (Args'Last)); begin if HM.Has_Element (Position) then return HM.Element (Position); else return Nil; end if; end; when others => Err.Raise_With ("parameter 1 must be nil or a map"); end case; end Get; function Has_Element (Position : in Cursor) return Boolean is (HM.Has_Element (HM.Cursor (Position))); function Hash (Item : in T) return Ada.Containers.Hash_Type is begin Err.Check (Item.Kind in Kind_Key, "keys must be keywords or strings"); return Strings.Hash (Item.Str); end Hash; function Hash_Map (Args : in T_Array) return T is (Assoc (HM.Empty_Map, Args)); procedure Keep_References (Object : in out Instance) is begin for Position in Object.Data.Iterate loop Keep (HM.Key (Position)); Keep (HM.Element (Position)); end loop; Keep (Object.F_Meta); end Keep_References; function Key (Position : in Cursor) return T is (HM.Key (HM.Cursor (Position))); function Keys (Args : in T_Array) return T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Map, "expected a map"); declare A1 : HM.Map renames Args (Args'First).Map.all.Data; Ref : constant Sequence_Ptr := Sequences.Constructor (Natural (A1.Length)); I : Positive := 1; begin for Position in A1.Iterate loop Ref.all.Data (I) := HM.Key (Position); I := I + 1; end loop; return (Kind_List, Ref); end; end Keys; function Meta (Container : in Instance) return T is (Container.F_Meta); procedure Next (Position : in out Cursor) is begin HM.Next (HM.Cursor (Position)); end Next; function New_Map (Source : in Instance) return T is Ref : constant Map_Ptr := Constructor; begin Ref.all.Data := Source.Data; return (Kind_Map, Ref); end New_Map; procedure Replace_Element (Container : in out Instance; Position : in Cursor; New_Item : in T) is begin Container.Data.Replace_Element (HM.Cursor (Position), New_Item); end Replace_Element; function Vals (Args : in T_Array) return T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Map, "expected a map"); declare A1 : HM.Map renames Args (Args'First).Map.all.Data; R : constant Sequence_Ptr := Sequences.Constructor (Natural (A1.Length)); I : Positive := 1; begin for Element of A1 loop R.all.Data (I) := Element; I := I + 1; end loop; return (Kind_List, R); end; end Vals; function With_Meta (Container : in Instance; Metadata : in T) return T is Ref : constant Map_Ptr := Constructor; begin Ref.all.Data := Container.Data; Ref.all.F_Meta := Metadata; return (Kind_Map, Ref); end With_Meta; end Types.Maps; ================================================ FILE: impls/ada.2/types-maps.ads ================================================ private with Ada.Containers.Hashed_Maps; with Garbage_Collected; package Types.Maps is -- All function receiving a key check that its kind is keyword or -- string. type Instance (<>) is abstract new Garbage_Collected.Instance with private; -- Built-in functions. function Assoc (Args : in T_Array) return T; function Contains (Args : in T_Array) return T; function Dissoc (Args : in T_Array) return T; function Get (Args : in T_Array) return T; function Hash_Map (Args : in T_Array) return T; function Keys (Args : in T_Array) return T; function Vals (Args : in T_Array) return T; function "=" (Left, Right : in Instance) return Boolean with Inline; -- Used to print each element of a map. type Cursor (<>) is limited private; function Has_Element (Position : in Cursor) return Boolean with Inline; function Key (Position : in Cursor) return T with Inline; function Element (Position : in Cursor) return T with Inline; function First (Container : in Instance) return Cursor with Inline; procedure Next (Position : in out Cursor) with Inline; -- Used to evaluate each element of a map. function New_Map (Source : in Instance) return T with Inline; procedure Replace_Element (Container : in out Instance; Position : in Cursor; New_Item : in T) with Inline; function Meta (Container : in Instance) return T with Inline; function With_Meta (Container : in Instance; Metadata : in T) return T with Inline; private function Hash (Item : in T) return Ada.Containers.Hash_Type with Inline; -- This function also checks the kind of the key, and raise an -- error in case of problem. package HM is new Ada.Containers.Hashed_Maps (Key_Type => T, Element_Type => T, Hash => Hash, Equivalent_Keys => "=", "=" => "="); type Instance is new Garbage_Collected.Instance with record Data : HM.Map; F_Meta : T; end record; overriding procedure Keep_References (Object : in out Instance) with Inline; type Cursor is new HM.Cursor; end Types.Maps; ================================================ FILE: impls/ada.2/types-sequences.adb ================================================ with Err; with Types.Fns; with Types.Builtins; package body Types.Sequences is function "=" (Left, Right : in Instance) return Boolean is -- Should become Left.all.Data = Right.all.Data when -- https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89178 is fixed. begin return Left.Length = Right.Length and then (for all I in 1 .. Left.Data'Length => Left.Data (I) = Right.Data (I)); end "="; function Concat (Args : in T_Array) return T is Sum : Natural := 0; First : Positive := 1; Last : Natural; begin Err.Check ((for all A of Args => A.Kind in Kind_Sequence), "expected sequences"); for Arg of Args loop Sum := Sum + Arg.Sequence.all.Data'Length; end loop; declare Ref : constant Sequence_Ptr := Constructor (Sum); begin for Arg of Args loop Last := First - 1 + Arg.Sequence.all.Data'Last; Ref.all.Data (First .. Last) := Arg.Sequence.all.Data; First := Last + 1; end loop; return (Kind_List, Ref); end; end Concat; function Conj (Args : in T_Array) return T is begin Err.Check (0 < Args'Length, "expected at least 1 parameter"); case Args (Args'First).Kind is when Kind_Sequence => declare Data : T_Array renames Args (Args'First).Sequence.all.Data; Last : constant Natural := Args'Length - 1 + Data'Length; -- Avoid exceptions until Ref is controlled. Ref : constant Sequence_Ptr := Constructor (Last); begin if Args (Args'First).Kind = Kind_List then for I in 1 .. Args'Length - 1 loop Ref.all.Data (I) := Args (Args'Last - I + 1); end loop; Ref.all.Data (Args'Length .. Last) := Data; return (Kind_List, Ref); else Ref.all.Data := Data & Args (Args'First + 1 .. Args'Last); return (Kind_Vector, Ref); end if; end; when others => Err.Raise_With ("parameter 1 must be a sequence"); end case; end Conj; function Cons (Args : in T_Array) return T is begin Err.Check (Args'Length = 2 and then Args (Args'Last).Kind in Kind_Sequence, "expected a value then a sequence"); declare Head : T renames Args (Args'First); Tail : T_Array renames Args (Args'Last).Sequence.all.Data; Ref : constant Sequence_Ptr := Constructor (1 + Tail'Length); begin Ref.all.Data := Head & Tail; return (Kind_List, Ref); end; end Cons; function Constructor (Length : in Natural) return Sequence_Ptr is Ref : constant Sequence_Ptr := new Instance (Length); begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); return Ref; end Constructor; function Count (Args : in T_Array) return T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); case Args (Args'First).Kind is when Kind_Nil => return (Kind_Number, 0); when Kind_Sequence => return (Kind_Number, Args (Args'First).Sequence.all.Data'Length); when others => Err.Raise_With ("parameter must be nil or a sequence"); end case; end Count; function First (Args : in T_Array) return T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); case Args (Args'First).Kind is when Kind_Nil => return Nil; when Kind_Sequence => declare Data : T_Array renames Args (Args'First).Sequence.all.Data; begin if Data'Length = 0 then return Nil; else return Data (Data'First); end if; end; when others => Err.Raise_With ("parameter must be nil or a sequence"); end case; end First; function Is_Empty (Args : in T_Array) return T is begin Err.Check (Args'Length = 1 and then Args (Args'First).Kind in Kind_Sequence, "expected a sequence"); return (Kind_Boolean, Args (Args'First).Sequence.all.Data'Length = 0); end Is_Empty; procedure Keep_References (Object : in out Instance) is begin Keep (Object.Meta); for M of Object.Data loop Keep (M); end loop; end Keep_References; function List (Args : in T_Array) return T is Ref : constant Sequence_Ptr := Constructor (Args'Length); begin Ref.all.Data := Args; return (Kind_List, Ref); end List; function Map (Args : in T_Array) return T is begin Err.Check (Args'Length = 2 and then Args (Args'Last).Kind in Kind_Sequence, "expected a function then a sequence"); declare F : T renames Args (Args'First); Src : T_Array renames Args (Args'Last).Sequence.all.Data; Ref : constant Sequence_Ptr := Constructor (Src'Length); begin case F.Kind is when Kind_Builtin => for I in Src'Range loop Ref.all.Data (I) := F.Builtin.all (Src (I .. I)); end loop; when Kind_Builtin_With_Meta => for I in Src'Range loop Ref.all.Data (I) := F.Builtin_With_Meta.all.Builtin.all (Src (I .. I)); end loop; when Kind_Fn => for I in Src'Range loop Ref.all.Data (I) := F.Fn.all.Apply (Src (I .. I)); end loop; when others => Err.Raise_With ("parameter 1 must be a function"); end case; return (Kind_List, Ref); end; end Map; function Nth (Args : in T_Array) return T is begin Err.Check (Args'Length = 2 and then Args (Args'First).Kind in Kind_Sequence and then Args (Args'Last).Kind = Kind_Number, "expected a sequence then a number"); declare L : T_Array renames Args (Args'First).Sequence.all.Data; I : constant Integer := Args (Args'Last).Number + 1; begin Err.Check (I in L'Range, "index out of bounds"); return L (I); end; end Nth; function Rest (Args : in T_Array) return T is begin Err.Check (Args'Length = 1, "expected 1 parameter"); case Args (Args'First).Kind is when Kind_Nil => return (Kind_List, Constructor (0)); when Kind_Sequence => declare A1 : T_Array renames Args (Args'First).Sequence.all.Data; Ref : constant Sequence_Ptr := Constructor (Integer'Max (0, A1'Length - 1)); begin Ref.all.Data := A1 (A1'First + 1 .. A1'Last); return (Kind_List, Ref); end; when others => Err.Raise_With ("parameter must be nil or a sequence"); 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); begin Ref.all.Data := Args; return (Kind_Vector, Ref); end Vector; end Types.Sequences; ================================================ FILE: impls/ada.2/types-sequences.ads ================================================ with Garbage_Collected; package Types.Sequences is -- Hiding the implementation would either cause a significative -- performance hit (the compiler performs better optimization with -- explicit arrays) or a convoluted interface (demonstrated for -- strings and maps, where the balance is different). type Instance (Length : Natural) is new Garbage_Collected.Instance with record Meta : T; Data : T_Array (1 .. Length); end record; -- Built-in functions. function Concat (Args : in T_Array) return T; function Conj (Args : in T_Array) return T; function Cons (Args : in T_Array) return T; function Count (Args : in T_Array) return T; function First (Args : in T_Array) return T; function Is_Empty (Args : in T_Array) return T; function List (Args : in T_Array) return T; 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. function Constructor (Length : in Natural) return Sequence_Ptr with Inline; -- Helper for Types."=". function "=" (Left, Right : in Instance) return Boolean; private overriding procedure Keep_References (Object : in out Instance) with Inline; end Types.Sequences; ================================================ FILE: impls/ada.2/types-strings.adb ================================================ with Ada.Strings.Hash; package body Types.Strings is function "=" (Left : in Instance; Right : in String) return Boolean is (Left.Data = Right); function Alloc (Data : in String) return String_Ptr is Ref : constant String_Ptr := new Instance (Data'Length); begin Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); Ref.all.Data := Data; return Ref; end Alloc; function Hash (Item : in String_Ptr) return Ada.Containers.Hash_Type is (Ada.Strings.Hash (Item.all.Data)); procedure Query_Element (Container : in Instance; Process : not null access procedure (Element : in String)) is begin Process.all (Container.Data); end Query_Element; function Same_Contents (Left, Right : in String_Ptr) return Boolean is (Left = Right or else Left.all.Data = Right.all.Data); function To_String (Container : in Instance) return String is (Container.Data); end Types.Strings; ================================================ FILE: impls/ada.2/types-strings.ads ================================================ with Ada.Containers; with Garbage_Collected; package Types.Strings is ------------------------------------ -- Keywords, Strings and Symbols -- ------------------------------------ -- Tests seem to show that manual garbage collection is faster -- than reference counting in Ada.Strings.Unbounded, probably -- because we know that the values will never change. -- Also, maintaining a global structure in order to avoid similar -- symbol allocations does not seem to improve performances. type Instance (<>) is abstract new Garbage_Collected.Instance with private; function Alloc (Data : in String) return String_Ptr with Inline; function "=" (Left : in Instance; Right : in String) return Boolean with Inline; -- This kind of accessor is more efficient than a function -- returning an array. procedure Query_Element (Container : in Instance; Process : not null access procedure (Element : in String)); -- These methods could be implemented with Query_Element, -- but we want to optimize Envs.Get. function Hash (Item : in String_Ptr) return Ada.Containers.Hash_Type with Inline; function Same_Contents (Left, Right : in String_Ptr) return Boolean with Inline; -- When readability is more important than copying a string. function To_String (Container : in Instance) return String with Inline; private type Instance (Last : Natural) is new Garbage_Collected.Instance with record Data : String (1 .. Last); end record; end Types.Strings; ================================================ FILE: impls/ada.2/types.adb ================================================ pragma Warnings (Off, "no entities of ""Types.*"" are referenced"); with Types.Atoms; with Types.Builtins; with Types.Fns; with Types.Maps; with Types.Sequences; pragma Warnings (On, "no entities of ""Types.*"" are referenced"); with Types.Strings; package body Types is function "=" (Left, Right : in T) return Boolean is (case Left.Kind is when Kind_Nil => Right.Kind = Kind_Nil, when Kind_Boolean => Right.Kind = Kind_Boolean and then Left.Ada_Boolean = Right.Ada_Boolean, when Kind_Number => Right.Kind = Kind_Number and then Left.Number = Right.Number, -- Here comes the part that differs from the predefined equality. when Kind_Key | Kind_Symbol => Right.Kind = Left.Kind and then Strings.Same_Contents (Left.Str, Right.Str), when Kind_Sequence => Right.Kind in Kind_Sequence and then (Left.Sequence = Right.Sequence or else Sequences."=" (Left.Sequence.all, Right.Sequence.all)), when Kind_Map => Right.Kind = Kind_Map and then (Left.Map = Right.Map or else Maps."=" (Left.Map.all, Right.Map.all)), -- Also, comparing functions is an interesting problem. when others => False); procedure Keep (Object : in T) is -- No dynamic dispatching happens here. begin case Object.Kind is when Kind_Nil | Kind_Boolean | Kind_Number | Kind_Builtin => null; when Kind_Key | Kind_Symbol => Object.Str.all.Keep; when Kind_Atom => Object.Atom.all.Keep; when Kind_Sequence => Object.Sequence.all.Keep; when Kind_Map => Object.Map.all.Keep; when Kind_Builtin_With_Meta => Object.Builtin_With_Meta.all.Keep; when Kind_Fn | Kind_Macro => Object.Fn.all.Keep; end case; end Keep; function To_Boolean (Form : T) return Boolean is (case Form.Kind is when Kind_Nil => False, when Kind_Boolean => Form.Ada_Boolean, when others => True); end Types; ================================================ FILE: impls/ada.2/types.ads ================================================ limited with Types.Atoms; limited with Types.Builtins; limited with Types.Fns; limited with Types.Maps; limited with Types.Sequences; limited with Types.Strings; package Types is -- A type with a default value for the discriminant is the Ada -- equivalent of a C union. It uses a fixed size, and allows -- efficient arrays. A class hierarchy would make this impossible, -- for little gain. -- Native types may seem to consume too much memory, but -- 1/ they require no allocation/deallocation. -- 2/ the overhead would actually be higher with an intermediate -- reference (the size of the pointer plus the size of the native -- type, while an union uses the minimum of both and a single -- memory area ). -- The idea is inspired from the Haskell and OCaml interpreters, -- which use a bit to distinguish pointers from integers. Ada -- allows to specify the bit position of each component, but -- generating such architecture-dependent definitions seems a lot -- of work for MAL. -- The Ada tradition is to give explicit names to types, but this -- one will be used very often. type Kind_Type is (Kind_Nil, Kind_Atom, Kind_Boolean, Kind_Number, Kind_Symbol, Kind_Keyword, Kind_String, Kind_List, Kind_Vector, Kind_Map, Kind_Macro, Kind_Fn, Kind_Builtin_With_Meta, Kind_Builtin); subtype Kind_Key is Kind_Type range Kind_Keyword .. Kind_String; subtype Kind_Sequence is Kind_Type range Kind_List .. Kind_Vector; subtype Kind_Function is Kind_Type range Kind_Fn .. Kind_Builtin; type T; type T_Array; type Atom_Ptr is not null access Atoms.Instance; type Builtin_Ptr is not null access function (Args : in T_Array) return T; type Builtin_With_Meta_Ptr is not null access Builtins.Instance; type Fn_Ptr is not null access Fns.Instance; type Map_Ptr is not null access Maps.Instance; type Sequence_Ptr is not null access Sequences.Instance; type String_Ptr is not null access Strings.Instance; type T (Kind : Kind_Type := Kind_Nil) is record case Kind is when Kind_Nil => null; when Kind_Boolean => Ada_Boolean : Boolean; when Kind_Number => Number : Integer; when Kind_Atom => Atom : Atom_Ptr; when Kind_Key | Kind_Symbol => Str : String_Ptr; when Kind_Sequence => Sequence : Sequence_Ptr; when Kind_Map => Map : Map_Ptr; when Kind_Builtin => Builtin : Builtin_Ptr; when Kind_Builtin_With_Meta => Builtin_With_Meta : Builtin_With_Meta_Ptr; when Kind_Fn | Kind_Macro => Fn : Fn_Ptr; end case; end record; -- Useful for recursive automatic definition of equality for -- composite types like the array type below. function "=" (Left, Right : in T) return Boolean with Inline; Nil : constant T := (Kind => Kind_Nil); function To_Boolean (Form : T) return Boolean with Inline; procedure Keep (Object : in T) with Inline; type T_Array is array (Positive range <>) of T; end Types; ================================================ FILE: impls/awk/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # GNU Awk RUN apt-get -y install gawk ================================================ FILE: impls/awk/Makefile ================================================ SOURCES_BASE = types.awk reader.awk printer.awk SOURCES_LISP = env.awk core.awk stepA_mal.awk SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.awk mal mal.awk: $(SOURCES) echo 'arbitrary_long_name==0 "exec" "/usr/bin/gawk" "-O" "-f" "$$0" "$$@"' > $@ cat $+ | grep -v "^@include " >> $@ mal: mal.awk echo '#!/bin/sh' > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.awk mal ================================================ FILE: impls/awk/core.awk ================================================ @load "readfile" @load "time" function core_eq_sub(lhs, rhs, i, len) { if (lhs ~ /^[([]/ && rhs ~ /^[([]/) { lhs = substr(lhs, 2) rhs = substr(rhs, 2) len = types_heap[lhs]["len"] if (len != types_heap[rhs]["len"]) { return 0 } for (i = 0; i < len; ++i) { if (!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) { return 0 } } return 1 } else if (lhs ~ /^\{/ && rhs ~ /^\{/) { lhs = substr(lhs, 2) rhs = substr(rhs, 2) if ( length(types_heap[lhs]) - ("meta" in types_heap[lhs]) != \ length(types_heap[rhs]) - ("meta" in types_heap[rhs]) ) { return 0 } for (i in types_heap[lhs]) { if ( i != "meta" && types_heap[lhs][i] ~ /^["':+#([{?&$%]/ && !core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) { return 0 } } return 1 } else { return lhs == rhs } } function core_eq(idx) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } return core_eq_sub(types_heap[idx][1], types_heap[idx][2]) ? "#true" : "#false" } function core_throw(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'throw'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return "!" types_addref(types_heap[idx][1]) } function core_nilp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'nil?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] == "#nil" ? "#true" : "#false" } function core_truep(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'true?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] == "#true" ? "#true" : "#false" } function core_falsep(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'false?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] == "#false" ? "#true" : "#false" } function core_stringp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'string?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^"/ ? "#true" : "#false" } function core_symbol(idx, str) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'symbol'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } str = types_heap[idx][1] if (str !~ /^"/) { return "!\"Incompatible type for argument 1 of builtin function 'symbol'. Expects string, supplied " types_typename(str) "." } return "'" substr(str, 2) } function core_symbolp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'symbol?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^'/ ? "#true" : "#false" } function core_keyword(idx, str) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'keyword'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } str = types_heap[idx][1] switch (str) { case /^:/: return str case /^"/: return "::" substr(str, 2) } return "!\"Incompatible type for argument 1 of builtin function 'keyword'. Expects string or keyword, supplied " types_typename(str) "." } function core_keywordp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'keyword?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^:/ ? "#true" : "#false" } function core_numberp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'number?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^\+/ ? "#true" : "#false" } function core_fnp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'fn?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } f = types_heap[idx][1] return f ~ /^[$&%]/ && !types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false" } function core_macrop(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'macro?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } f = types_heap[idx][1] return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false" } function core_pr_str(idx, i, len, result) { len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { result = result printer_pr_str(types_heap[idx][i], 1) " " } return "\"" substr(result, 1, length(result) - 1) } function core_str(idx, i, len, result) { len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { result = result printer_pr_str(types_heap[idx][i], 0) } return "\"" result } function core_prn(idx, i, len, result) { len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { result = result printer_pr_str(types_heap[idx][i], 1) " " } print substr(result, 1, length(result) - 1) return "#nil" } function core_println(idx, i, len, result) { len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { result = result printer_pr_str(types_heap[idx][i], 0) " " } print substr(result, 1, length(result) - 1) return "#nil" } function core_read_string(idx, str) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'read-string'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } str = types_heap[idx][1] if (str !~ /^"/) { return "!\"Incompatible type for argument 1 of builtin function 'read-string'. Expects string, supplied " types_typename(str) "." } return reader_read_str(substr(str, 2)) } function core_readline(idx, prompt, var) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'readline'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } prompt = types_heap[idx][1] if (prompt !~ /^"/) { return "!\"Incompatible type for argument 1 of builtin function 'readline'. Expects string, supplied " types_typename(prompt) "." } printf("%s", printer_pr_str(prompt, 0)) return getline var <= 0 ? "#nil" : "\"" var } function core_slurp(idx, filename, str) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'slurp'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } filename = types_heap[idx][1] if (filename !~ /^"/) { return "!\"Incompatible type for argument 1 of builtin function 'slurp'. Expects string, supplied " types_typename(filename) "." } str = readfile(substr(filename, 2)) if (str == "" && ERRNO != "") { return "!\"cannot read file '" filename "', ERRNO = " ERRNO } return "\"" str } function core_lt(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '<'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '<'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '<'. Expects number, supplied " types_typename(rhs) "." } return substr(lhs, 2) + 0 < substr(rhs, 2) + 0 ? "#true" : "#false" } function core_le(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '<='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '<='. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '<='. Expects number, supplied " types_typename(rhs) "." } return substr(lhs, 2) + 0 <= substr(rhs, 2) + 0 ? "#true" : "#false" } function core_gt(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '>'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '>'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '>'. Expects number, supplied " types_typename(rhs) "." } return substr(lhs, 2) + 0 > substr(rhs, 2) + 0 ? "#true" : "#false" } function core_ge(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '>='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '>='. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '>='. Expects number, supplied " types_typename(rhs) "." } return substr(lhs, 2) + 0 >= substr(rhs, 2) + 0 ? "#true" : "#false" } function core_add(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) + substr(rhs, 2)) } function core_subtract(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) - substr(rhs, 2)) } function core_multiply(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) * substr(rhs, 2)) } function core_divide(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." } return "+" int(substr(lhs, 2) / substr(rhs, 2)) } function core_time_ms(idx) { if (types_heap[idx]["len"] != 1) { return "!\"Invalid argument length for builtin function 'time-ms'. Expects no arguments, supplied " (types_heap[idx]["len"] - 1) "." } return "+" int(gettimeofday() * 1000) } function core_list(idx, new_idx, len, i) { new_idx = types_allocate() len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) } types_heap[new_idx]["len"] = len - 1 return "(" new_idx } function core_listp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'list?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^\(/ ? "#true" : "#false" } function core_vector(idx, new_idx, len, i) { new_idx = types_allocate() len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) } types_heap[new_idx]["len"] = len - 1 return "[" new_idx } function core_vectorp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'vector?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^\[/ ? "#true" : "#false" } function core_hash_map(idx, len, new_idx, i, key) { len = types_heap[idx]["len"] if (len % 2 != 1) { return "!\"Invalid argument length for builtin function 'hash-map'. Expects even number of arguments, supplied " (len - 1) "." } new_idx = types_allocate() for (i = 1; i < len; i += 2) { key = types_heap[idx][i] if (key !~ /^[":]/) { types_release("{" new_idx) return "!\"Incompatible type for key argument of builtin function 'hash-map'. Expects string or keyword, supplied " types_typename(key) "." } if (key in types_heap[new_idx]) { types_release(types_heap[new_idx][key]) } types_addref(types_heap[new_idx][key] = types_heap[idx][i + 1]) } return "{" new_idx } function core_mapp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'map?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^\{/ ? "#true" : "#false" } function core_assoc(idx, len, map, i, key, add_list, new_idx, map_idx) { len = types_heap[idx]["len"] if (len % 2 != 0) { return "!\"Invalid argument length for builtin function 'assoc'. Expects odd number of arguments, supplied " (len - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/) { return "!\"Incompatible type for argument 1 of builtin function 'assoc'. Expects hash-map, supplied " types_typename(map) "." } for (i = 2; i < len; i += 2) { key = types_heap[idx][i] if (key !~ /^[":]/) { return "!\"Incompatible type for key argument of builtin function 'assoc'. Expects string or keyword, supplied " types_typename(key) "." } add_list[key] = types_heap[idx][i + 1] } new_idx = types_allocate() map_idx = substr(map, 2) for (key in types_heap[map_idx]) { if (key ~ /^[":]|^meta$/ && !(key in add_list)) { types_addref(types_heap[new_idx][key] = types_heap[map_idx][key]) } } for (key in add_list) { types_addref(types_heap[new_idx][key] = add_list[key]) } return "{" new_idx } function core_dissoc(idx, len, map, i, key, del_list, new_idx, map_idx) { len = types_heap[idx]["len"] if (len < 2) { return "!\"Invalid argument length for builtin function 'dissoc'. Expects at least 1 argument, supplied " (len - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/) { return "!\"Incompatible type for argument 1 of builtin function 'dissoc'. Expects hash-map, supplied " types_typename(map) "." } for (i = 2; i < len; ++i) { key = types_heap[idx][i] if (key !~ /^[":]/) { return "!\"Incompatible type for key argument of builtin function 'dissoc'. Expects string or keyword, supplied " types_typename(key) "." } del_list[key] = "1" } new_idx = types_allocate() map_idx = substr(map, 2) for (key in types_heap[map_idx]) { if (key ~ /^[":]|^meta$/ && !(key in del_list)) { types_addref(types_heap[new_idx][key] = types_heap[map_idx][key]) } } return "{" new_idx } function core_get(idx, map, key, map_idx) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'get'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/ && map != "#nil") { return "!\"Incompatible type for argument 1 of builtin function 'get'. Expects hash-map or nil, supplied " types_typename(map) "." } key = types_heap[idx][2] if (key !~ /^[":]/) { return "!\"Incompatible type for argument 2 of builtin function 'get'. Expects string or keyword, supplied " types_typename(key) "." } if (map != "#nil" && key in types_heap[map_idx = substr(map, 2)]) { return types_addref(types_heap[map_idx][key]) } else { return "#nil" } } function core_containsp(idx, map, key) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'contains?'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/) { return "!\"Incompatible type for argument 1 of builtin function 'contains?'. Expects hash-map, supplied " types_typename(map) "." } key = types_heap[idx][2] if (key !~ /^[":]/) { return "!\"Incompatible type for argument 2 of builtin function 'contains?'. Expects string or keyword, supplied " types_typename(key) "." } return key in types_heap[substr(map, 2)] ? "#true" : "#false" } function core_keys(idx, map, map_idx, new_idx, len, key) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'keys'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/) { return "!\"Incompatible type for argument 1 of builtin function 'keys'. Expects hash-map, supplied " types_typename(map) "." } map_idx = substr(map, 2) new_idx = types_allocate() len = 0 for (key in types_heap[map_idx]) { if (key ~ /^[":]/) { types_heap[new_idx][len++] = key } } types_heap[new_idx]["len"] = len return "(" new_idx } function core_vals(idx, map, map_idx, new_idx, len, key) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'vals'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } map = types_heap[idx][1] if (map !~ /^\{/) { return "!\"Incompatible type for argument 1 of builtin function 'vals'. Expects hash-map, supplied " types_typename(map) "." } map_idx = substr(map, 2) new_idx = types_allocate() len = 0 for (key in types_heap[map_idx]) { if (key ~ /^[":]/) { types_addref(types_heap[new_idx][len++] = types_heap[map_idx][key]) } } types_heap[new_idx]["len"] = len return "(" new_idx } function core_sequentialp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'sequential?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^[([]/ ? "#true" : "#false" } function core_cons(idx, lst, lst_idx, new_idx, len, i) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'cons'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][2] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'cons'. Expects list or vector, supplied " types_typename(lst) "." } lst_idx = substr(lst, 2) new_idx = types_allocate() types_addref(types_heap[new_idx][0] = types_heap[idx][1]) len = types_heap[lst_idx]["len"] for (i = 0; i < len; ++i) { types_addref(types_heap[new_idx][i + 1] = types_heap[lst_idx][i]) } types_heap[new_idx]["len"] = len + 1 return "(" new_idx } function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j) { new_idx = types_allocate() new_len = 0 len = types_heap[idx]["len"] for (i = 1; i < len; ++i) { lst = types_heap[idx][i] if (lst !~ /^[([]/) { types_heap[new_idx]["len"] = new_len types_release("(" new_idx) return "!\"Incompatible type for argument ' (i - 1) ' of builtin function 'concat'. Expects list or vector, supplied " types_typename(lst) "." } lst_idx = substr(lst, 2) lst_len = types_heap[lst_idx]["len"] for (j = 0; j < lst_len; ++j) { types_addref(types_heap[new_idx][new_len++] = types_heap[lst_idx][j]) } } types_heap[new_idx]["len"] = new_len 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) { return "!\"Invalid argument length for builtin function 'nth'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][1] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'nth'. Expects list or vector, supplied " types_typename(lst) "." } num = types_heap[idx][2] if (num !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function 'nth'. Expects number, supplied " types_typename(num) "." } n = substr(num, 2) + 0 lst_idx = substr(lst, 2) if (n < 0 || types_heap[lst_idx]["len"] <= n) { return "!\"Index out of range. Sequence length is " types_heap[lst_idx]["len"] ", supplied " n "." } return types_addref(types_heap[lst_idx][n]) } function core_first(idx, lst, lst_idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'first'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][1] if (lst == "#nil") { return "#nil" } if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'first'. Expects list, vector or nil, supplied " types_typename(lst) "." } lst_idx = substr(lst, 2) return types_heap[lst_idx]["len"] == 0 ? "#nil" : types_addref(types_heap[lst_idx][0]) } function core_rest(idx, lst, lst_idx, lst_len, new_idx, i) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'rest'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][1] if (lst == "#nil") { new_idx = types_allocate() types_heap[new_idx]["len"] = 0 return "(" new_idx } if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'rest'. Expects list, vector or nil, supplied " types_typename(lst) "." } lst_idx = substr(lst, 2) lst_len = types_heap[lst_idx]["len"] new_idx = types_allocate() for (i = 1; i < lst_len; ++i) { types_addref(types_heap[new_idx][i - 1] = types_heap[lst_idx][i]) } types_heap[new_idx]["len"] = lst_len - 1 return "(" new_idx } function core_emptyp(idx, lst) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'empty?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][1] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'empty?'. Expects list or vector, supplied " types_typename(lst) "." } return types_heap[substr(lst, 2)]["len"] == 0 ? "#true" : "#false" } function core_count(idx, lst) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'count'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } lst = types_heap[idx][1] if (lst ~ /^[([]/) { return "+" types_heap[substr(lst, 2)]["len"] } if (lst == "#nil") { return "+0" } return "!\"Incompatible type for argument 1 of builtin function 'count'. Expects list, vector or nil, supplied " types_typename(lst) "." } function core_apply(idx, len, f, lst, new_idx, i, lst_idx, lst_len, f_idx, env, ret) { len = types_heap[idx]["len"] if (len < 3) { return "!\"Invalid argument length for builtin function 'apply'. Expects at least 2 arguments, supplied " (len - 1) "." } f = types_heap[idx][1] if (f !~ /^[$&%]/) { return "!\"Incompatible type for argument 1 of builtin function 'apply'. Expects function, supplied " types_typename(f) "." } lst = types_heap[idx][len - 1] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument ' (len - 1) ' of builtin function 'apply'. Expects list or vector, supplied " types_typename(lst) "." } new_idx = types_allocate() types_addref(types_heap[new_idx][0] = f) for (i = 2; i < len - 1; ++i) { types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i]) } lst_idx = substr(lst, 2) lst_len = types_heap[lst_idx]["len"] for (i = 0; i < lst_len; ++i) { types_addref(types_heap[new_idx][len + i - 2] = types_heap[lst_idx][i]) } types_heap[new_idx]["len"] = len + lst_len - 2 f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx) types_release("(" new_idx) if (env ~ /^!/) { return env } ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) env_release(env) return ret case /^%/: f_idx = types_heap[f_idx]["func"] case /^&/: ret = @f_idx(new_idx) types_release("(" new_idx) return ret } } function core_map(idx, f, lst, f_idx, lst_idx, lst_len, new_idx, expr_idx, i, env, ret, val) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'map'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } f = types_heap[idx][1] if (f !~ /^[$&%]/) { return "!\"Incompatible type for argument 1 of builtin function 'map'. Expects function, supplied " types_typename(f) "." } lst = types_heap[idx][2] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 2 of builtin function 'map'. Expects list or vector, supplied " types_typename(lst) "." } f_idx = substr(f, 2) lst_idx = substr(lst, 2) lst_len = types_heap[lst_idx]["len"] new_idx = types_allocate() types_heap[new_idx][0] = f types_heap[new_idx]["len"] = 2 expr_idx = types_allocate() for (i = 0; i < lst_len; ++i) { types_heap[new_idx][1] = types_heap[lst_idx][i] switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx) if (env ~ /^!/) { types_heap[expr_idx]["len"] = i types_heap[new_idx]["len"] = 0 types_release("(" expr_idx) types_release("(" new_idx) return env } ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) env_release(env) break case /^%/: f_idx = types_heap[f_idx]["func"] case /^&/: ret = @f_idx(new_idx) break } if (ret ~ /^!/) { types_heap[expr_idx]["len"] = i types_heap[new_idx]["len"] = 0 types_release("(" expr_idx) types_release("(" new_idx) return ret } types_heap[expr_idx][i] = ret } types_heap[expr_idx]["len"] = lst_len types_heap[new_idx]["len"] = 0 types_release("(" new_idx) return "(" expr_idx } function core_conj(idx, len, lst, lst_idx, lst_len, new_idx, i, j) { len = types_heap[idx]["len"] if (len < 3) { return "!\"Invalid argument length for builtin function 'conj'. Expects at least 2 arguments, supplied " (len - 1) "." } lst = types_heap[idx][1] if (lst !~ /^[([]/) { return "!\"Incompatible type for argument 1 of builtin function 'conj'. Expects list or vector, supplied " types_typename(lst) "." } lst_idx = substr(lst, 2) lst_len = types_heap[lst_idx]["len"] new_idx = types_allocate() j = 0 if (lst ~ /^\(/) { for (i = len - 1; i >= 2; --i) { types_addref(types_heap[new_idx][j++] = types_heap[idx][i]) } for (i = 0; i < lst_len; ++i) { types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i]) } } else { for (i = 0; i < lst_len; ++i) { types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i]) } for (i = 2; i < len; ++i) { types_addref(types_heap[new_idx][j++] = types_heap[idx][i]) } } types_addref(types_heap[new_idx]["meta"] = types_heap[lst_idx]["meta"]) types_heap[new_idx]["len"] = j return substr(lst, 1, 1) new_idx } function core_seq(idx, obj, obj_idx, new_idx, i, len, chars) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'seq'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } obj = types_heap[idx][1] if (obj ~ /^[(]/) { if (types_heap[substr(obj, 2)]["len"] == 0) { return "#nil" } return types_addref(obj) } else if (obj ~ /^\[/) { obj_idx = substr(obj, 2) len = types_heap[obj_idx]["len"] if (len == 0) { return "#nil" } new_idx = types_allocate() for (i = 0; i < len; ++i) { types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) } types_heap[new_idx]["len"] = len return "(" new_idx } else if (obj ~ /^"/) { obj_idx = substr(obj, 2) len = length(obj_idx) if (len == 0) { return "#nil" } new_idx = types_allocate() split(obj_idx, chars, "") for (i = 0; i <= len; ++i) { types_heap[new_idx][i] = "\"" chars[i+1] } types_heap[new_idx]["len"] = len return "(" new_idx } else if (obj == "#nil") { return "#nil" } else { return "!\"seq: called on non-sequence" } } function core_meta(idx, obj, obj_idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'meta'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } obj = types_heap[idx][1] if (obj ~ /^[([{$%]/ && "meta" in types_heap[obj_idx = substr(obj, 2)]) { return types_addref(types_heap[obj_idx]["meta"]) } return "#nil" } function core_with_meta(idx, obj, obj_idx, new_idx, i, len) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'with-meta'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } obj = types_heap[idx][1] obj_idx = substr(obj, 2) new_idx = types_allocate() types_addref(types_heap[new_idx]["meta"] = types_heap[idx][2]) switch (obj) { case /^[([]/: len = types_heap[obj_idx]["len"] for (i = 0; i < len; ++i) { types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) } types_heap[new_idx]["len"] = len return substr(obj, 1, 1) new_idx case /^\{/: for (i in types_heap[obj_idx]) { if (i ~ /^[":]/) { types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i]) } } return "{" new_idx case /^\$/: types_addref(types_heap[new_idx]["params"] = types_heap[obj_idx]["params"]) types_addref(types_heap[new_idx]["body"] = types_heap[obj_idx]["body"]) env_addref(types_heap[new_idx]["env"] = types_heap[obj_idx]["env"]) return "$" new_idx case /^&/: types_heap[new_idx]["func"] = obj_idx return "%" new_idx case /^%/: types_heap[new_idx]["func"] = types_heap[obj_idx]["func"] return "%" new_idx default: types_release("{" new_idx) return "!\"Incompatible type for argument 1 of builtin function 'with-meta'. Expects list, vector, hash-map or function, supplied " types_typename(lst) "." } } function core_atom(idx, atom_idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'atom'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } atom_idx = types_allocate() types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][1]) return "?" atom_idx } function core_atomp(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'atom?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return types_heap[idx][1] ~ /^\?/ ? "#true" : "#false" } function core_deref(idx, atom) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'deref'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } atom = types_heap[idx][1] if (atom !~ /^\?/) { return "!\"Incompatible type for argument 1 of builtin function 'deref'. Expects atom, supplied " types_typename(atom) "." } return types_addref(types_heap[substr(atom, 2)]["obj"]) } function core_reset(idx, atom, atom_idx) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function 'reset!'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } atom = types_heap[idx][1] if (atom !~ /^\?/) { return "!\"Incompatible type for argument 1 of builtin function 'reset!'. Expects atom, supplied " types_typename(atom) "." } atom_idx = substr(atom, 2) types_release(types_heap[atom_idx]["obj"]) return types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][2]) } function core_swap(idx, expr, atom, f, lst_idx, ret, f_idx, env, i, len, atom_idx) { len = types_heap[idx]["len"] if (len < 3) { return "!\"Invalid argument length for builtin function 'swap!'. Expects at least 2 arguments, supplied " (len - 1) "." } atom = types_heap[idx][1] if (atom !~ /^\?/) { return "!\"Incompatible type for argument 1 of builtin function 'swap!'. Expects atom, supplied " types_typename(atom) "." } f = types_heap[idx][2] if (f !~ /^[&$%]/) { return "!\"Incompatible type for argument 2 of builtin function 'swap!'. Expects function, supplied " types_typename(f) "." } lst_idx = types_allocate() atom_idx = substr(atom, 2) types_addref(types_heap[lst_idx][0] = f) types_addref(types_heap[lst_idx][1] = types_heap[atom_idx]["obj"]) for (i = 3; i < len; ++i) { types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) } types_heap[lst_idx]["len"] = len - 1 f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], lst_idx) types_release("(" lst_idx) if (env ~ /^!/) { return env } ret = EVAL(types_addref(types_heap[f_idx]["body"]), env) env_release(env) break case /^%/: f_idx = types_heap[f_idx]["func"] case /^&/: ret = @f_idx(lst_idx) types_release("(" lst_idx) break } if (ret ~ /^!/) { return ret } types_release(types_heap[atom_idx]["obj"]) return types_addref(types_heap[atom_idx]["obj"] = ret) } function core_init() { core_ns["'="] = "&core_eq" core_ns["'throw"] = "&core_throw" core_ns["'nil?"] = "&core_nilp" core_ns["'true?"] = "&core_truep" core_ns["'false?"] = "&core_falsep" core_ns["'string?"] = "&core_stringp" core_ns["'symbol"] = "&core_symbol" core_ns["'symbol?"] = "&core_symbolp" core_ns["'keyword"] = "&core_keyword" core_ns["'keyword?"] = "&core_keywordp" core_ns["'number?"] = "&core_numberp" core_ns["'fn?"] = "&core_fnp" core_ns["'macro?"] = "&core_macrop" core_ns["'pr-str"] = "&core_pr_str" core_ns["'str"] = "&core_str" core_ns["'prn"] = "&core_prn" core_ns["'println"] = "&core_println" core_ns["'read-string"] = "&core_read_string" core_ns["'readline"] = "&core_readline" core_ns["'slurp"] = "&core_slurp" core_ns["'<"] = "&core_lt" core_ns["'<="] = "&core_le" core_ns["'>"] = "&core_gt" core_ns["'>="] = "&core_ge" core_ns["'+"] = "&core_add" core_ns["'-"] = "&core_subtract" core_ns["'*"] = "&core_multiply" core_ns["'/"] = "&core_divide" core_ns["'time-ms"] = "&core_time_ms" 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" core_ns["'map?"] = "&core_mapp" core_ns["'assoc"] = "&core_assoc" core_ns["'dissoc"] = "&core_dissoc" core_ns["'get"] = "&core_get" core_ns["'contains?"] = "&core_containsp" core_ns["'keys"] = "&core_keys" core_ns["'vals"] = "&core_vals" core_ns["'sequential?"] = "&core_sequentialp" core_ns["'cons"] = "&core_cons" core_ns["'concat"] = "&core_concat" core_ns["'nth"] = "&core_nth" core_ns["'first"] = "&core_first" core_ns["'rest"] = "&core_rest" core_ns["'empty?"] = "&core_emptyp" core_ns["'count"] = "&core_count" core_ns["'apply"] = "&core_apply" core_ns["'map"] = "&core_map" core_ns["'conj"] = "&core_conj" core_ns["'seq"] = "&core_seq" core_ns["'meta"] = "&core_meta" core_ns["'with-meta"] = "&core_with_meta" core_ns["'atom"] = "&core_atom" core_ns["'atom?"] = "&core_atomp" core_ns["'deref"] = "&core_deref" core_ns["'reset!"] = "&core_reset" core_ns["'swap!"] = "&core_swap" } BEGIN { core_init() } ================================================ FILE: impls/awk/env.awk ================================================ function env_new(outer, params, args, idx, len, i, j, lst, param) { if (params != "") { params = substr(params, 2) len = types_heap[params]["len"] if (len >= 2 && types_heap[params][len - 2] == "'&") { if (types_heap[args]["len"] < len - 1) { return "!\"Invalid argument length for the function. Expects at least " (len - 2) " arguments, supplied " (types_heap[args]["len"] - 1) "." } } else { if (types_heap[args]["len"] != len + 1) { return "!\"Invalid argument length for the function. Expects exactly " len " arguments, supplied " (types_heap[args]["len"] - 1) "." } } } env_heap[env_heap_index]["ref"] = 1 env_heap[env_heap_index]["outer"] = outer if (params != "") { for (i = 0; i < len; ++i) { param = types_heap[params][i] if (param == "'&") { idx = types_allocate() env_set(env_heap_index, types_heap[params][++i], "(" idx) len = types_heap[args]["len"] for (j = 0; i < len; ++j) { types_addref(types_heap[idx][j] = types_heap[args][i++]) } types_heap[idx]["len"] = j break } env_set(env_heap_index, param, types_heap[args][i + 1]) types_addref(types_heap[args][i + 1]) } } if (outer != "") { env_addref(outer) } return env_heap_index++ } function env_set(env, key, val) { if (key in env_heap[env]) { types_release(env_heap[env][key]) } if (val ~ /^&/) { env_builtinnames[substr(val, 2)] = substr(key, 2) } env_heap[env][key] = val } function env_find(env, key) { while (env != "") { if (key in env_heap[env]) { return env } env = env_heap[env]["outer"] } return env } function env_get(env, key) { env = env_find(env, key) if (env != "") { return env_heap[env][key] } return "!\"'" substr(key, 2) "' not found" } function env_addref(env) { env_heap[env]["ref"]++ } function env_release(env, i, outer) { while (env != "" && --env_heap[env]["ref"] == 0) { for (i in env_heap[env]) { if (i ~ /^'/) { types_release(env_heap[env][i]) } } outer = env_heap[env]["outer"] delete env_heap[env] env = outer } } function env_dump(i, j) { for (i = 0; i < env_heap_index; i++) { if (i in env_heap) { if (isarray(env_heap[i])) { if (!("checked" in env_heap[i]) || env_heap[i]["checked"] != env_heap[i]["ref"]) { for (j in env_heap[i]) { print " env_heap[" i "][" j "] = " env_heap[i][j] } } } else { print " env_heap[" i "] = " env_heap[i] } } } } function env_check(env, i, outer) { if (env_heap[env]["checked"]++) { return } for (i in env_heap[env]) { if (i != "ref" && i != "outer") { types_check(env_heap[env][i]) } } outer = env_heap[env]["outer"] if (outer in env_heap) { env_check(outer) } } BEGIN { env_heap_index = 0 } ================================================ FILE: impls/awk/printer.awk ================================================ function printer_pr_list(expr, print_readably, idx, len, i, str) { idx = substr(expr, 2) len = types_heap[idx]["len"] for (i = 0; i < len; ++i) { str = str printer_pr_str(types_heap[idx][i], print_readably) " " } return substr(str, 1, length(str) - 1) } function printer_pr_hash(expr, print_readably, idx, var, str) { idx = substr(expr, 2) for (var in types_heap[idx]) { switch (var) { case /^"/: str = str printer_pr_string(var, print_readably) " " printer_pr_str(types_heap[idx][var], print_readably) " " break case /^:/: str = str substr(var, 2) " " printer_pr_str(types_heap[idx][var], print_readably) " " break } } return substr(str, 1, length(str) - 1) } function printer_pr_string(expr, print_readably, v, r) { if (!print_readably) { return substr(expr, 2) } expr = substr(expr, 2) while (match(expr, /["\n\\]/, r)) { v = v substr(expr, 1, RSTART - 1) (r[0] == "\n" ? "\\n" : "\\" r[0]) expr = substr(expr, RSTART + RLENGTH) } return "\"" v expr "\"" } function printer_pr_str(expr, print_readably, var) { switch (expr) { case /^\(/: return "(" printer_pr_list(expr, print_readably) ")" case /^\[/: return "[" printer_pr_list(expr, print_readably) "]" case /^\{/: return "{" printer_pr_hash(expr, print_readably) "}" case /^"/: return printer_pr_string(expr, print_readably) case /^\$/: var = substr(expr, 2) return "# (fn* " printer_pr_str(types_heap[var]["params"], print_readably) " " printer_pr_str(types_heap[var]["body"], print_readably) ")" case /^&/: return "#" case /^%/: return "#" case /^\?/: return "(atom " printer_pr_str(types_heap[substr(expr, 2)]["obj"], print_readably) ")" default: return substr(expr, 2) } } ================================================ FILE: impls/awk/reader.awk ================================================ function reader_read_string(token, v, r) { token = substr(token, 1, length(token) - 1) gsub(/\\\\/, "\xf7", token) gsub(/\\"/, "\"", token) gsub(/\\n/, "\n", token) gsub("\xf7", "\\", token) return token } function reader_read_atom(token) { switch (token) { case "true": case "false": case "nil": return "#" token case /^:/: return ":" token case /^"/: if (token ~ /^"(\\.|[^\\"])*"$/) { return reader_read_string(token) } else { return "!\"Expected '\"', got EOF." } case /^-?[0-9]+$/: return "+" token default: return "'" token } } function reader_read_list(reader, type, end, idx, len, ret) { idx = types_allocate() len = 0 while (reader["curidx"] in reader) { if (reader[reader["curidx"]] == end) { types_heap[idx]["len"] = len reader["curidx"]++ return type idx } ret = reader_read_from(reader) if (ret ~ /^!/) { types_heap[idx]["len"] = len types_release(type idx) return ret } types_heap[idx][len++] = ret } types_heap[idx]["len"] = len types_release(type idx) return "!\"expected '" end "', got EOF" } function reader_read_hash(reader, idx, key, val) { idx = types_allocate() while (reader["curidx"] in reader) { if (reader[reader["curidx"]] == "}") { reader["curidx"]++ return "{" idx } key = reader_read_from(reader) if (key ~ /^!/) { types_release("{" idx) return key } if (key !~ /^[":]/) { types_release(key) types_release("{" idx) return "!\"Hash-map key must be string or keyword." } if (!(reader["curidx"] in reader)) { types_release("{" idx) return "!\"Element count of hash-map must be even." } val = reader_read_from(reader) if (val ~ /^!/) { types_release("{" idx) return val } types_heap[idx][key] = val } types_release("{" idx) return "!\"expected '}', got EOF" } function reader_read_abbrev(reader, symbol, val, idx) { val = reader_read_from(reader) if (val ~ /^!/) { return val } idx = types_allocate() types_heap[idx]["len"] = 2 types_heap[idx][0] = symbol types_heap[idx][1] = val return "(" idx } function reader_read_with_meta(reader, meta, val, idx) { meta = reader_read_from(reader) if (meta ~ /^!/) { return meta } val = reader_read_from(reader) if (val ~ /^!/) { types_release(meta) return val } idx = types_allocate() types_heap[idx]["len"] = 3 types_heap[idx][0] = "'with-meta" types_heap[idx][1] = val types_heap[idx][2] = meta return "(" idx } function reader_read_from(reader, current) { current = reader[reader["curidx"]++] switch (current) { case "(": return reader_read_list(reader, "(", ")") case "[": return reader_read_list(reader, "[", "]") case "{": return reader_read_hash(reader) case ")": case "]": case "}": return "!\"Unexpected token '" current "'." case "'": return reader_read_abbrev(reader, "'quote") case "`": return reader_read_abbrev(reader, "'quasiquote") case "~": return reader_read_abbrev(reader, "'unquote") case "~@": return reader_read_abbrev(reader, "'splice-unquote") case "@": return reader_read_abbrev(reader, "'deref") case "^": return reader_read_with_meta(reader) default: return reader_read_atom(current) } } function reader_tokenizer(str, reader, len, r) { for (len = 0; match(str, /^[ \t\r\n,]*(~@|[\[\]{}()'`~^@]|\"(\\.|[^\\"])*\"?|;[^\r\n]*|[^ \t\r\n\[\]{}('"`,;)^~@][^ \t\r\n\[\]{}('"`,;)]*)/, r); ) { if (substr(r[1], 1, 1) != ";") { reader[len++] = r[1] } str = substr(str, RSTART + RLENGTH) } if (str !~ /^[ \t\r\n,]*$/) { return "!\"Cannot tokenize '" str "'." } reader["len"] = len return "" } function reader_read_str(str, reader, ret) { ret = reader_tokenizer(str, reader) if (ret != "") { return ret } if (reader["len"] == 0) { return "#nil" } ret = reader_read_from(reader) if (ret ~ /^!/) { return ret } if (reader["len"] != reader["curidx"]) { types_release(ret) return "!\"Unexpected token '" reader[reader["curidx"]] "'." } return ret } ================================================ FILE: impls/awk/run ================================================ #!/usr/bin/env bash exec awk -O -f $(dirname $0)/${STEP:-stepA_mal}.awk "${@}" ================================================ FILE: impls/awk/step0_repl.awk ================================================ function READ(str) { return str } function EVAL(ast) { return ast } function PRINT(expr) { return expr } function rep(str) { return PRINT(EVAL(READ(str))) } function main(str) { while (1) { printf("user> ") if (getline str <= 0) { break } print rep(str) } } BEGIN { main() exit(0) } ================================================ FILE: impls/awk/step1_read_print.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" function READ(str) { return reader_read_str(str) } function EVAL(ast) { return ast } function PRINT(expr) { return printer_pr_str(expr, 1) } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast) if (expr ~ /^!/) { return expr } return PRINT(expr) } function main(str, ret) { while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() exit(0) } ================================================ FILE: impls/awk/step2_eval.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" function READ(str) { return reader_read_str(str) } function eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { # print "EVAL: " printer_pr_str(ast, 1) switch (ast) { case /^'/: # symbol if (ast in env) { ret = types_addref(env[ast]) } else { ret = "!\"'" substr(ast, 2) "' not found" } types_release(ast) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) return ret case /^[^(]/: # not a list types_release(ast) return ast } idx = substr(ast, 2) if (types_heap[idx]["len"] == 0) { return ast } f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) return f } new_ast = eval_ast(ast, env) types_release(ast) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) if (f ~ /^&/) { f_idx = substr(f, 2) ret = @f_idx(idx) types_release(new_ast) return ret } else { types_release(new_ast) return "!\"First element of list must be function, supplied " types_typename(f) "." } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function add(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) + substr(rhs, 2)) } function subtract(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) - substr(rhs, 2)) } function multiply(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) * substr(rhs, 2)) } function divide(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." } return "+" int(substr(lhs, 2) / substr(rhs, 2)) } function main(str, ret) { repl_env["'+"] = "&add" repl_env["'-"] = "&subtract" repl_env["'*"] = "&multiply" repl_env["'/"] = "÷" env_builtinnames["add"] = "+" env_builtinnames["subtract"] = "-" env_builtinnames["multiply"] = "*" env_builtinnames["divide"] = "/" while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() exit(0) } ================================================ FILE: impls/awk/step3_env.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" function READ(str) { return reader_read_str(str) } function eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret = EVAL(body, new_env) env_release(new_env) return ret } function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) if (types_heap[idx]["len"] == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": return EVAL_let(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) f_idx = substr(f, 2) switch (f) { case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) return "!\"First element of list must be function, supplied " types_typename(f) "." } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function add(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) + substr(rhs, 2)) } function subtract(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) - substr(rhs, 2)) } function multiply(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." } return "+" (substr(lhs, 2) * substr(rhs, 2)) } function divide(idx, lhs, rhs) { if (types_heap[idx]["len"] != 3) { return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." } lhs = types_heap[idx][1] if (lhs !~ /^\+/) { return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." } rhs = types_heap[idx][2] if (rhs !~ /^\+/) { return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." } return "+" int(substr(lhs, 2) / substr(rhs, 2)) } function main(str, ret) { repl_env = env_new() env_set(repl_env, "'+", "&add") env_set(repl_env, "'-", "&subtract") env_set(repl_env, "'*", "&multiply") env_set(repl_env, "'/", "÷") while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step4_if_fn_do.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } function eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret = EVAL(body, new_env) env_release(new_env) return ret } function EVAL_do(ast, env, idx, len, i, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } ret = EVAL(types_addref(types_heap[idx][len - 1]), env) types_release(ast) env_release(env) return ret } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { types_release(ast) env_release(env) return "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } ret = EVAL(body, env) types_release(ast) env_release(env) return ret } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) if (types_heap[idx]["len"] == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": return EVAL_let(ast, env) case "'do": return EVAL_do(ast, env) case "'if": return EVAL_if(ast, env) case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(new_ast) ret = EVAL(ast, env) env_release(env) return ret case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) return "!\"First element of list must be function, supplied " types_typename(f) "." } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function main(str, ret, i) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } rep("(def! not (fn* (a) (if a false true)))") while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step5_tco.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } function eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function main(str, ret, i) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } rep("(def! not (fn* (a) (if a false true)))") while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step6_file.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } function eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function eval(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return EVAL(types_addref(types_heap[idx][1]), repl_env) } function main(str, ret, i, idx) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } env_set(repl_env, "'eval", "&eval") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) if (ARGC > 1) { for (i = 2; i < ARGC; ++i) { types_heap[idx][i - 2] = "\"" ARGV[i] } types_heap[idx]["len"] = ARGC - 2 ARGC = 1 rep("(load-file \"" ARGV[1] "\")") return } types_heap[idx]["len"] = 0 while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step7_quote.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } # Return 0, an error or the unquote argument (second element of ast). function starts_with(ast, sym, idx, len) { 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, new_idx, ret, ast_idx, elt_i, elt, previous) { 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 } ret = starts_with(ast, "'unquote") if (ret ~ /^!/) { types_release(ast) return ret } if (ret) { types_addref(ret) types_release(ast) return ret } new_idx = types_allocate() 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 eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'quote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) env_release(env) return body case "'quasiquote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) ast = quasiquote(body) if (ast ~ /^!/) { env_release(env) return ast } continue case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) f_idx = substr(f, 2) switch (f) { case /^\$/: env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function eval(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return EVAL(types_addref(types_heap[idx][1]), repl_env) } function main(str, ret, i, idx) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } env_set(repl_env, "'eval", "&eval") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) if (ARGC > 1) { for (i = 2; i < ARGC; ++i) { types_heap[idx][i - 2] = "\"" ARGV[i] } types_heap[idx]["len"] = ARGC - 2 ARGC = 1 rep("(load-file \"" ARGV[1] "\")") return } types_heap[idx]["len"] = 0 while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step8_macros.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } # Return 0, an error or the unquote argument (second element of ast). function starts_with(ast, sym, idx, len) { 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, new_idx, ret, ast_idx, elt_i, elt, previous) { 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 } ret = starts_with(ast, "'unquote") if (ret ~ /^!/) { types_release(ast) return ret } if (ret) { types_addref(ret) types_release(ast) return ret } new_idx = types_allocate() 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 eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) types_release(ast) if (ret ~ /^!/) { env_release(env) return ret } if (ret !~ /^\$/) { types_release(ret) env_release(env) return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." } # Replace `ret` with a clone setting the `is_macro` bit. fun_idx = substr(ret, 2) mac_idx = types_allocate() types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) types_heap[mac_idx]["is_macro"] = 1 types_release(ret) ret = "$" mac_idx env_set(env, sym, ret) types_addref(ret) env_release(env) return ret } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'quote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) env_release(env) return body case "'quasiquote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) ast = quasiquote(body) if (ast ~ /^!/) { env_release(env) return ast } continue case "'defmacro!": return EVAL_defmacro(ast, env) case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } f_idx = substr(f, 2) switch (f) { case /^\$/: if (types_heap[f_idx]["is_macro"]) { idx = substr(ast, 2) ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) types_release(ast) if (ret ~ /^!/) { types_release(f) types_release(env) return ret } ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) types_release(ret) types_release(f) continue } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^&/: new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function eval(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return EVAL(types_addref(types_heap[idx][1]), repl_env) } function main(str, ret, i, idx) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } env_set(repl_env, "'eval", "&eval") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) if (ARGC > 1) { for (i = 2; i < ARGC; ++i) { types_heap[idx][i - 2] = "\"" ARGV[i] } types_heap[idx]["len"] = ARGC - 2 ARGC = 1 rep("(load-file \"" ARGV[1] "\")") return } types_heap[idx]["len"] = 0 while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/step9_try.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } # Return 0, an error or the unquote argument (second element of ast). function starts_with(ast, sym, idx, len) { 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, new_idx, ret, ast_idx, elt_i, elt, previous) { 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 } ret = starts_with(ast, "'unquote") if (ret ~ /^!/) { types_release(ast) return ret } if (ret) { types_addref(ret) types_release(ast) return ret } new_idx = types_allocate() 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 eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) types_release(ast) if (ret ~ /^!/) { env_release(env) return ret } if (ret !~ /^\$/) { types_release(ret) env_release(env) return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." } # Replace `ret` with a clone setting the `is_macro` bit. fun_idx = substr(ret, 2) mac_idx = types_allocate() types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) types_heap[mac_idx]["is_macro"] = 1 types_release(ret) ret = "$" mac_idx env_set(env, sym, ret) types_addref(ret) env_release(env) return ret } function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 2 && len != 3) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'try*'. Expects 1 or 2 arguments, supplied" (len - 1) "." } if (len == 2) { ret = EVAL(types_addref(types_heap[idx][1]), env) types_release(ast) env_release(env) return ret } catch = types_heap[idx][2] if (catch !~ /^\(/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 2 of 'try*'. Expects list, supplied " types_typename(catch) "." } catch_idx = substr(catch, 2) if (types_heap[catch_idx]["len"] != 3) { len = types_heap[catch_idx]["len"] types_release(ast) env_release(env) return "!\"Invalid elements count for argument 2 of 'try*'. Expects exactly 3 elements, supplied " len "." } if (types_heap[catch_idx][0] != "'catch*") { str = printer_pr_str(types_heap[catch_idx][0]) types_release(ast) env_release(env) return "!\"Invalid first element of argument 2 of 'try*'. Expects symbol 'catch*', supplied '" str "'." } catch_sym = types_heap[catch_idx][1] if (catch_sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for second element of argument 2 of 'try*'. Expects symbol, supplied " types_typename(catch_sym) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret !~ /^!/) { types_release(ast) env_release(env) return ret } types_addref(catch_body[0] = types_heap[catch_idx][2]) catch_env[0] = env_new(env) env_release(env) env_set(catch_env[0], catch_sym, substr(ret, 2)) types_release(ast) return "" } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'quote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) env_release(env) return body case "'quasiquote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) ast = quasiquote(body) if (ast ~ /^!/) { env_release(env) return ast } continue case "'defmacro!": return EVAL_defmacro(ast, env) case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { return ret } ast = ret_body[0] env = ret_env[0] continue case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } f_idx = substr(f, 2) switch (f) { case /^\$/: if (types_heap[f_idx]["is_macro"]) { idx = substr(ast, 2) ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) types_release(ast) if (ret ~ /^!/) { types_release(f) types_release(env) return ret } ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) types_release(ret) types_release(f) continue } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^&/: new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function eval(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return EVAL(types_addref(types_heap[idx][1]), repl_env) } function main(str, ret, i, idx) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } env_set(repl_env, "'eval", "&eval") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) if (ARGC > 1) { for (i = 2; i < ARGC; ++i) { types_heap[idx][i - 2] = "\"" ARGV[i] } types_heap[idx]["len"] = ARGC - 2 ARGC = 1 rep("(load-file \"" ARGV[1] "\")") return } types_heap[idx]["len"] = 0 while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/stepA_mal.awk ================================================ @include "types.awk" @include "reader.awk" @include "printer.awk" @include "env.awk" @include "core.awk" function READ(str) { return reader_read_str(str) } # Return 0, an error or the unquote argument (second element of ast). function starts_with(ast, sym, idx, len) { 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, new_idx, ret, ast_idx, elt_i, elt, previous) { 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 } ret = starts_with(ast, "'unquote") if (ret ~ /^!/) { types_release(ast) return ret } if (ret) { types_addref(ret) types_release(ast) return ret } new_idx = types_allocate() 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 eval_ast(ast, env, i, idx, len, new_idx, ret) # This function has two distinct purposes. # non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) # vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() if (ast ~ /^\(/) { types_heap[new_idx][0] = "#nil" i = 1 } else { i = 0 } for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i types_release(substr(ast, 1, 1) new_idx) return ret } types_heap[new_idx][i] = ret } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx } function eval_map(ast, env, i, idx, new_idx, ret) { idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { if (i ~ /^[":]/) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release("{" new_idx) return ret } types_heap[new_idx][i] = ret } } return "{" new_idx } function EVAL_def(ast, env, idx, sym, ret, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'def!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) if (ret !~ /^!/) { env_set(env, sym, ret) types_addref(ret) } types_release(ast) env_release(env) return ret } function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] if (params_len % 2 != 0) { types_release(ast) env_release(env) return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len "." } new_env = env_new(env) env_release(env) for (i = 0; i < params_len; i += 2) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(new_env) return "!\"Incompatible type for odd element of argument 1 of 'let*'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env) if (ret ~ /^!/) { types_release(ast) env_release(new_env) return ret } env_set(new_env, sym, ret) } types_addref(body = types_heap[idx][2]) types_release(ast) ret_env[0] = new_env return body } function EVAL_defmacro(ast, env, idx, sym, ret, len, fun_idx, mac_idx) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'defmacro!'. Expects exactly 2 arguments, supplied" (len - 1) "." } sym = types_heap[idx][1] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'defmacro!'. Expects symbol, supplied " types_typename(sym) "." } ret = EVAL(types_addref(types_heap[idx][2]), env) types_release(ast) if (ret ~ /^!/) { env_release(env) return ret } if (ret !~ /^\$/) { types_release(ret) env_release(env) return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "." } # Replace `ret` with a clone setting the `is_macro` bit. fun_idx = substr(ret, 2) mac_idx = types_allocate() types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"]) types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"]) env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"]) types_heap[mac_idx]["is_macro"] = 1 types_release(ret) ret = "$" mac_idx env_set(env, sym, ret) types_addref(ret) env_release(env) return ret } function EVAL_try(ast, env, catch_body, catch_env, idx, catch, catch_idx, catch_sym, ret, len, str) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 2 && len != 3) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'try*'. Expects 1 or 2 arguments, supplied" (len - 1) "." } if (len == 2) { ret = EVAL(types_addref(types_heap[idx][1]), env) types_release(ast) env_release(env) return ret } catch = types_heap[idx][2] if (catch !~ /^\(/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 2 of 'try*'. Expects list, supplied " types_typename(catch) "." } catch_idx = substr(catch, 2) if (types_heap[catch_idx]["len"] != 3) { len = types_heap[catch_idx]["len"] types_release(ast) env_release(env) return "!\"Invalid elements count for argument 2 of 'try*'. Expects exactly 3 elements, supplied " len "." } if (types_heap[catch_idx][0] != "'catch*") { str = printer_pr_str(types_heap[catch_idx][0]) types_release(ast) env_release(env) return "!\"Invalid first element of argument 2 of 'try*'. Expects symbol 'catch*', supplied '" str "'." } catch_sym = types_heap[catch_idx][1] if (catch_sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for second element of argument 2 of 'try*'. Expects symbol, supplied " types_typename(catch_sym) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret !~ /^!/) { types_release(ast) env_release(env) return ret } types_addref(catch_body[0] = types_heap[catch_idx][2]) catch_env[0] = env_new(env) env_release(env) env_set(catch_env[0], catch_sym, substr(ret, 2)) types_release(ast) return "" } function EVAL_do(ast, env, idx, len, i, body, ret) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 1) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "." } for (i = 1; i < len - 1; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_release(ast) env_release(env) return ret } types_release(ret) } types_addref(body = types_heap[idx][len - 1]) types_release(ast) return body } function EVAL_if(ast, env, idx, len, ret, body) { idx = substr(ast, 2) len = types_heap[idx]["len"] if (len != 3 && len != 4) { types_release(ast) return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "." } ret = EVAL(types_addref(types_heap[idx][1]), env) if (ret ~ /^!/) { types_release(ast) return ret } types_release(ret) switch (ret) { case "#nil": case "#false": if (len == 3) { body = "#nil" } else { types_addref(body = types_heap[idx][3]) } break default: types_addref(body = types_heap[idx][2]) break } types_release(ast) return body } function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len) { idx = substr(ast, 2) if (types_heap[idx]["len"] != 3) { len = types_heap[idx]["len"] types_release(ast) env_release(env) return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len - 1) "." } params = types_heap[idx][1] if (params !~ /^[([]/) { types_release(ast) env_release(env) return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename(params) "." } params_idx = substr(params, 2) params_len = types_heap[params_idx]["len"] for (i = 0; i < params_len; ++i) { sym = types_heap[params_idx][i] if (sym !~ /^'/) { types_release(ast) env_release(env) return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename(sym) "." } if (sym == "'&" && i + 2 != params_len) { types_release(ast) env_release(env) return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len ", position of symbol '&' is " (i + 1) "." } } f_idx = types_allocate() types_addref(types_heap[f_idx]["params"] = types_heap[idx][1]) types_addref(types_heap[f_idx]["body"] = types_heap[idx][2]) types_heap[f_idx]["env"] = env types_release(ast) return "$" f_idx } function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { switch (env_get(env, "'DEBUG-EVAL")) { case /^!/: case "#nil": case "#false": break default: print "EVAL: " printer_pr_str(ast, 1) } switch (ast) { case /^'/: # symbol ret = env_get(env, ast) if (ret !~ /^!/) { types_addref(ret) } types_release(ast) env_release(env) return ret case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret case /^\{/: # map ret = eval_map(ast, env) types_release(ast) env_release(env) return ret case /^[^(]/: # not a list types_release(ast) env_release(env) return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] if (len == 0) { env_release(env) return ast } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) case "'let*": ast = EVAL_let(ast, env, ret_env) if (ast ~ /^!/) { return ast } env = ret_env[0] continue case "'quote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) env_release(env) return body case "'quasiquote": if (len != 2) { types_release(ast) env_release(env) return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len - 1) "." } types_addref(body = types_heap[idx][1]) types_release(ast) ast = quasiquote(body) if (ast ~ /^!/) { env_release(env) return ast } continue case "'defmacro!": return EVAL_defmacro(ast, env) case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { return ret } ast = ret_body[0] env = ret_env[0] continue case "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { return ast } continue case "'if": ast = EVAL_if(ast, env) if (ast !~ /^['([{]/) { env_release(env) return ast } continue case "'fn*": return EVAL_fn(ast, env) default: f = EVAL(types_addref(types_heap[idx][0]), env) if (f ~ /^!/) { types_release(ast) env_release(env) return f } f_idx = substr(f, 2) switch (f) { case /^\$/: if (types_heap[f_idx]["is_macro"]) { idx = substr(ast, 2) ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) types_release(ast) if (ret ~ /^!/) { types_release(f) types_release(env) return ret } ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) types_release(ret) types_release(f) continue } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) types_release(f) types_release(new_ast) continue case /^%/: f_idx = types_heap[f_idx]["func"] types_release(f) case /^&/: new_ast = eval_ast(ast, env) types_release(ast) env_release(env) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) ret = "!\"First element of list must be function, supplied " types_typename(f) "." types_release(f) return ret } } } } function PRINT(expr, str) { str = printer_pr_str(expr, 1) types_release(expr) return str } function rep(str, ast, expr) { ast = READ(str) if (ast ~ /^!/) { return ast } expr = EVAL(ast, repl_env) if (expr ~ /^!/) { return expr } return PRINT(expr) } function eval(idx) { if (types_heap[idx]["len"] != 2) { return "!\"Invalid argument length for builtin function 'eval'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "." } return EVAL(types_addref(types_heap[idx][1]), repl_env) } function main(str, ret, i, idx) { repl_env = env_new() for (i in core_ns) { env_set(repl_env, i, core_ns[i]) } env_set(repl_env, "'eval", "&eval") rep("(def! *host-language* \"GNU awk\")") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") idx = types_allocate() env_set(repl_env, "'*ARGV*", "(" idx) if (ARGC > 1) { for (i = 2; i < ARGC; ++i) { types_heap[idx][i - 2] = "\"" ARGV[i] } types_heap[idx]["len"] = ARGC - 2 ARGC = 1 rep("(load-file \"" ARGV[1] "\")") return } types_heap[idx]["len"] = 0 rep("(println (str \"Mal [\" *host-language* \"]\"))") while (1) { printf("user> ") if (getline str <= 0) { break } ret = rep(str) if (ret ~ /^!/) { print "ERROR: " printer_pr_str(substr(ret, 2)) } else { print ret } } } BEGIN { main() env_check(0) #env_dump() #types_dump() exit(0) } ================================================ FILE: impls/awk/tests/step5_tco.mal ================================================ ;; awk: skipping non-TCO recursion ;; Reason: completes up to 50,000 ================================================ FILE: impls/awk/types.awk ================================================ # string" # symbol ' # keyword : # number + # nil # # true # # false # # list ( # vector [ # hash { # atom ? # builtin function & # builtin function with meta % # user defined function $ function types_allocate() { types_heap[types_heap_index]["ref"] = 1 return types_heap_index++ } function types_addref(ast) { if (ast ~ /^[([{$%?]/) { ++types_heap[substr(ast, 2)]["ref"] } return ast } function types_release(ast, idx, ref, i, len) { switch (ast) { case /^[([]/: idx = substr(ast, 2) ref = --types_heap[idx]["ref"] if (ref <= 0) { if (ref < 0) { print "ref count error:" ast ", " ref } len = types_heap[idx]["len"] for (i = 0; i < len; ++i) { types_release(types_heap[idx][i]) } types_release(types_heap[idx]["meta"]) delete types_heap[idx] } return case /^\{/: idx = substr(ast, 2) ref = --types_heap[idx]["ref"] if (ref <= 0) { if (ref < 0) { print "ref count error:" ast ", " ref } for (i in types_heap[idx]) { if (i ~ /^[":]/) { types_release(types_heap[idx][i]) } } types_release(types_heap[idx]["meta"]) delete types_heap[idx] } return case /^\$/: idx = substr(ast, 2) ref = --types_heap[idx]["ref"] if (ref <= 0) { if (ref < 0) { print "ref count error:" ast ", " ref } types_release(types_heap[idx]["params"]) types_release(types_heap[idx]["body"]) types_release(types_heap[idx]["meta"]) env_release(types_heap[idx]["env"]) delete types_heap[idx] } return case /^%/: idx = substr(ast, 2) ref = --types_heap[idx]["ref"] if (ref <= 0) { if (ref < 0) { print "ref count error:" ast ", " ref } types_release(types_heap[idx]["meta"]) delete types_heap[idx] } return case /^\?/: idx = substr(ast, 2) ref = --types_heap[idx]["ref"] if (ref <= 0) { if (ref < 0) { print "ref count error:" ast ", " ref } types_release(types_heap[idx]["obj"]) delete types_heap[idx] } } } function types_check(val, idx, len, i) { if (val !~ /^[([{?%$]/) { return } idx = substr(val, 2) if (!(idx in types_heap)) { print "dangling reference " val return } if (types_heap[idx]["checked"]++) { return } #types_heap[idx]["checked"] = 1 switch (val) { case /^[([]/: if (!("len" in types_heap[idx])) { print "length not found in " val return } len = types_heap[idx]["len"] for (i = 0; i < len; ++i) { if (!(i in types_heap[idx])) { print "sequence corrupted in " val " of " i } else { types_check(types_heap[idx][i]) } } types_check(types_heap[idx]["meta"]) return case /^\{/: for (i in types_heap[idx]) { if (i != "ref") { types_check(types_heap[idx][i]) } } return case /^\?/: if (!("obj" in types_heap[idx])) { print "atom corrupted in " val } else { types_check(types_heap[idx]["obj"]) } types_check(types_heap[idx]["meta"]) return case /^%/: if (!("func" in types_heap[idx])) { print "function corrupted in " val } else { types_check(types_heap[idx]["func"]) } types_check(types_heap[idx]["meta"]) return case /^\$/: if (!("body" in types_heap[idx])) { print "function body corrupted in " val } else { types_check(types_heap[idx]["body"]) } if (!("params" in types_heap[idx])) { print "function params corrupted in " val } else { types_check(types_heap[idx]["params"]) } if (!("env" in types_heap[idx])) { print "function env corrupted in " val } else { env_check(types_heap[idx]["env"]) } types_check(types_heap[idx]["meta"]) return default: print "unknown type " val return } } function types_dump(i, j) { for (i = 0; i < types_heap_index; i++) { if (i in types_heap) { if (isarray(types_heap[i])) { if (!("checked" in types_heap[i]) || types_heap[i]["checked"] != types_heap[i]["ref"]) { for (j in types_heap[i]) { print " types_heap[" i "][" j "] = " types_heap[i][j] } } } else { print " types_heap[" i "] = " types_heap[i] } } } } function types_typename(str) { switch (str) { case /^"/: return "string" case /^'/: return "symbol" case /^:/: return "keyword" case /^\+/: return "number" case /^#nil$/: return "nil" case /^#true$/: return "true" case /^#false$/: return "false" case /^\(/: return "list" case /^\[/: return "vector" case /^\{/: return "hash" case /^\?/: return "atom" case /^[&%]/: return "builtin function" case /^\$/: return "user defined function" } } BEGIN { types_heap_index = 0 } ================================================ FILE: impls/bash/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Nothing additional needed for bash ================================================ FILE: impls/bash/Makefile ================================================ SOURCES_BASE = types.sh reader.sh printer.sh SOURCES_LISP = env.sh core.sh stepA_mal.sh SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.sh mal mal.sh: $(SOURCES) cat $+ | grep -v "^source " > $@ mal: mal.sh echo "#!/usr/bin/env bash" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.sh mal ================================================ FILE: impls/bash/core.sh ================================================ # # mal (Make a Lisp) object types # if [ -z "${__mal_core_included__}" ]; then __mal_core_included=true source $(dirname $0)/types.sh source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh # Exceptions/Errors throw() { __ERROR="${1}" r= } # General functions obj_type () { _obj_type "${1}" _string "${r}" } equal? () { _equal? "${1}" "${2}" && r="${__true}" || r="${__false}" } # Scalar functions nil? () { _nil? "${1}" && r="${__true}" || r="${__false}"; } true? () { _true? "${1}" && r="${__true}" || r="${__false}"; } false? () { _false? "${1}" && r="${__true}" || r="${__false}"; } # Symbol functions symbol () { _symbol "${ANON["${1}"]}"; } symbol? () { _symbol? "${1}" && r="${__true}" || r="${__false}"; } # Keyword functions keyword () { _keyword "${ANON["${1}"]}"; } keyword? () { _keyword? "${1}" && r="${__true}" || r="${__false}"; } # Number functions number? () { _number? "${1}" && r="${__true}" || r="${__false}"; } num_plus () { r=$(( ${ANON["${1}"]} + ${ANON["${2}"]} )); _number "${r}"; } num_minus () { r=$(( ${ANON["${1}"]} - ${ANON["${2}"]} )); _number "${r}"; } num_multiply () { r=$(( ${ANON["${1}"]} * ${ANON["${2}"]} )); _number "${r}"; } num_divide () { r=$(( ${ANON["${1}"]} / ${ANON["${2}"]} )); _number "${r}"; } _num_bool () { [[ "${1}" = "1" ]] && r="${__true}" || r="${__false}"; } num_gt () { r=$(( ${ANON["${1}"]} > ${ANON["${2}"]} )); _num_bool "${r}"; } num_gte () { r=$(( ${ANON["${1}"]} >= ${ANON["${2}"]} )); _num_bool "${r}"; } num_lt () { r=$(( ${ANON["${1}"]} < ${ANON["${2}"]} )); _num_bool "${r}"; } num_lte () { r=$(( ${ANON["${1}"]} <= ${ANON["${2}"]} )); _num_bool "${r}"; } # return number of milliseconds since epoch time_ms () { local ms=$(date +%s%3N) _number "${ms}" } # String functions string? () { _string? "${1}" && ( ! _keyword? "${1}" ) && r="${__true}" || r="${__false}"; } pr_str () { local res="" for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done _string "${res:1}" } str () { local res="" for x in "${@}"; do _pr_str "${x}"; res="${res}${r}"; done _string "${res}" } prn () { local res="" for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done echo "${res:1}" r="${__nil}"; } println () { local res="" for x in "${@}"; do _pr_str "${x}"; res="${res} ${r}"; done echo "${res:1}" r="${__nil}"; } readline () { READLINE "${ANON["${1}"]}" && _string "${r}" || r="${__nil}" } read_string () { READ_STR "${ANON["${1}"]}" } slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} _string "${text}" } # Function functions function? () { _function? "${1}" && [ -z "${ANON["${1}_ismacro_"]}" ] && r="${__true}" || r="${__false}"; } macro? () { _function? "${1}" && [ "${ANON["${1}_ismacro_"]}" ] && r="${__true}" || r="${__false}"; } # List functions list? () { _list? "${1}" && r="${__true}" || r="${__false}"; } # Vector functions (same as lists for now) vector? () { _vector? "${1}" && r="${__true}" || r="${__false}"; } # Hash map (associative array) functions hash_map? () { _hash_map? "${1}" && r="${__true}" || r="${__false}"; } # Return new hash map with keys/values updated assoc () { if ! _hash_map? "${1}"; then _error "assoc onto non-hash-map" return fi _copy_hash_map "${1}"; shift local name="${r}" local obj=${ANON["${name}"]} declare -A -g ${obj} while [[ "${1}" ]]; do eval ${obj}[\"${ANON["${1}"]}\"]=\"${2}\" shift; shift done r="${name}" } dissoc () { if ! _hash_map? "${1}"; then _error "dissoc from non-hash-map" return fi _copy_hash_map "${1}"; shift local name="${r}" local obj=${ANON["${name}"]} declare -A -g ${obj} while [[ "${1}" ]]; do eval unset ${obj}[\"${ANON["${1}"]}\"] shift done r="${name}" } _get () { _obj_type "${1}"; local ot="${r}" case "${ot}" in hash_map) local obj="${ANON["${1}"]}" eval r="\${${obj}[\"${2}\"]}" ;; list|vector) _nth "${1}" "${2}" ;; nil) r="${__nil}" ;; esac } get () { _get "${1}" "${ANON["${2}"]}" [[ "${r}" ]] || r="${__nil}" } contains? () { _contains? "${1}" "${ANON["${2}"]}" && r="${__true}" || r="${__false}"; } keys () { local obj="${ANON["${1}"]}" local kstrs= eval local keys="\${!${obj}[@]}" for k in ${keys}; do _string "${k}" kstrs="${kstrs} ${r}" done __new_obj_hash_code r="list_${r}" ANON["${r}"]="${kstrs:1}" } vals () { local obj="${ANON["${1}"]}" local kvals= local val= eval local keys="\${!${obj}[@]}" for k in ${keys}; do eval val="\${${obj}["\${k}"]}" kvals="${kvals} ${val}" done __new_obj_hash_code r="list_${r}" ANON["${r}"]="${kvals:1}" } # sequence operations sequential? () { _sequential? "${1}" && r="${__true}" || r="${__false}" } cons () { _list ${1} ${ANON["${2}"]} } concat () { _list local acc="" for item in "${@}"; do acc="${acc} ${ANON["${item}"]}" done ANON["${r}"]="${acc:1}" } nth () { _nth "${1}" "${ANON["${2}"]}" if [ -z "${r}" ]; then _error "nth: index out of bounds" return fi } empty? () { _empty? "${1}" && r="${__true}" || r="${__false}"; } count () { _count "${1}" _number "${r}" } apply () { local f="${ANON["${1}"]}"; shift local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}" eval ${f%%@*} ${items} } # Takes a function object and an list object and invokes the function # on each element of the list, returning a new list of the results. map () { local f="${ANON["${1}"]}"; shift #echo _map "${f}" "${@}" _map "${f}" "${@}" } conj () { local obj="${1}"; shift local obj_data="${ANON["${obj}"]}" __new_obj_like "${obj}" if _list? "${obj}"; then ANON["${r}"]="${obj_data:+${obj_data}}" for elem in ${@}; do ANON["${r}"]="${elem} ${ANON["${r}"]}" done else ANON["${r}"]="${obj_data:+${obj_data} }${*}" fi } seq () { local obj="${1}"; shift local obj_data="${ANON["${obj}"]}" if _list? "${obj}"; then _count "${obj}" if [ "${r}" -eq 0 ]; then r="${__nil}"; return; fi r="${obj}" elif _vector? "${obj}"; then _count "${obj}" if [ "${r}" -eq 0 ]; then r="${__nil}"; return; fi __new_obj_hash_code r="list_${r}" ANON["${r}"]="${obj_data}" elif _string? "${obj}"; then if [ "${#obj_data}" -eq 0 ]; then r="${__nil}"; return; fi local i=0 acc="" for (( i=0; i < ${#obj_data}; i++ )); do _string "${obj_data:$i:1}" acc="${acc} ${r}" done _list ANON["${r}"]="${acc:1}" elif _nil? "${obj}"; then r="${__nil}" else throw "seq: called on non-sequence" fi } # Metadata functions with_meta () { local obj="${1}"; shift local meta_data="${1}"; shift __new_obj_like "${obj}" ANON["${r}"]="${ANON["${obj}"]}" local meta_obj="meta_${r#*_}" ANON["${meta_obj}"]="${meta_data}" } meta () { r="${ANON["meta_${1#*_}"]}" [[ "${r}" ]] || r="${__nil}" } # Atom functions atom? () { _atom? "${1}" && r="${__true}" || r="${__false}"; } deref () { # TODO: double-check atom type r=${ANON["${1}"]} } reset_BANG () { local atm="${1}"; shift ANON["${atm}"]="${*}" r="${*}" } swap_BANG () { local atm="${1}"; shift local f="${ANON["${1}"]}"; shift ${f%%@*} "${ANON["${atm}"]}" "${@}" ANON["${atm}"]="${r}" } # Namespace of core functions declare -A core_ns=( [type]=obj_type [=]=equal? [throw]=throw [nil?]=nil? [true?]=true? [false?]=false? [string?]=string? [symbol]=symbol [symbol?]=symbol? [keyword]=keyword [keyword?]=keyword? [number?]=number? [fn?]=function? [macro?]=macro? [pr-str]=pr_str [str]=str [prn]=prn [println]=println [readline]=readline [read-string]=read_string [slurp]=slurp ['<']=num_lt ['<=']=num_lte ['>']=num_gt ['>=']=num_gte [+]=num_plus [-]=num_minus [__STAR__]=num_multiply [/]=num_divide [time-ms]=time_ms [list]=_list [list?]=list? [vector]=_vector [vector?]=vector? [hash-map]=_hash_map [map?]=hash_map? [assoc]=assoc [dissoc]=dissoc [get]=get [contains?]=contains? [keys]=keys [vals]=vals [sequential?]=sequential? [cons]=cons [concat]=concat [vec]=vec [nth]=nth [first]=_first [rest]=_rest [empty?]=empty? [count]=count [apply]=apply [map]=map [conj]=conj [seq]=seq [with-meta]=with_meta [meta]=meta [atom]=_atom [atom?]=atom? [deref]=deref [reset!]=reset_BANG [swap!]=swap_BANG) fi ================================================ FILE: impls/bash/env.sh ================================================ # # mal (Make a Lisp) environment definition # if [ -z "${__mal_env_included__}" ]; then __mal_env_included=true source $(dirname $0)/types.sh # Any environment is a hash_map with an __outer__ key that refers to # a parent environment (or nil) ENV () { r= _hash_map local env="${r}" if [[ "${1}" ]]; then outer="${1}"; shift _assoc! "${env}" "__outer__" "${outer}" else _assoc! "${env}" "__outer__" "${__nil}" fi r="${env}" if [[ "${1}" && "${@}" ]]; then local binds=(${ANON["${1}"]}); shift local idx=0 while [[ "${binds["${idx}"]}" ]]; do local fp="${ANON["${binds["${idx}"]}"]}" if [[ "${fp}" == "&" ]]; then idx=$(( idx + 1 )) fp="${ANON["${binds["${idx}"]}"]}" _list "${@}" _assoc! "${env}" "${fp}" "${r}" break else _assoc! "${env}" "${fp}" "${1}" shift idx=$(( idx + 1 )) fi done fi r="${env}" } # Find the environment with the key set and return the environment ENV_FIND () { if _contains? "${1}" "${ANON["${2}"]}"; then r="${1}" else local obj="${ANON["${1}"]}" eval 'local outer=${'${obj}'["__outer__"]}' if [[ "${outer}" && "${outer}" != "${__nil}" ]]; then ENV_FIND "${outer}" "${2}" else r= fi fi } # Find the environment with the key set and return the value of the # key in that environment. If no environment contains the key then # return an error ENV_GET () { ENV_FIND "${1}" "${2}" local env="${r}" local key="${ANON["${2}"]}" if [[ "${r}" ]]; then local obj="${ANON["${env}"]}" eval 'r=${'${obj}'["'${key}'"]}' else _error "'${key}' not found" fi } ENV_SET () { local key="${ANON["${2}"]}" _assoc! "${1}" "${key}" "${3}" } fi ================================================ FILE: impls/bash/printer.sh ================================================ # # mal (Make a Lisp) printer # if [ -z "${__mal_printer_included__}" ]; then __mal_printer_included=true source $(dirname $0)/types.sh _pr_str () { local print_readably="${2}" _obj_type "${1}"; local ot="${r}" if [[ -z "${ot}" ]]; then _error "_pr_str failed on '${1}'" r="<${1}>" else eval ${ot}_pr_str "${1}" "${print_readably}" fi } nil_pr_str () { r="nil"; } true_pr_str () { r="true"; } false_pr_str () { r="false"; } number_pr_str () { r="${ANON["${1}"]}"; } symbol_pr_str () { r="${ANON["${1}"]}" r="${r//__STAR__/*}" } keyword_pr_str () { string_pr_str "${1}" } _raw_string_pr_str () { local s="${1}" local print_readably="${2}" if [[ "${s:0:1}" = "${__keyw}" ]]; then r=":${s:1}" elif [[ "${s:0:2}" = "${__keyw}" ]]; then r=":${s:2}" elif [ "${print_readably}" == "yes" ]; then s="${s//\\/\\\\}" s="${s//\"/\\\"}" r="\"${s//$'\n'/\\n}\"" else r="${s}" fi r="${r//__STAR__/$'*'}" } string_pr_str () { _raw_string_pr_str "${ANON["${1}"]}" "${2}" } function_pr_str () { r="${ANON["${1}"]}"; } bash_pr_str () { r="$(declare -f -p ${1})" } hash_map_pr_str () { local print_readably="${2}" local res=""; local val="" local hm="${ANON["${1}"]}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do _raw_string_pr_str "${key}" "${print_readably}" res="${res} ${r}" eval val="\${${hm}[\"${key}\"]}" _pr_str "${val}" "${print_readably}" res="${res} ${r}" done r="{${res:1}}" } vector_pr_str () { local print_readably="${2}" local res="" for elem in ${ANON["${1}"]}; do _pr_str "${elem}" "${print_readably}" res="${res} ${r}" done r="[${res:1}]" } list_pr_str () { local print_readably="${2}" local res="" for elem in ${ANON["${1}"]}; do _pr_str "${elem}" "${print_readably}" res="${res} ${r}" done r="(${res:1})" } atom_pr_str () { local print_readably="${2}" _pr_str "${ANON["${1}"]}" "${print_readably}" r="(atom ${r})"; } fi ================================================ FILE: impls/bash/reader.sh ================================================ # # mal (Make Lisp) Parser/Reader # if [ -z "${__mal_readerr_included__}" ]; then __mal_readerr_included=true source $(dirname $0)/types.sh READ_ATOM () { local token=${__reader_tokens[${__reader_idx}]} __reader_idx=$(( __reader_idx + 1 )) case "${token}" in [0-9]*) _number "${token}" ;; -[0-9]*) _number "${token}" ;; \"*) if [[ ! "${token}" =~ ^\"(\\.|[^\\\"])*\"$ ]]; then _error "expected '\"', got EOF" return fi token="${token:1:-1}" token="${token//\\\\/${__keyw}}" token="${token//\\\"/\"}" token="${token//\\n/$'\n'}" token="${token//${__keyw}/\\}" _string "${token}" ;; :*) _keyword "${token:1}" ;; nil) r="${__nil}" ;; true) r="${__true}" ;; false) r="${__false}" ;; *) _symbol "${token}" ;; esac } # Return seqence of tokens into r. # ${1}: Type of r (vector, list) # ${2}: starting symbol # ${3}: ending symbol READ_SEQ () { local start="${1}" local end="${2}" local items="" local token=${__reader_tokens[${__reader_idx}]} __reader_idx=$(( __reader_idx + 1 )) if [[ "${token}" != "${start}" ]]; then r= _error "expected '${start}'" return fi token=${__reader_tokens[${__reader_idx}]} while [[ "${token}" != "${end}" ]]; do if [[ ! "${token}" ]]; then r= _error "expected '${end}', got EOF" return fi READ_FORM items="${items} ${r}" token=${__reader_tokens[${__reader_idx}]} done __reader_idx=$(( __reader_idx + 1 )) r="${items:1}" } # Return form in r READ_FORM () { local token=${__reader_tokens[${__reader_idx}]} case "${token}" in \') __reader_idx=$(( __reader_idx + 1 )) _symbol quote; local q="${r}" READ_FORM; local f="${r}" _list "${q}" "${f}" ;; \`) __reader_idx=$(( __reader_idx + 1 )) _symbol quasiquote; local q="${r}" READ_FORM; local f="${r}" _list "${q}" "${f}" ;; \~) __reader_idx=$(( __reader_idx + 1 )) _symbol unquote; local q="${r}" READ_FORM; local f="${r}" _list "${q}" "${f}" ;; \~\@) __reader_idx=$(( __reader_idx + 1 )) _symbol splice-unquote; local q="${r}" READ_FORM; local f="${r}" _list "${q}" "${f}" ;; ^) __reader_idx=$(( __reader_idx + 1 )) _symbol with-meta; local wm="${r}" READ_FORM; local meta="${r}" READ_FORM; local obj="${r}" _list "${wm}" "${obj}" "${meta}" ;; @) __reader_idx=$(( __reader_idx + 1 )) _symbol deref; local d="${r}" READ_FORM; local f="${r}" _list "${d}" "${f}" ;; \)) _error "unexpected ')'" ;; \() READ_SEQ "(" ")" _list ${r} ;; \]) _error "unexpected ']'" ;; \[) READ_SEQ "[" "]" _vector ${r} ;; \}) _error "unexpected '}'" ;; \{) READ_SEQ "{" "}" _hash_map ${r} ;; *) READ_ATOM esac } TOKEN_PAT=$'^^([][{}\\(\\)^@])|^(~@)|^("(\\\\.|[^\\"])*"?)|^(;[^\n]*)|^([~\'`])|^([^][ ~`\'";{}\\(\\)^@,\n]+)|^(,)|^([[:space:]]+)' # Returns __reader_tokens as an indexed array of tokens TOKENIZE () { local data="${*}" local datalen=${#data} local idx=0 local chunk=0 local chunksz=500 local token= local str= __reader_idx=0 declare -a -g __reader_tokens=() # global array while true; do if (( ${#str} < ( chunksz / 2) )) && (( chunk < datalen )); then str="${str}${data:${chunk}:${chunksz}}" chunk=$(( chunk + ${chunksz} )) fi (( ${#str} == 0 )) && break [[ "${str}" =~ ${TOKEN_PAT} ]] token=${BASH_REMATCH[0]} str="${str:${#token}}" token="${token}" #echo "MATCH: '${token}' / [${str}]" if ! [[ "${token}" =~ (^[,]$|^[[:space:]]*;.*$|^[[:space:]]*$) ]]; then __reader_tokens[${idx}]="${token}" idx=$(( idx + 1 )) fi if [ -z "${token}" ]; then _error "Tokenizing error at: ${str:0:50}" return 1 fi done } # read-str from a raw "string" or from a string object. Retruns object # read in r. READ_STR () { declare -a __reader_tokens TOKENIZE "${*}" || return 1 # sets __reader_tokens #set | grep ^__reader_tokens if [ -z "${__reader_tokens[0]}" ]; then r= return 1 # No tokens fi READ_FORM #echo "Token: ${r}: <${ANON["${r}"]}>" return } # Call readline and save the history. Returns the string read in r. READLINE_EOF= READLINE_HISTORY_FILE=${HOME}/.mal-history READLINE () { history -r "${READLINE_HISTORY_FILE}" 2>/dev/null || true read -r -e -p "${1}" r || return "$?" history -s -- "${r}" history -a "${READLINE_HISTORY_FILE}" 2>/dev/null || true } fi ================================================ FILE: impls/bash/run ================================================ #!/usr/bin/env bash exec bash $(dirname $0)/${STEP:-stepA_mal}.sh "${@}" ================================================ FILE: impls/bash/step0_repl.sh ================================================ #!/usr/bin/env bash READ () { read -u 0 -e -p "user> " r } EVAL () { r="${1}" } PRINT () { r="${1}" } while true; do READ EVAL "${r}" PRINT "${r}" echo "${r}" done ================================================ FILE: impls/bash/step1_read_print.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval EVAL () { local ast="${1}" local env="${2}" r= [[ "${__ERROR}" ]] && return 1 r="${ast}" } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" no r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl REP () { READ "${1}" EVAL "${r}" PRINT "${r}" } # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step2_eval.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval EVAL () { local ast="${1}" env="${2}" #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) local val="${ANON["${ast}"]}" eval r="\${${env}["${val}"]}" [ "${r}" ] || _error "'${val}' not found" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && return 1 local el="${r}" _first "${el}"; local f="${r}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: ${f} ${args}" eval ${f} ${args} } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl declare -A REPL_ENV REP () { r= READ "${1}" EVAL "${r}" REPL_ENV PRINT "${r}" } plus () { r=$(( ${ANON["${1}"]} + ${ANON["${2}"]} )); _number "${r}"; } minus () { r=$(( ${ANON["${1}"]} - ${ANON["${2}"]} )); _number "${r}"; } multiply () { r=$(( ${ANON["${1}"]} * ${ANON["${2}"]} )); _number "${r}"; } divide () { r=$(( ${ANON["${1}"]} / ${ANON["${2}"]} )); _number "${r}"; } REPL_ENV["+"]=plus REPL_ENV["-"]=minus REPL_ENV["__STAR__"]=multiply REPL_ENV["/"]=divide # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step3_env.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval _symbol DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done EVAL "${a2}" "${let_env}" return ;; *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${r}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: ${f} ${args}" eval ${f} ${args} return ;; esac } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } plus () { r=$(( ${ANON["${1}"]} + ${ANON["${2}"]} )); _number "${r}"; } minus () { r=$(( ${ANON["${1}"]} - ${ANON["${2}"]} )); _number "${r}"; } multiply () { r=$(( ${ANON["${1}"]} * ${ANON["${2}"]} )); _number "${r}"; } divide () { r=$(( ${ANON["${1}"]} / ${ANON["${2}"]} )); _number "${r}"; } _symbol "+"; ENV_SET "${REPL_ENV}" "${r}" plus _symbol "-"; ENV_SET "${REPL_ENV}" "${r}" minus _symbol "__STAR__"; ENV_SET "${REPL_ENV}" "${r}" multiply _symbol "/"; ENV_SET "${REPL_ENV}" "${r}" divide # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step4_if_fn_do.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval _symbol DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done EVAL "${a2}" "${let_env}" return ;; do) _rest "${ast}" _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${r}" return ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then EVAL "${a3}" "${env}" else r="${__nil}" fi else # eval true condition EVAL "${a2}" "${env}" fi return ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" return ;; *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: ${f} ${args}" eval ${f} ${args} return ;; esac } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step5_tco.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval _symbol DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step6_file.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval _symbol DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done _eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval _list; argv="${r}" for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done _symbol "__STAR__ARGV__STAR__" ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then REP "(load-file \"${1}\")" exit 0 fi # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step7_quote.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval starts_with () { _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { _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 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 DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; quote) r="${a1}" return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" # Continue loop ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) _map_with_type _list EVAL "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 local el="${r}" _first "${el}"; local f="${ANON["${r}"]}" _rest "${el}"; local args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done _eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval _list; argv="${r}" for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done _symbol "__STAR__ARGV__STAR__" ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then REP "(load-file \"${1}\")" exit 0 fi # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step8_macros.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval starts_with () { _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { _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 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 DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; quote) r="${a1}" return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" # Continue loop ;; defmacro!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 local func="${r}" __new_obj_like "${func}" ANON["${r}"]="${ANON["${func}"]}" ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) EVAL "${a0}" "${env}" [[ "${__ERROR}" ]] && return 1 local f="${r}" _rest "${ast}" # Should cause no error as ast is not empty. local args="${r}" if [ "${ANON["${f}_ismacro_"]}" ]; then f="${ANON["${f}"]}" ${f%%@*} ${ANON["${args}"]} ast="${r}" continue fi f="${ANON["${f}"]}" _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done _eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval _list; argv="${r}" for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done _symbol "__STAR__ARGV__STAR__" ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then REP "(load-file \"${1}\")" exit 0 fi # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/step9_try.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval starts_with () { _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { _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 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 DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; quote) r="${a1}" return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" # Continue loop ;; defmacro!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 local func="${r}" __new_obj_like "${func}" ANON["${r}"]="${ANON["${func}"]}" ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; try__STAR__) EVAL "${a1}" "${env}" [[ -z "${__ERROR}" ]] && return _nth "${a2}" 0; local a20="${r}" if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then _nth "${a2}" 1; local a21="${r}" _nth "${a2}" 2; local a22="${r}" _list "${a21}"; local binds="${r}" ENV "${env}" "${binds}" "${__ERROR}" local try_env="${r}" __ERROR= EVAL "${a22}" "${try_env}" fi # if no catch* clause, just propagate __ERROR return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) EVAL "${a0}" "${env}" [[ "${__ERROR}" ]] && return 1 local f="${r}" _rest "${ast}" # Should cause no error as ast is not empty. local args="${r}" if [ "${ANON["${f}_ismacro_"]}" ]; then f="${ANON["${f}"]}" ${f%%@*} ${ANON["${args}"]} ast="${r}" continue fi f="${ANON["${f}"]}" _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done _eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval _list; argv="${r}" for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done _symbol "__STAR__ARGV__STAR__" ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then REP "(load-file \"${1}\")" exit 0 fi # repl loop while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/stepA_mal.sh ================================================ #!/usr/bin/env bash source $(dirname $0)/reader.sh source $(dirname $0)/printer.sh source $(dirname $0)/env.sh source $(dirname $0)/core.sh # read READ () { [ "${1}" ] && r="${1}" || READLINE READ_STR "${r}" } # eval starts_with () { _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { _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 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 DEBUG-EVAL; debug_eval="$r" EVAL () { local ast="${1}" env="${2}" while true; do r= ENV_GET "$env" "$debug_eval" if [ -n "$__ERROR" ]; then __ERROR= elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then _pr_str "$ast" yes; echo "EVAL: $r / $env" fi _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) ;; vector) _map_with_type _vector EVAL "${ast}" "${env}" return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" return ;; *) r="${ast}" return ;; esac # apply list _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" _nth "${ast}" 1; local a1="${r}" _nth "${ast}" 2; local a2="${r}" case "${ANON["${a0}"]}" in def!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 ENV_SET "${env}" "${a1}" "${r}" return ;; let__STAR__) ENV "${env}"; local let_env="${r}" local let_pairs=(${ANON["${a1}"]}) local idx=0 #echo "let: [${let_pairs[*]}] for ${a2}" while [[ "${let_pairs["${idx}"]}" ]]; do EVAL "${let_pairs[$(( idx + 1))]}" "${let_env}" ENV_SET "${let_env}" "${let_pairs[${idx}]}" "${r}" idx=$(( idx + 2)) done ast="${a2}" env="${let_env}" # Continue loop ;; quote) r="${a1}" return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" # Continue loop ;; defmacro!) EVAL "${a2}" "${env}" [[ "${__ERROR}" ]] && return 1 local func="${r}" __new_obj_like "${func}" ANON["${r}"]="${ANON["${func}"]}" ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; sh__STAR__) EVAL "${a1}" "${env}" local output="" local line="" r="${ANON["${r}"]}" r="${r//__STAR__/*}" while read -r line || [ -n "${line}" ]; do output="${output}${line}"$'\n' done < <(eval "${r}") _string "${output%$'\n'}" return ;; try__STAR__) EVAL "${a1}" "${env}" [[ -z "${__ERROR}" ]] && return _nth "${a2}" 0; local a20="${r}" if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then _nth "${a2}" 1; local a21="${r}" _nth "${a2}" 2; local a22="${r}" _list "${a21}"; local binds="${r}" ENV "${env}" "${binds}" "${__ERROR}" local try_env="${r}" __ERROR= EVAL "${a22}" "${try_env}" fi # if no catch* clause, just propagate __ERROR return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" # Continue loop ;; if) EVAL "${a1}" "${env}" [[ "${__ERROR}" ]] && return 1 if [[ "${r}" == "${__false}" || "${r}" == "${__nil}" ]]; then # eval false form _nth "${ast}" 3; local a3="${r}" if [[ "${a3}" ]]; then ast="${a3}" else r="${__nil}" return fi else # eval true condition ast="${a2}" fi # Continue loop ;; fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; *) EVAL "${a0}" "${env}" [[ "${__ERROR}" ]] && return 1 local f="${r}" _rest "${ast}" # Should cause no error as ast is not empty. local args="${r}" if [ "${ANON["${f}_ismacro_"]}" ]; then f="${ANON["${f}"]}" ${f%%@*} ${ANON["${args}"]} ast="${r}" continue fi f="${ANON["${f}"]}" _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 args="${ANON["${r}"]}" #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } ast="${2}" ENV "${3}" "${4}" ${args} env="${r}" else eval ${f%%@*} ${args} return fi # Continue loop ;; esac done } # print PRINT () { if [[ "${__ERROR}" ]]; then _pr_str "${__ERROR}" yes r="Error: ${r}" __ERROR= else _pr_str "${1}" yes fi } # repl ENV; REPL_ENV="${r}" REP () { r= READ "${1}" EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } # core.sh: defined using bash _fref () { _symbol "${1}"; local sym="${r}" _function "${2} \"\${@}\"" ENV_SET "${REPL_ENV}" "${sym}" "${r}" } for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done _eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval _list; argv="${r}" for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done _symbol "__STAR__ARGV__STAR__" ENV_SET "${REPL_ENV}" "${r}" "${argv}"; # core.mal: defined using the language itself REP "(def! *host-language* \"bash\")" REP "(def! not (fn* (a) (if a false true)))" REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" # load/run file from command line (then exit) if [[ "${1}" ]]; then REP "(load-file \"${1}\")" exit 0 fi # repl loop REP "(println (str \"Mal [\" *host-language* \"]\"))" while true; do READLINE "user> " || exit "$?" [[ "${r}" ]] && REP "${r}" && echo "${r}" done ================================================ FILE: impls/bash/tests/stepA_mal.mal ================================================ ;; Testing basic bash interop (sh* "echo 7") ;=>"7" (sh* "echo >&2 hello") ;/hello ;=>"" (sh* "foo=8; echo ${foo}") ;=>"8" (sh* "for x in a b c; do echo -n \"X${x}Y \"; done; echo") ;=>"XaY XbY XcY" (sh* "for x in 1 2 3; do echo -n \"$((1+$x)) \"; done; echo") ;=>"2 3 4" (sh* "for x in {1..10}; do echo $x; done") ;=>"1\n2\n3\n4\n5\n6\n7\n8\n9\n10" (sh* "echo -n {1..3}") ;=>"1 2 3" (sh* "echo hello; echo foo; echo yes;") ;=>"hello\nfoo\nyes" (sh* "grep -oE '\[.*!\]' core.sh") ;=>"[reset!]\n[swap!]" (sh* "ls cor*.sh") ;=>"core.sh" ================================================ FILE: impls/bash/types.sh ================================================ # # mal (Make a Lisp) object types # if [ -z "${__mal_types_included__}" ]; then __mal_types_included=true declare -A ANON __obj_magic=__5bal7 __keyw=$(echo -en "\xCA\x9E") # \u029E __obj_hash_code=${__obj_hash_code:-0} __new_obj_hash_code () { __obj_hash_code=$(( __obj_hash_code + 1)) r="${__obj_hash_code}" } __new_obj () { __new_obj_hash_code r="${1}_${r}" } __new_obj_like () { __new_obj_hash_code r="${1%_*}_${r}" } # Errors/Exceptions __ERROR= _error() { _string "${1}" __ERROR="${r}" r= } # # General functions # # Return the type of the object (or "make" if it's not a object _obj_type () { local type="${1:0:4}" r= case "${type}" in symb) r="symbol" ;; list) r="list" ;; numb) r="number" ;; func) r="function" ;; strn) local s="${ANON["${1}"]}" if [[ "${1:0:1}" = "${__keyw}" ]] \ || [[ "${1:0:2}" = "${__keyw}" ]]; then r="keyword" else r="string" fi ;; _nil) r="nil" ;; true) r="true" ;; fals) r="false" ;; vect) r="vector" ;; hmap) r="hash_map" ;; atom) r="atom" ;; undf) r="undefined" ;; *) r="bash" ;; esac } _equal? () { _obj_type "${1}"; local ot1="${r}" _obj_type "${2}"; local ot2="${r}" if [[ "${ot1}" != "${ot2}" ]]; then if ! _sequential? "${1}" || ! _sequential? "${2}"; then return 1 fi fi case "${ot1}" in string|symbol|keyword|number) [[ "${ANON["${1}"]}" == "${ANON["${2}"]}" ]] ;; list|vector) _count "${1}"; local sz1="${r}" _count "${2}"; local sz2="${r}" [[ "${sz1}" == "${sz2}" ]] || return 1 local a1=(${ANON["${1}"]}) local a2=(${ANON["${2}"]}) for ((i=0;i<${#a1[*]};i++)); do _equal? "${a1[${i}]}" "${a2[${i}]}" || return 1 done ;; hash_map) local hm1="${ANON["${1}"]}" eval local ks1="\${!${hm1}[@]}" local hm2="${ANON["${2}"]}" eval local ks2="\${!${hm2}[@]}" [[ "${#ks1}" == "${#ks2}" ]] || return 1 for k in ${ks1}; do eval v1="\${${hm1}[\"${k}\"]}" eval v2="\${${hm2}[\"${k}\"]}" [ "${v1}" ] || return 1 [ "${v2}" ] || return 1 _equal? "${v1}" "${v2}" || return 1 done ;; *) [[ "${1}" == "${2}" ]] ;; esac } # Constant atomic values __nil=_nil_0 __true=true_0 __false=fals_0 _nil? () { [[ ${1} =~ ^_nil_ ]]; } _true? () { [[ ${1} =~ ^true_ ]]; } _false? () { [[ ${1} =~ ^fals_ ]]; } # Symbols _symbol () { __new_obj_hash_code r="symb_${r}" ANON["${r}"]="${1//\*/__STAR__}" } _symbol? () { [[ ${1} =~ ^symb_ ]]; } # Keywords _keyword () { local k="${1}" __new_obj_hash_code r="strn_${r}" if [[ "${1:0:1}" = "${__keyw}" ]] \ || [[ "${1:0:2}" = "${__keyw}" ]]; then true else k="${__keyw}${1}" fi ANON["${r}"]="${k//\*/__STAR__}" } _keyword? () { [[ ${1} =~ ^strn_ ]] || return 1 local s="${ANON["${1}"]}" [[ "${s:0:1}" = "${__keyw}" ]] || [[ "${s:0:2}" = "${__keyw}" ]] } # Numbers _number () { __new_obj_hash_code r="numb_${r}" ANON["${r}"]="${1}" } _number? () { [[ ${1} =~ ^numb_ ]]; } # Strings _string () { __new_obj_hash_code r="strn_${r}" ANON["${r}"]="${1//\*/__STAR__}" } _string? () { [[ ${1} =~ ^strn_ ]]; } # Functions # Return a function object. The first parameter is the # function 'source'. _function () { __new_obj_hash_code eval "function ${__obj_magic}_func_${r} () { ${1%;} ; }" r="func_${r}" if [[ "${2}" ]]; then # Native function ANON["${r}"]="${__obj_magic}_${r}@${2}@${3}@${4}" else # Bash function ANON["${r}"]="${__obj_magic}_${r}" fi } _function? () { [[ ${1} =~ ^func_ ]]; } # Lists _list () { __new_obj_hash_code r="list_${r}" ANON["${r}"]="${*}" } _list? () { [[ ${1} =~ ^list_ ]]; } # Vectors _vector () { __new_obj_hash_code r="vector_${r}" ANON["${r}"]="${*}" } _vector? () { [[ ${1} =~ ^vector_ ]]; } vec () { __new_obj_hash_code r="vector_$r" ANON["$r"]=${ANON["$1"]} } # hash maps (associative arrays) _hash_map () { __new_obj_hash_code local name="hmap_${r}" local obj="${__obj_magic}_${name}" declare -A -g ${obj}; eval "${obj}=()" ANON["${name}"]="${obj}" while [[ "${1}" ]]; do eval ${obj}[\"${ANON["${1}"]}\"]=\"${2}\" shift; shift done r="${name}" } _hash_map? () { [[ ${1} =~ ^hmap_ ]]; } _contains? () { local obj="${ANON["${1}"]}" eval [[ "\${${obj}[\"${2}\"]+isset}" ]] } _copy_hash_map () { local orig_obj="${ANON["${1}"]}" _hash_map local name="${r}" local obj="${ANON["${name}"]}" # Copy the existing key/values to the new object local temp=$(typeset -p ${orig_obj}) eval ${temp/#declare -A ${orig_obj}=/declare -A -g ${obj}=} r="${name}" } # Return same hash map with keys/values added/mutated in place _assoc! () { local obj=${ANON["${1}"]}; shift declare -A -g ${obj} # Set the key/values specified while [[ "${1}" ]]; do eval ${obj}[\"${1}\"]=\"${2}\" shift; shift done } # Return same hash map with keys/values deleted/mutated in place _dissoc! () { local obj=${ANON["${1}"]}; shift declare -A -g ${obj} # Delete the key/values specified while [[ "${1}" ]]; do eval unset ${obj}[\"${1}\"] shift done } # Atoms _atom() { __new_obj_hash_code r="atom_${r}" ANON["${r}"]="${*}" } _atom? () { [[ ${1} =~ ^atom_ ]]; } # sequence operations _sequential? () { _list? "${1}" || _vector? "${1}" } _nth () { local temp=(${ANON["${1}"]}) r="${temp[${2}]}" } _first () { local temp="${ANON["${1}"]}" r="${temp%% *}" [ "${r}" ] || r="${__nil}" } _last () { local temp="${ANON["${1}"]}" r="${temp##* }" } # Creates a new vector/list of the everything after but the first # element _rest () { local temp="${ANON["${1}"]}" _list if [[ "${temp#* }" == "${temp}" ]]; then ANON["${r}"]= else ANON["${r}"]="${temp#* }" fi } _empty? () { [[ -z "${ANON["${1}"]}" ]]; } # conj that mutates in place (and always appends) _conj! () { local obj="${1}"; shift local obj_data="${ANON["${obj}"]}" ANON["${obj}"]="${obj_data:+${obj_data} }${*}" r="${1}" } _count () { if _nil? "${1}"; then r="0" else local temp=(${ANON["${1}"]}) r=${#temp[*]} fi } # Slice a sequence object $1 starting at $2 of length $3 _slice () { local temp=(${ANON["${1}"]}) __new_obj_like "${1}" ANON["${r}"]="${temp[@]:${2}:${3}}" } # Takes a bash function and an list object and invokes the function on # each element of the list, returning a new list (or vector) of the results. _map_with_type () { local constructor="${1}"; shift local f="${1}"; shift local items="${ANON["${1}"]}"; shift eval "${constructor}"; local new_seq="${r}" for v in ${items}; do #echo eval ${f%%@*} "${v}" "${@}" eval ${f%%@*} "${v}" "${@}" [[ "${__ERROR}" ]] && r= && return 1 _conj! "${new_seq}" "${r}" done r="${new_seq}" } _map () { _map_with_type _list "${@}" } fi ================================================ FILE: impls/basic/.args.mal ================================================ (def! -*ARGS*- (list )) ================================================ FILE: impls/basic/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ ca-certificates curl gcc g++ libasound2-dev \ libglu1-mesa-dev mesa-common-dev patch unzip wget \ xz-utils libncurses-dev # cbmbasic # Remove duplicate RAM (https://github.com/mist64/cbmbasic/commit/352a313313dd0a15a47288c8f8031b54ac8c92a2). RUN cd /tmp && \ curl -L https://github.com/kanaka/cbmbasic/archive/master.zip -o cbmbasic.zip && \ unzip cbmbasic.zip && \ cd cbmbasic-master && \ sed -i '/unsigned char RAM.65536.;/d' runtime.c && \ make && \ mv cbmbasic /usr/local/bin && \ cd .. && \ rm -r cbmbasic* # qbasic (using freebasic: `fbc -lang qb`) RUN cd /opt && \ curl -L https://sourceforge.net/projects/fbc/files/FreeBASIC-1.10.1/Binaries-Linux/FreeBASIC-1.10.1-ubuntu-22.04-x86_64.tar.xz | tar xvJf - && \ ln -sf /opt/FreeBASIC-1.10.1-ubuntu-22.04-x86_64/bin/fbc /usr/local/bin/fbc ================================================ FILE: impls/basic/Makefile ================================================ basic_MODE = cbm BASICPP_OPTS = --mode $(basic_MODE) FBC = fbc -lang qb STEPS4_A = step4_if_fn_do.bas step5_tco.bas step6_file.bas \ step7_quote.bas step8_macros.bas step9_try.bas stepA_mal.bas STEPS3_A = step3_env.bas $(STEPS4_A) STEPS1_A = step1_read_print.bas step2_eval.bas $(STEPS3_A) STEPS0_A = step0_repl.bas $(STEPS1_A) all: $(if $(filter qbasic,$(basic_MODE)),$(subst .bas,,$(STEPS0_A)),$(STEPS0_A)) $(STEPS0_A): debug.in.bas mem.in.bas readline.in.bas $(STEPS1_A): types.in.bas reader.in.bas printer.in.bas $(STEPS3_A): env.in.bas $(STEPS4_A): core.in.bas step%.bas: step%.in.bas ./basicpp.py $(BASICPP_OPTS) $< > $@ tests/%.bas: tests/%.in.bas ./basicpp.py $(BASICPP_OPTS) $< > $@ # QBasic specific compilation rule step%: step%.bas $(FBC) $< -x $@ # CBM/C64 image rules %.prg: %.bas cat $< | tr "A-Z" "a-z" > $<.tmp #cat $< | sed 's/["]\@["]\@!/\L&/g' > $<.tmp petcat -w2 -nc -o $@ $<.tmp #rm $<.tmp mal.prg: stepA_mal.prg cp $< $@ .args.mal.prg: .args.mal petcat -text -w2 -o $@ $< core.mal.prg: ../core.mal petcat -text -w2 -o $@ $< mal.d64: mal.prg .args.mal.prg core.mal.prg c1541 -format "mal,01" d64 $@ \ -attach $@ \ -write $< mal \ -write .args.mal.prg .args.mal \ -write core.mal.prg core.mal # Clean and Stats rules .PHONY: clean clean: rm -f $(STEPS0_A) $(subst .bas,,$(STEPS0_A)) *.d64 *.prg rm -rf ./internal ================================================ FILE: impls/basic/basicpp.py ================================================ #!/usr/bin/env python from __future__ import print_function import argparse import re import sys def debug(*args, **kwargs): print(*args, file=sys.stderr, **kwargs) def parse_args(): parser = argparse.ArgumentParser(description='Preprocess Basic code.') parser.add_argument('infiles', type=str, nargs='+', help='the Basic files to preprocess') parser.add_argument('--mode', choices=["cbm", "qbasic"], default="cbm") parser.add_argument('--keep-rems', action='store_true', default=False, help='The type of REMs to keep (0 (none) -> 4 (all)') parser.add_argument('--keep-blank-lines', action='store_true', default=False, help='Keep blank lines from the original file') parser.add_argument('--keep-indent', action='store_true', default=False, help='Keep line identing') parser.add_argument('--skip-misc-fixups', action='store_true', default=False, help='Skip miscellaneous fixup/shrink fixups') parser.add_argument('--skip-combine-lines', action='store_true', default=False, help='Do not combine lines using the ":" separator') args = parser.parse_args() if args.keep_rems and not args.skip_combine_lines: debug("Option --keep-rems implies --skip-combine-lines ") args.skip_combine_lines = True if args.mode == 'qbasic' and not args.skip_misc_fixups: debug("Mode 'qbasic' implies --skip-misc-fixups") args.skip_misc_fixups = True return args # pull in include files def resolve_includes(orig_lines, args): included = {} lines = orig_lines[:] position = 0 while position < len(lines): line = lines[position] m = re.match(r"^(?:#([^ ]*) )? *REM \$INCLUDE: '([^'\n]*)' *$", line) if m: mode = m.group(1) f = m.group(2) if mode and mode != args.mode: position += 1 elif f not in included: ilines = [l.rstrip() for l in open(f).readlines()] if args.keep_rems: lines.append("REM vvv BEGIN '%s' vvv" % f) lines[position:position+1] = ilines if args.keep_rems: lines.append("REM ^^^ END '%s' ^^^" % f) else: debug("Ignoring already included file: %s" % f) else: position += 1 return lines def resolve_mode(orig_lines, args): lines = [] for line in orig_lines: m = re.match(r"^ *#([^ \n]*) *([^\n]*)$", line) if m: if m.group(1) == args.mode: lines.append(m.group(2)) continue lines.append(line) return lines def drop_blank_lines(orig_lines): lines = [] for line in orig_lines: if re.match(r"^\W*$", line): continue lines.append(line) return lines def drop_rems(orig_lines): lines = [] for line in orig_lines: if re.match(r"^ *REM", line): continue m = re.match(r"^(.*): *REM .*$", line) if m: lines.append(m.group(1)) else: lines.append(line) return lines def remove_indent(orig_lines): lines = [] for line in orig_lines: m = re.match(r"^ *([^ \n].*)$", line) lines.append(m.group(1)) return lines def misc_fixups(orig_lines): text = "\n".join(orig_lines) # Remove GOTO after THEN text = re.sub(r"\bTHEN GOTO\b", "THEN", text) # Remove spaces after keywords text = re.sub(r"\bIF ", "IF", text) text = re.sub(r"\bPRINT *", "PRINT", text) text = re.sub(r"\bDIM ", "DIM", text) text = re.sub(r"\bOPEN ", "OPEN", text) text = re.sub(r"\bGET ", "GET", text) text = re.sub(r"\bPOKE ", "POKE", text) text = re.sub(r"\bCLOSE ", "CLOSE", text) text = re.sub(r"\bFOR ", "FOR", text) text = re.sub(r" TO ", "TO", text) text = re.sub(r"\bNEXT ", "NEXT", text) # Remove spaces around GOTO/GOSUB/THEN text = re.sub(r" *GOTO *", "GOTO", text) text = re.sub(r" *GOSUB *", "GOSUB", text) text = re.sub(r" *THEN *", r"THEN", text) # Remove spaces around AND/OR except after ST text = re.sub(r"(?OR", text) return text.split("\n") def finalize(lines, args): labels_lines = {} lines_labels = {} call_index = {} cur_sub = None # number lines, remove labels (but track line number), and replace # CALLs with a stack based GOTO src_lines = lines lines = [] lnum=1 for line in src_lines: # Drop labels (track line number for GOTO/GOSUB) m = re.match(r"^ *([^ :\n]*): *$", line) if m: label = m.groups(1)[0] labels_lines[label] = lnum lines_labels[lnum] = label continue if re.match(r".*CALL *([^ :\n]*) *:", line): raise Exception("CALL is not the last thing on line %s" % lnum) # Replace CALLs (track line number for replacement later) #m = re.match(r"\bCALL *([^ :]*) *$", line) m = re.match(r"(.*)CALL *([^ :\n]*) *$", line) if m: prefix = m.groups(1)[0] sub = m.groups(1)[1] if not sub in call_index: call_index[sub] = 0 call_index[sub] += 1 label = sub+"_"+str(call_index[sub]) # Replace the CALL with stack based GOTO if args.mode == "cbm": lines.append("%s %sQ=%s:GOSUBPUSH_Q:GOTO%s" % ( lnum, prefix, call_index[sub], sub)) else: lines.append("%s %sX=X+1:X%%(X)=%s:GOTO %s" % ( lnum, prefix, call_index[sub], sub)) lnum += 1 # Add the return spot labels_lines[label] = lnum lines_labels[lnum] = label continue lines.append("%s %s" % (lnum, line)) lnum += 1 # remove SUB (but track lines), and replace END SUB with ON GOTO # that returns to original caller src_lines = lines lines = [] lnum=1 for line in src_lines: # Drop subroutine defs (track line number for CALLS) m = re.match(r"^([0-9][0-9]*) *SUB *([^ \n]*) *$", line) if m: lnum = int(m.groups(1)[0])+1 label = m.groups(1)[1] cur_sub = label labels_lines[label] = lnum lines_labels[lnum] = label continue # Drop END SUB (track line number for replacement later) m = re.match(r"^([0-9][0-9]*) *END SUB *$", line) if m: if cur_sub == None: raise Exception("END SUB found without preceeding SUB") lnum = int(m.groups(1)[0]) index = call_index[cur_sub] ret_labels = [cur_sub+"_"+str(i) for i in range(1, index+1)] if args.mode == "cbm": line = "%s GOSUBPOP_Q:ONQGOTO%s" % (lnum, ",".join(ret_labels)) else: line = "%s X=X-1:ON X%%(X+1) GOTO %s" % (lnum, ",".join(ret_labels)) cur_sub = None lines.append(line) def update_labels_lines(text, a, b): stext = "" while stext != text: stext = text text = re.sub(r"(THEN *)%s\b" % a, r"\g<1>%s" % b, stext) #text = re.sub(r"(THEN)%s\b" % a, r"THEN%s" % b, stext) if args.mode == "cbm": text = re.sub(r"ON *([^:\n]*) *GOTO *([^:\n]*)\b%s\b" % a, r"ON\g<1>GOTO\g<2>%s" % b, text) text = re.sub(r"ON *([^:\n]*) *GOSUB *([^:\n]*)\b%s\b" % a, r"ON\g<1>GOSUB\g<2>%s" % b, text) else: text = re.sub(r"(ON [^:\n]* *GOTO *[^:\n]*)\b%s\b" % a, r"\g<1>%s" % b, text) text = re.sub(r"(ON [^:\n]* *GOSUB *[^:\n]*)\b%s\b" % a, r"\g<1>%s" % b, text) text = re.sub(r"(GOSUB *)%s\b" % a, r"\g<1>%s" % b, text) text = re.sub(r"(GOTO *)%s\b" % a, r"\g<1>%s" % b, text) #text = re.sub(r"(GOTO)%s\b" % a, r"\1%s" % b, text) return text # search for and replace GOTO/GOSUBs src_lines = lines text = "\n".join(lines) for label, lnum in labels_lines.items(): text = update_labels_lines(text, label, lnum) lines = text.split("\n") # combine lines if not args.skip_combine_lines: renumber = {} src_lines = lines lines = [] pos = 0 acc_line = "" def renum(line): lnum = len(lines)+1 renumber[old_num] = lnum return "%s %s" % (lnum, line) while pos < len(src_lines): line = src_lines[pos] m = re.match(r"^([0-9]*) (.*)$", line) old_num = int(m.group(1)) line = m.group(2) if acc_line == "": # Starting a new line acc_line = renum(line) elif old_num in lines_labels or re.match(r"^ *FOR\b.*", line): # This is a GOTO/GOSUB target or FOR loop so it must # be on a line by itself lines.append(acc_line) acc_line = renum(line) elif re.match(r".*(?:GOTO|THEN|RETURN).*", acc_line): # GOTO/THEN/RETURN are last thing on the line lines.append(acc_line) acc_line = renum(line) # TODO: not sure why this is 88 rather than 80 elif len(acc_line) + 1 + len(line) < 88: # Continue building up the line acc_line = acc_line + ":" + line # GOTO/IF/RETURN must be the last things on a line so # start a new line if re.match(r".*(?:GOTO|THEN|RETURN).*", line): lines.append(acc_line) acc_line = "" else: # Too long so start a new line lines.append(acc_line) acc_line = renum(line) pos += 1 if acc_line != "": lines.append(acc_line) # Finally renumber GOTO/GOSUBS src_lines = lines text = "\n".join(lines) # search for and replace GOTO/GOSUBs for a in sorted(renumber.keys()): b = renumber[a] text = update_labels_lines(text, a, b) lines = text.split("\n") return lines if __name__ == '__main__': args = parse_args() debug("Preprocessing basic files: "+", ".join(args.infiles)) # read in lines lines = [l.rstrip() for f in args.infiles for l in open(f).readlines()] debug("Original lines: %s" % len(lines)) # pull in include files lines = resolve_includes(lines, args) debug("Lines after includes: %s" % len(lines)) lines = resolve_mode(lines, args) debug("Lines after resolving mode specific lines: %s" % len(lines)) # drop blank lines if not args.keep_blank_lines: lines = drop_blank_lines(lines) debug("Lines after dropping blank lines: %s" % len(lines)) # keep/drop REMs if not args.keep_rems: lines = drop_rems(lines) debug("Lines after dropping REMs: %s" % len(lines)) # keep/remove the indenting if not args.keep_indent: lines = remove_indent(lines) # apply some miscellaneous simple fixups/regex transforms if not args.skip_misc_fixups: lines = misc_fixups(lines) # number lines, drop/keep labels, combine lines lines = finalize(lines, args) debug("Lines after finalizing: %s" % len(lines)) print("\n".join(lines)) ================================================ FILE: impls/basic/cbmbasic_console.patch ================================================ diff --git a/runtime.c b/runtime.c index 3066580..c635bd4 100644 --- a/runtime.c +++ b/runtime.c @@ -535,7 +535,8 @@ printf("CHROUT: %d @ %x,%x,%x,%x\n", A, a, b, c, d); left_cursor(); break; case '"': - kernal_quote = 1; + // jdm: this doesn't match C64 behavior + //kernal_quote = 1; // fallthrough default: putchar(A); @@ -838,8 +839,10 @@ GETIN() { /*Notice that EOF is also turned off in non-canonical mode*/ A = getchar(); if (A == 255) { A = 4; } // map actual EOF to 4 + + // jdm: this doesn't match C64 behavior /* Simulate echo */ - if (A != 0 && A != 4) { putchar(A); } + //if (A != 0 && A != 4) { putchar(A); } /*restore the old settings*/ tcsetattr( STDIN_FILENO, TCSANOW, &oldt); ================================================ FILE: impls/basic/core.in.bas ================================================ REM APPLY should really be in types.in.bas but it is here because it REM calls DO_TCO_FUNCTION so it will cause syntax errors for steps1-3 REM if it is in types.in.bas because there are unresolved labels. REM APPLY(F, AR) -> R REM - restores E REM - call using GOTO and with return label/address on the stack SUB APPLY REM if metadata, get the actual object GOSUB TYPE_F IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F ON T-8 GOTO APPLY_FUNCTION,APPLY_MAL_FUNCTION,APPLY_MAL_FUNCTION APPLY_FUNCTION: REM regular function IF Z%(F+1)<64 THEN GOSUB DO_FUNCTION:GOTO APPLY_DONE REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION GOTO APPLY_DONE APPLY_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment REM create new environ using env and params stored in the REM function and bind the params to the apply arguments C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS A=Z%(F+1):E=R:CALL EVAL AY=E:GOSUB RELEASE: REM release the new environment GOSUB POP_Q:E=Q: REM pop/restore the saved environment APPLY_DONE: END SUB REM DO_TCO_FUNCTION(F, AR) SUB DO_TCO_FUNCTION G=Z%(F+1) REM Get argument values A=Z%(AR+2) B=Z%(Z%(AR+1)+2) REM PRINT "F:"+STR$(F)+", Z%(F):"+STR$(Z%(F))+", G:"+STR$(G) ON G-64 GOTO DO_APPLY,DO_MAP,DO_SWAP_BANG DO_APPLY: F=A AR=Z%(AR+1) A=AR:GOSUB COUNT:C=R A=Z%(AR+2) REM no intermediate args, but not a list, so convert it first GOSUB TYPE_A IF C<=1 AND T<>6 THEN T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2 REM no intermediate args, just call APPLY directly IF C<=1 THEN GOTO DO_APPLY_1 REM prepend intermediate args to final args element A=AR:B=0:C=C-1:GOSUB SLICE REM release the terminator of new list (we skip over it) REM we already checked for an empty list above, so R6 is pointer REM a real non-empty list AY=Z%(R6+1):GOSUB RELEASE REM attach end of slice to final args element A2=Z%(A+2) Z%(R6+1)=A2 Z%(A2)=Z%(A2)+32 GOTO DO_APPLY_2 DO_APPLY_1: AR=A:CALL APPLY GOTO DO_TCO_FUNCTION_DONE DO_APPLY_2: GOSUB PUSH_R: REM push/save new args for release AR=R:CALL APPLY REM pop/release new args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO DO_TCO_FUNCTION_DONE DO_MAP: F=A REM setup the stack for the loop T=6:GOSUB MAP_LOOP_START DO_MAP_LOOP: IF Z%(B+1)=0 THEN GOTO DO_MAP_DONE REM create argument list for apply T=6:L=6:M=Z%(B+2):GOSUB ALLOC GOSUB PUSH_R: REM push argument list Q=F:GOSUB PUSH_Q: REM push F Q=B:GOSUB PUSH_Q: REM push B AR=R:CALL APPLY GOSUB POP_Q:B=Q: REM pop B GOSUB POP_Q:F=Q: REM pop F GOSUB POP_Q: REM pop apply args and release them AY=Q:GOSUB RELEASE REM main value is result of apply M=R B=Z%(B+1): REM go to the next element REM if error, release the unattached element IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO DO_MAP_DONE REM update the return sequence structure REM release N since list takes full ownership C=1:T=6:GOSUB MAP_LOOP_UPDATE GOTO DO_MAP_LOOP DO_MAP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO DO_TCO_FUNCTION_DONE DO_SWAP_BANG: F=B REM add atom to front of the args list T=6:L=Z%(Z%(AR+1)+1):M=Z%(A+1):GOSUB ALLOC: REM cons AR=R REM push args for release after Q=AR:GOSUB PUSH_Q REM push atom GOSUB PUSH_A CALL APPLY REM pop atom GOSUB POP_A REM pop and release args GOSUB POP_Q:AY=Q GOSUB RELEASE REM use reset to update the value B=R:GOSUB DO_RESET_BANG REM but decrease ref cnt of return by 1 (not sure why) AY=R:GOSUB RELEASE GOTO DO_TCO_FUNCTION_DONE DO_TCO_FUNCTION_DONE: END SUB REM DO_FUNCTION(F, AR) DO_FUNCTION: REM Get the function number G=Z%(F+1) REM Get argument values A=Z%(AR+2):A1=Z%(A+1) B=Z%(Z%(AR+1)+2):B1=Z%(B+1) REM Switch on the function number REM MEMORY DEBUGGING: 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: ON G GOTO DO_EQUAL_Q,DO_THROW,DO_NIL_Q,DO_TRUE_Q,DO_FALSE_Q,DO_STRING_Q,DO_SYMBOL,DO_SYMBOL_Q,DO_KEYWORD DO_10_19: ON G-9 GOTO DO_KEYWORD_Q,DO_NUMBER_Q,DO_FN_Q,DO_MACRO_Q,DO_PR_STR,DO_STR,DO_PRN,DO_PRINTLN,DO_READ_STRING,DO_READLINE DO_20_29: ON G-19 GOTO DO_SLURP,DO_LT,DO_LTE,DO_GT,DO_GTE,DO_ADD,DO_SUB,DO_MULT,DO_DIV,DO_TIME_MS DO_30_39: ON G-29 GOTO DO_LIST,DO_LIST_Q,DO_VECTOR,DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_ASSOC,DO_THROW,DO_GET,DO_CONTAINS DO_40_49: ON G-39 GOTO DO_KEYS,DO_VALS,DO_SEQUENTIAL_Q,DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT 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_VEC,DO_PR_MEMORY_SUMMARY DO_EQUAL_Q: GOSUB EQUAL_Q GOTO RETURN_TRUE_FALSE DO_THROW: ER=A Z%(ER)=Z%(ER)+32 R=-1 RETURN DO_NIL_Q: R=A=0 GOTO RETURN_TRUE_FALSE DO_TRUE_Q: R=A=4 GOTO RETURN_TRUE_FALSE DO_FALSE_Q: R=A=2 GOTO RETURN_TRUE_FALSE DO_STRING_Q: R=0 GOSUB TYPE_A IF T<>4 THEN GOTO RETURN_TRUE_FALSE IF MID$(S$(A1),1,1)=CHR$(127) THEN GOTO RETURN_TRUE_FALSE R=1 GOTO RETURN_TRUE_FALSE DO_SYMBOL: B$=S$(A1) T=5:GOSUB STRING RETURN DO_SYMBOL_Q: GOSUB TYPE_A R=T=5 GOTO RETURN_TRUE_FALSE DO_KEYWORD: B$=S$(A1) IF MID$(B$,1,1)<>CHR$(127) THEN B$=CHR$(127)+B$ T=4:GOSUB STRING RETURN DO_KEYWORD_Q: R=0 GOSUB TYPE_A IF T<>4 THEN GOTO RETURN_TRUE_FALSE IF MID$(S$(A1),1,1)<>CHR$(127) THEN GOTO RETURN_TRUE_FALSE R=1 GOTO RETURN_TRUE_FALSE DO_NUMBER_Q: GOSUB TYPE_A R=T=2 GOTO RETURN_TRUE_FALSE DO_FN_Q: GOSUB TYPE_A R=T=9 OR T=10 GOTO RETURN_TRUE_FALSE DO_MACRO_Q: GOSUB TYPE_A R=T=11 GOTO RETURN_TRUE_FALSE DO_PR_STR: AZ=AR:B=1:B$=" ":GOSUB PR_STR_SEQ B$=R$:T=4:GOSUB STRING RETURN DO_STR: AZ=AR:B=0:B$="":GOSUB PR_STR_SEQ B$=R$:T=4:GOSUB STRING RETURN DO_PRN: AZ=AR:B=1:B$=" ":GOSUB PR_STR_SEQ PRINT R$ R=0 GOTO INC_REF_R DO_PRINTLN: AZ=AR:B=0:B$=" ":GOSUB PR_STR_SEQ PRINT R$ R=0 GOTO INC_REF_R DO_READ_STRING: A$=S$(A1) GOSUB READ_STR RETURN DO_READLINE: A$=S$(A1):GOSUB READLINE IF EZ>0 THEN EZ=0:R=0:GOTO INC_REF_R B$=R$:T=4:GOSUB STRING RETURN DO_SLURP: R$="" EZ=0 #cbm OPEN 2,8,0,S$(A1) #qbasic A$=S$(A1) #qbasic OPEN A$ FOR INPUT AS #2 #qbasic IF ERR()<>0 THEN ER=-1:E$="File not found":RETURN DO_SLURP_LOOP: C$="" RJ=1:GOSUB READ_FILE_CHAR #cbm IF ASC(C$)=10 THEN R$=R$+CHR$(13) #qbasic IF ASC(C$)=10 THEN R$=R$+CHR$(10) IF (ASC(C$)<>10) AND (C$<>"") THEN R$=R$+C$ IF EZ>0 THEN GOTO DO_SLURP_DONE GOTO DO_SLURP_LOOP DO_SLURP_DONE: CLOSE 2 IF ER>-2 THEN RETURN B$=R$:T=4:GOSUB STRING RETURN DO_LT: R=A1B1 GOTO RETURN_TRUE_FALSE DO_GTE: R=A1>=B1 GOTO RETURN_TRUE_FALSE DO_ADD: T=2:L=A1+B1:GOSUB ALLOC RETURN DO_SUB: T=2:L=A1-B1:GOSUB ALLOC RETURN DO_MULT: T=2:L=A1*B1:GOSUB ALLOC RETURN DO_DIV: T=2:L=A1/B1:GOSUB ALLOC RETURN DO_TIME_MS: #cbm T=2:L=INT((TI-BT)*16.667):GOSUB ALLOC #qbasic T=2:L=INT((TIMER()-BT#)*1000):GOSUB ALLOC RETURN DO_LIST: R=AR GOTO INC_REF_R DO_LIST_Q: GOSUB LIST_Q GOTO RETURN_TRUE_FALSE DO_VECTOR: A=AR:T=7:GOTO FORCE_SEQ_TYPE DO_VECTOR_Q: GOSUB TYPE_A R=T=7 GOTO RETURN_TRUE_FALSE DO_HASH_MAP: REM setup the stack for the loop T=8:GOSUB MAP_LOOP_START A=AR DO_HASH_MAP_LOOP: IF Z%(A+1)=0 THEN GOTO DO_HASH_MAP_LOOP_DONE M=Z%(A+2) N=Z%(Z%(A+1)+2) A=Z%(Z%(A+1)+1): REM skip two REM update the return sequence structure REM do not release M and N since we are pulling them from the REM arguments (and not creating them here) C=0:GOSUB MAP_LOOP_UPDATE GOTO DO_HASH_MAP_LOOP DO_HASH_MAP_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE RETURN DO_MAP_Q: GOSUB TYPE_A R=T=8 GOTO RETURN_TRUE_FALSE DO_ASSOC: H=A AR=Z%(AR+1) DO_ASSOC_LOOP: K=Z%(AR+2) C=Z%(Z%(AR+1)+2) Z%(H)=Z%(H)+32 GOSUB ASSOC1:H=R AR=Z%(Z%(AR+1)+1) IF AR=0 OR Z%(AR+1)=0 THEN RETURN GOTO DO_ASSOC_LOOP DO_GET: IF A=0 THEN R=0:GOTO INC_REF_R H=A:B$=S$(Z%(B+1)):GOSUB HASHMAP_GET GOTO INC_REF_R DO_CONTAINS: H=A:B$=S$(Z%(B+1)):GOSUB HASHMAP_CONTAINS GOTO RETURN_TRUE_FALSE DO_KEYS: T1=0 GOTO DO_KEYS_VALS DO_VALS: T1=1 DO_KEYS_VALS: REM setup the stack for the loop T=6:GOSUB MAP_LOOP_START DO_KEYS_VALS_LOOP: IF Z%(A+1)=0 THEN GOTO DO_KEYS_VALS_LOOP_DONE IF T1=0 THEN M=Z%(A+2) IF T1=1 THEN M=Z%(A+3) A=Z%(A+1): REM next element REM update the return sequence structure REM do not release N since we are pulling it from the REM hash-map (and not creating them here) C=0:GOSUB MAP_LOOP_UPDATE GOTO DO_KEYS_VALS_LOOP DO_KEYS_VALS_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE RETURN DO_SEQUENTIAL_Q: GOSUB TYPE_A R=T=6 OR T=7 GOTO RETURN_TRUE_FALSE DO_CONS: T=6:L=B:M=A:GOSUB ALLOC RETURN DO_CONCAT: REM always a list R=6:GOSUB INC_REF_R GOSUB PUSH_R: REM current value GOSUB PUSH_R: REM return value DO_CONCAT_LOOP: IF AR<16 THEN GOTO DO_CONCAT_DONE: REM no more elements REM slice/copy current element to a list A=Z%(AR+2) IF A<16 THEN GOTO DO_CONCAT_LOOP_NEXT: REM skip empty elements B=0:C=-1:GOSUB SLICE GOSUB PEEK_Q: REM return value REM if this is the first element, set return element IF Q=6 THEN Q=R:GOSUB PUT_Q:GOTO DO_CONCAT_LOOP_AGAIN REM otherwise Q<>6, so attach current to sliced GOSUB PEEK_Q_1 Z%(Q+1)=R DO_CONCAT_LOOP_AGAIN: REM update current to end of sliced list Q=R6:GOSUB PUT_Q_1 REM dec empty since no longer part of slice AY=6:GOSUB RELEASE DO_CONCAT_LOOP_NEXT: REM next list element AR=Z%(AR+1) GOTO DO_CONCAT_LOOP DO_CONCAT_DONE: 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 GOSUB COUNT IF R<=B THEN R=-1:ER=-1:E$="nth: index out of range":RETURN DO_NTH_LOOP: IF B=0 THEN GOTO DO_NTH_DONE B=B-1 A=Z%(A+1) GOTO DO_NTH_LOOP DO_NTH_DONE: R=Z%(A+2) GOTO INC_REF_R DO_FIRST: R=0 IF A=0 THEN GOTO INC_REF_R IF A1<>0 THEN R=Z%(A+2) GOTO INC_REF_R DO_REST: IF A=0 THEN R=6:GOTO INC_REF_R IF A1<>0 THEN A=A1: REM get the next sequence element T=6:GOSUB FORCE_SEQ_TYPE RETURN DO_EMPTY_Q: R=A1=0 GOTO RETURN_TRUE_FALSE DO_COUNT: GOSUB COUNT T=2:L=R:GOSUB ALLOC RETURN DO_CONJ: R=0 GOTO INC_REF_R DO_SEQ: R=0 GOTO INC_REF_R DO_WITH_META: GOSUB TYPE_A REM remove existing metadata first IF T=14 THEN A=A1:GOTO DO_WITH_META T=14:L=A:M=B:GOSUB ALLOC RETURN DO_META: R=0 GOSUB TYPE_A IF T=14 THEN R=Z%(A+2) GOTO INC_REF_R DO_ATOM: T=12:L=A:GOSUB ALLOC RETURN DO_ATOM_Q: GOSUB TYPE_A R=T=12 GOTO RETURN_TRUE_FALSE DO_DEREF: R=A1 GOTO INC_REF_R DO_RESET_BANG: R=B REM release current value REM can't use A1 here because DO_RESET_BANG is called from swap! AY=Z%(A+1):GOSUB RELEASE REM inc ref by 2 for atom ownership and since we are returning it Z%(R)=Z%(R)+64 REM update value Z%(A+1)=R RETURN DO_EVAL: Q=E:GOSUB PUSH_Q: REM push/save environment E=D:CALL EVAL GOSUB POP_Q:E=Q RETURN DO_READ_FILE: A$=S$(A1) GOSUB READ_FILE RETURN REM DO_PR_MEMORY: REM P1=ZT:P2=-1:GOSUB PR_MEMORY REM RETURN DO_PR_MEMORY_SUMMARY: REM GOSUB PR_MEMORY_SUMMARY GOSUB PR_MEMORY_SUMMARY_SMALL R=0 GOTO INC_REF_R RETURN INIT_CORE_SET_FUNCTION: T=9:L=A:GOSUB ALLOC: REM native function C=R:GOSUB ENV_SET_S A=A+1 RETURN REM INIT_CORE_NS(E) INIT_CORE_NS: REM create the environment mapping REM must match DO_FUNCTION mappings A=1 B$="=":GOSUB INIT_CORE_SET_FUNCTION: REM A=1 B$="throw":GOSUB INIT_CORE_SET_FUNCTION: REM A=2 B$="nil?":GOSUB INIT_CORE_SET_FUNCTION: REM A=3 B$="true?":GOSUB INIT_CORE_SET_FUNCTION: REM A=4 B$="false?":GOSUB INIT_CORE_SET_FUNCTION: REM A=5 B$="string?":GOSUB INIT_CORE_SET_FUNCTION: REM A=6 B$="symbol":GOSUB INIT_CORE_SET_FUNCTION: REM A=7 B$="symbol?":GOSUB INIT_CORE_SET_FUNCTION: REM A=8 B$="keyword":GOSUB INIT_CORE_SET_FUNCTION: REM A=9 B$="keyword?":GOSUB INIT_CORE_SET_FUNCTION: REM A=10 B$="number?":GOSUB INIT_CORE_SET_FUNCTION: REM A=11 B$="fn?":GOSUB INIT_CORE_SET_FUNCTION: REM A=12 B$="macro?":GOSUB INIT_CORE_SET_FUNCTION: REM A=13 B$="pr-str":GOSUB INIT_CORE_SET_FUNCTION: REM A=14 B$="str":GOSUB INIT_CORE_SET_FUNCTION: REM A=15 B$="prn":GOSUB INIT_CORE_SET_FUNCTION: REM A=16 B$="println":GOSUB INIT_CORE_SET_FUNCTION: REM A=17 B$="read-string":GOSUB INIT_CORE_SET_FUNCTION: REM A=18 B$="readline":GOSUB INIT_CORE_SET_FUNCTION: REM A=19 B$="slurp":GOSUB INIT_CORE_SET_FUNCTION: REM A=20 B$="<":GOSUB INIT_CORE_SET_FUNCTION: REM A=21 B$="<=":GOSUB INIT_CORE_SET_FUNCTION: REM A=22 B$=">":GOSUB INIT_CORE_SET_FUNCTION: REM A=23 B$=">=":GOSUB INIT_CORE_SET_FUNCTION: REM A=24 B$="+":GOSUB INIT_CORE_SET_FUNCTION: REM A=25 B$="-":GOSUB INIT_CORE_SET_FUNCTION: REM A=26 B$="*":GOSUB INIT_CORE_SET_FUNCTION: REM A=27 B$="/":GOSUB INIT_CORE_SET_FUNCTION: REM A=28 B$="time-ms":GOSUB INIT_CORE_SET_FUNCTION: REM A=29 B$="list":GOSUB INIT_CORE_SET_FUNCTION: REM A=30 B$="list?":GOSUB INIT_CORE_SET_FUNCTION: REM A=31 B$="vector":GOSUB INIT_CORE_SET_FUNCTION: REM A=32 B$="vector?":GOSUB INIT_CORE_SET_FUNCTION: REM A=33 B$="hash-map":GOSUB INIT_CORE_SET_FUNCTION: REM A=34 B$="map?":GOSUB INIT_CORE_SET_FUNCTION: REM A=35 B$="assoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=36 B$="dissoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=37 B$="get":GOSUB INIT_CORE_SET_FUNCTION: REM A=38 B$="contains?":GOSUB INIT_CORE_SET_FUNCTION: REM A=39 B$="keys":GOSUB INIT_CORE_SET_FUNCTION: REM A=40 B$="vals":GOSUB INIT_CORE_SET_FUNCTION: REM A=41 B$="sequential?":GOSUB INIT_CORE_SET_FUNCTION: REM A=42 B$="cons":GOSUB INIT_CORE_SET_FUNCTION: REM A=43 B$="concat":GOSUB INIT_CORE_SET_FUNCTION: REM A=44 B$="nth":GOSUB INIT_CORE_SET_FUNCTION: REM A=45 B$="first":GOSUB INIT_CORE_SET_FUNCTION: REM A=46 B$="rest":GOSUB INIT_CORE_SET_FUNCTION: REM A=47 B$="empty?":GOSUB INIT_CORE_SET_FUNCTION: REM A=48 B$="count":GOSUB INIT_CORE_SET_FUNCTION: REM A=49 B$="conj":GOSUB INIT_CORE_SET_FUNCTION: REM A=50 B$="seq":GOSUB INIT_CORE_SET_FUNCTION: REM A=51 B$="with-meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=52 B$="meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=53 B$="atom":GOSUB INIT_CORE_SET_FUNCTION: REM A=54 B$="atom?":GOSUB INIT_CORE_SET_FUNCTION: REM A=55 B$="deref":GOSUB INIT_CORE_SET_FUNCTION: REM A=56 B$="reset!":GOSUB INIT_CORE_SET_FUNCTION: REM A=57 B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58 B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59 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 B$="apply":GOSUB INIT_CORE_SET_FUNCTION: REM A=65 B$="map":GOSUB INIT_CORE_SET_FUNCTION: REM A=66 B$="swap!":GOSUB INIT_CORE_SET_FUNCTION: REM A=67 RETURN ================================================ FILE: impls/basic/debug.in.bas ================================================ REM CHECK_FREE_LIST() -> P2 CHECK_FREE_LIST: REM start and accumulator P1=ZK P2=0 CHECK_FREE_LIST_LOOP: IF P1>=ZI THEN RETURN REM MEMORY DEBUGGING: REM IF (Z%(P1)AND 31)<>15 THEN PRINT "corrupt free:"+STR$(P1):END P2=P2+(Z%(P1)AND-32)/32 P1=Z%(P1+1) GOTO CHECK_FREE_LIST_LOOP PR_MEMORY_SUMMARY_SMALL: #cbm P0=FRE(0) GOSUB CHECK_FREE_LIST #cbm PRINT "Free:"+STR$(FRE(0))+", "; PRINT "Values:"+STR$(ZI-1-P2)+", Emptys:"; FOR P=0 TO 4 STEP 2:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P FOR P=6 TO 12 STEP 3:GOSUB PR_MEMORY_SUMMARY_SMALL_1:NEXT P PRINT RETURN PR_MEMORY_SUMMARY_SMALL_1: PRINT STR$(INT(Z%(P)/32))+","; RETURN REM REM COUNT_STRINGS() -> P2 REM COUNT_STRINGS: REM P1=0 REM P2=0 REM COUNT_STRINGS_LOOP: REM IF P1>S-1 THEN RETURN REM IF S%(P1)>0 THEN P2=P2+1 REM P1=P1+1 REM GOTO COUNT_STRINGS_LOOP REM REM PR_MEMORY_SUMMARY: REM #cbm P0=FRE(0) REM REM PRINT REM #cbm PRINT "Free (FRE) :"+STR$(P0) REM GOSUB CHECK_FREE_LIST: REM get count in P2 REM PRINT "Values (Z%) :"+STR$(ZI-1-P2)+" /"+STR$(Z1) REM REM PRINT " max:"+STR$(ZI-1); REM REM PRINT ", freed:"+STR$(P2)+", after repl_env:"+STR$(ZT) REM GOSUB COUNT_STRINGS REM PRINT "Strings (S$) :"+STR$(P2)+" /"+STR$(Z2) REM #qbasic PRINT "Stack (X%) :"+STR$(X+1)+" /"+STR$(Z3) REM #cbm PRINT "Stack :"+STR$(X+2-Z3)+" / 1920" REM RETURN REM REM #cbm PR_MEMORY_MAP: REM #cbm PRINT REM #cbm P1=PEEK(43)+PEEK(44)*256 REM #cbm P2=PEEK(45)+PEEK(46)*256 REM #cbm P3=PEEK(47)+PEEK(48)*256 REM #cbm P4=PEEK(49)+PEEK(50)*256 REM #cbm P5=PEEK(51)+PEEK(52)*256 REM #cbm P6=PEEK(53)+PEEK(54)*256 REM #cbm P7=PEEK(55)+PEEK(56)*256 REM #cbm PRINT "BASIC beg. :"STR$(P1) REM #cbm PRINT "Variable beg.:"STR$(P2) REM #cbm PRINT "Array beg. :"STR$(P3) REM #cbm PRINT "Array end :"STR$(P4) REM #cbm PRINT "String beg. :"STR$(P5) REM #cbm PRINT "String cur. :"STR$(P6) REM #cbm PRINT "BASIC end :"STR$(P7) REM #cbm PRINT REM #cbm PRINT "Program Code :"STR$(P2-P1) REM #cbm PRINT "Variables :"STR$(P3-P2) REM #cbm PRINT "Arrays :"STR$(P4-P3) REM #cbm PRINT "String Heap :"STR$(P7-P5) REM #cbm RETURN REM REM REM PR_MEMORY_VALUE(I) -> J: REM REM - I is memory value to print REM REM - I is returned as last byte of value printed REM REM - J is returned as type REM PR_MEMORY_VALUE: REM J=Z%(I)AND 31 REM P3=Z%(I+1) REM PRINT " "+STR$(I)+": type:"+STR$(J); REM IF J<>15 THEN PRINT ", refs:"+STR$((Z%(I)-J)/32); REM IF J=15 THEN PRINT ", size:"+STR$((Z%(I)AND-32)/32); REM PRINT ", ["+STR$(Z%(I));+" |"+STR$(P3); REM IF J<6 OR J=9 OR J=12 OR J=15 THEN PRINT " | --- | --- ]";:GOTO PR_MEM_SKIP REM PRINT " |"+STR$(Z%(I+2)); REM IF J=6 OR J=7 OR J=13 OR J=14 THEN PRINT " | --- ]";:GOTO PR_MEM_SKIP REM PRINT " |"+STR$(Z%(I+3))+" ]"; REM PR_MEM_SKIP: REM PRINT " >> "; REM ON J+1 GOTO PR_ENTRY_NIL,PR_ENTRY_BOOL,PR_ENTRY_INT,PR_ENTRY_FLOAT,PR_ENTRY_STR,PR_ENTRY_SYM,PR_ENTRY_LIST,PR_ENTRY_VECTOR,PR_ENTRY_HASH_MAP,PR_ENTRY_FN,PR_ENTRY_MALFN,PR_ENTRY_MAC,PR_ENTRY_ATOM,PR_ENTRY_ENV,PR_ENTRY_META,PR_ENTRY_FREE REM PRINT "Unknown type:"+STR$(J):END REM REM PR_ENTRY_NIL: REM PRINT "nil" REM I=I+1 REM RETURN REM PR_ENTRY_BOOL: REM IF P3=0 THEN PRINT "false" REM IF P3=1 THEN PRINT "true" REM I=I+1 REM RETURN REM PR_ENTRY_INT: REM PR_ENTRY_FLOAT: REM PRINT STR$(P3) REM I=I+1 REM RETURN REM PR_ENTRY_STR: REM PRINT "'"+S$(P3)+"'" REM I=I+1 REM RETURN REM PR_ENTRY_SYM: REM PRINT S$(P3) REM I=I+1 REM RETURN REM PR_ENTRY_LIST: REM I=I+2 REM IF I<16 THEN PRINT "()":RETURN REM PRINT "(..."+STR$(Z%(I))+" ...)" REM RETURN REM PR_ENTRY_VECTOR: REM I=I+2 REM IF I<16 THEN PRINT "[]":RETURN REM PRINT "[..."+STR$(Z%(I))+" ...]" REM RETURN REM PR_ENTRY_HASH_MAP: REM I=I+3 REM IF I<16 THEN PRINT "{}":RETURN REM IF J=8 THEN PRINT "{... key:"+STR$(Z%(I-1))+", val:"+STR$(Z%(I))+" ...}" REM RETURN REM PR_ENTRY_FN: REM PRINT "#" REM I=I+1 REM RETURN REM PR_ENTRY_MALFN: REM PR_ENTRY_MAC: REM IF I=11 THEN PRINT "MACRO "; REM PRINT "(fn* param:"+STR$(Z%(I))+", env:"+STR$(Z%(I+1))+")" REM I=I+3 REM RETURN REM PR_ENTRY_ATOM: REM PRINT "(atom val:"+STR$(P3)+")" REM I=I+1 REM RETURN REM PR_ENTRY_ENV: REM PRINT "#" REM I=I+2 REM RETURN REM PR_ENTRY_META: REM PRINT "#" REM I=I+2 REM RETURN REM PR_ENTRY_FREE: REM PRINT "FREE next:"+STR$(P3); REM IF I=ZK THEN PRINT " (free list start)"; REM PRINT REM I=I-1+(Z%(I)AND-32)/32 REM RETURN REM REM REM PR_OBJECT(P1) -> nil REM PR_OBJECT: REM RD=0 REM REM IF P1=-1 THEN PRINT " "+STR$(-1)+": ---":RETURN REM RD=RD+1 REM Q=P1:GOSUB PUSH_Q REM REM PR_OBJ_LOOP: REM IF RD=0 THEN RETURN REM RD=RD-1 REM REM GOSUB PEEK_Q:I=Q REM REM IF I<15 THEN GOSUB POP_Q:GOTO PR_OBJ_LOOP REM GOSUB PR_MEMORY_VALUE REM REM J holds type now REM GOSUB POP_Q:I=Q REM REM IF J<6 OR J=9 THEN GOTO PR_OBJ_LOOP: REM no contained references REM REM reference in first position REM IF Z%(I+1)<>0 THEN RD=RD+1:Q=Z%(I+1):GOSUB PUSH_Q REM IF J=12 OR J=15 THEN PR_OBJ_LOOP: REM no more reference REM REM reference in second position REM IF Z%(I+2)<>0 THEN RD=RD+1:Q=Z%(I+2):GOSUB PUSH_Q REM IF J=6 OR J=7 OR J=13 OR J=14 THEN PR_OBJ_LOOP: REM no more references REM IF Z%(I+3)<>0 THEN RD=RD+1:Q=Z%(I+3):GOSUB PUSH_Q REM GOTO PR_OBJ_LOOP REM REM REM PR_MEMORY(P1, P2) -> nil REM PR_MEMORY: REM IF P2"+STR$(P2); REM PRINT " (ZI: "+STR$(ZI)+", ZK: "+STR$(ZK)+"):" REM IF P2P2 THEN GOTO PR_MEMORY_AFTER_VALUES REM GOSUB PR_MEMORY_VALUE REM I=I+1 REM GOTO PR_MEMORY_VALUE_LOOP REM PR_MEMORY_AFTER_VALUES: REM PRINT "S$ String Memory (S: "+STR$(S)+"):" REM IF S<=0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STRINGS REM FOR I=0 TO S-1 REM PRINT " "+STR$(I)+": '"+S$(I)+"'" REM NEXT I REM PR_MEMORY_SKIP_STRINGS: REM PRINT "X% Stack Memory (X: "+STR$(X)+"):" REM #cbm IF X R ENV_NEW: REM allocate the data hashmap GOSUB HASHMAP AY=R REM set the outer and data pointer T=13:L=R:M=C:GOSUB ALLOC GOSUB RELEASE: REM environment takes ownership RETURN REM see RELEASE types.in.bas for environment cleanup REM ENV_NEW_BINDS(C, A, B) -> R ENV_NEW_BINDS: GOSUB ENV_NEW E=R REM process bindings ENV_NEW_BINDS_LOOP: IF Z%(A+1)=0 THEN R=E:RETURN REM get/deref the key from A K=Z%(A+2) IF S$(Z%(K+1))="&" THEN GOTO EVAL_NEW_BINDS_VARGS EVAL_NEW_BINDS_1x1: REM get/deref the key from B C=Z%(B+2) REM set the binding in the environment data GOSUB ENV_SET REM go to next element of A and B A=Z%(A+1) B=Z%(B+1) GOTO ENV_NEW_BINDS_LOOP EVAL_NEW_BINDS_VARGS: REM get/deref the key from next element of A A=Z%(A+1) K=Z%(A+2) REM the value is the remaining list in B A=B:T=6:GOSUB FORCE_SEQ_TYPE C=R REM set the binding in the environment data GOSUB ENV_SET R=E AY=C:GOSUB RELEASE: REM list is owned by environment RETURN REM ENV_SET(E, K, C) -> R ENV_SET: H=Z%(E+1) GOSUB ASSOC1 Z%(E+1)=R R=C RETURN REM ENV_SET_S(E, B$, C) -> R ENV_SET_S: H=Z%(E+1) GOSUB ASSOC1_S Z%(E+1)=R R=C RETURN REM ENV_GET(E, B$) -> R REM - R3=1 if the key was found, else 0 SUB ENV_GET T=E ENV_FIND_LOOP: H=Z%(T+1) REM More efficient to use GET for value (R) and contains? (R3) GOSUB HASHMAP_GET REM if we found it, return it IF R3=1 THEN GOTO ENV_FIND_DONE T=Z%(T+2): REM get outer environment IF T>0 THEN GOTO ENV_FIND_LOOP ENV_FIND_DONE: END SUB ================================================ FILE: impls/basic/mem.in.bas ================================================ REM Memory layout: REM REM type bytes REM ---------- ---------- REM nil ref/ 0 | 0 | | REM false ref/ 1 | 0 | | REM true ref/ 1 | 1 | | REM integer ref/ 2 | int | | REM float ref/ 3 | ??? | | REM string/kw ref/ 4 | S$ idx | | REM symbol ref/ 5 | S$ idx | | REM list ref/ 6 | next Z% idx | val Z% idx | REM vector ref/ 7 | next Z% idx | val Z% idx | REM hashmap ref/ 8 | next Z% idx | key Z% idx | val Z% idx REM function ref/ 9 | fn idx | | REM mal function ref/10 | body Z% idx | param Z% idx | env Z% idx REM macro fn ref/11 | body Z% idx | param Z% idx | env Z% idx REM atom ref/12 | val Z% idx | | REM environment ref/13 | hmap Z% idx | outer Z% idx | REM metadata ref/14 | obj Z% idx | meta Z% idx | REM FREE sz/15 | next Z% idx | | REM REM Locations 0-15 are for constant/persistent values: REM 0: nil REM 2: false REM 4: true REM 6: empty list REM 9: empty vector REM 12: empty hash-map REM Note: DIM_MEMORY for C64 BASIC and the INIT_MEMORY function are at REM end of this file for efficiency on C64. The most commonly used REM function should be at the top since C64 BASIC scans line numbers REM for every GOTO/GOSUB. On the other hand, QBasic requires that REM arrays are dimensioned at the top of the file, not just as the REM first operation on that array so DIM_MEMORY for QBasic is here at REM the top. #qbasic DIM_MEMORY: #qbasic T=0 #qbasic #qbasic Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each) #qbasic Z2=199: REM S$/S% (string memory) size (3+2 bytes each) #qbasic Z3=200: REM X% (call stack) size (2 bytes each) #qbasic Z4=64: REM Y% (release stack) size (4 bytes each) #qbasic #qbasic REM boxed element memory #qbasic DIM Z%(Z1): REM TYPE ARRAY #qbasic #qbasic REM string memory storage #qbasic S=0:DIM S$(Z2):DIM S%(Z2) #qbasic #qbasic REM call/logic stack #qbasic X=-1:DIM X%(Z3): REM stack of Z% indexes #qbasic #qbasic REM pending release stack #qbasic Y=-1:DIM Y%(Z4,1): REM stack of Z% indexes and level/LV values #qbasic #qbasic RETURN REM stack functions #qbasic PUSH_A: #qbasic X=X+1:X%(X)=A:RETURN #qbasic POP_A: #qbasic A=X%(X):X=X-1:RETURN #qbasic #qbasic PUSH_R: #qbasic X=X+1:X%(X)=R:RETURN #qbasic POP_R: #qbasic R=X%(X):X=X-1:RETURN #qbasic #qbasic PUSH_Q: #qbasic X=X+1:X%(X)=Q:RETURN #qbasic POP_Q: #qbasic Q=X%(X):X=X-1:RETURN #qbasic PEEK_Q: #qbasic Q=X%(X):RETURN #qbasic PEEK_Q_1: #qbasic Q=X%(X-1):RETURN #qbasic PEEK_Q_2: #qbasic Q=X%(X-2):RETURN #qbasic PEEK_Q_Q: #qbasic Q=X%(X-Q):RETURN #qbasic PUT_Q: #qbasic X%(X)=Q:RETURN #qbasic PUT_Q_1: #qbasic X%(X-1)=Q:RETURN #qbasic PUT_Q_2: #qbasic X%(X-2)=Q:RETURN #cbm PUSH_A: #cbm X=X+2:POKE X,A AND255:POKE X+1,A/256:RETURN #cbm POP_A: #cbm A=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN #cbm #cbm PUSH_R: #cbm X=X+2:POKE X,R AND255:POKE X+1,R/256:RETURN #cbm POP_R: #cbm R=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN #cbm #cbm PUSH_Q: #cbm X=X+2:POKE X,Q AND255:POKE X+1,Q/256:RETURN #cbm POP_Q: #cbm Q=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN #cbm PEEK_Q: #cbm Q=PEEK(X)+PEEK(X+1)*256:RETURN #cbm PEEK_Q_1: #cbm Q=PEEK(X-2)+PEEK(X-1)*256:RETURN #cbm PEEK_Q_2: #cbm Q=PEEK(X-4)+PEEK(X-3)*256:RETURN #cbm PEEK_Q_Q: #cbm Q=PEEK(X-Q*2)+PEEK(X-Q*2+1)*256:RETURN #cbm PUT_Q: #cbm POKE X,Q AND255:POKE X+1,Q/256:RETURN #cbm PUT_Q_1: #cbm POKE X-2,Q AND255:POKE X-1,Q/256:RETURN #cbm PUT_Q_2: #cbm POKE X-4,Q AND255:POKE X-3,Q/256:RETURN REM memory functions REM ALLOC(T,L) -> R REM ALLOC(T,L,M) -> R REM ALLOC(T,L,M,N) -> R REM L is value for Z%(R+1) REM M is value for Z%(R+2), if SZ>2 REM N is value for Z%(R+3), if SZ>3 ALLOC: SZ=3 IF T<6 OR T=9 OR T=12 THEN SZ=2 IF T=8 OR T=10 OR T=11 THEN SZ=4 REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK) U=ZK R=ZK ALLOC_LOOP: IF R=ZI THEN GOTO ALLOC_UNUSED REM TODO sanity check that type is 15 IF ((Z%(R)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R) U=R: REM previous set to current R=Z%(R+1): REM current set to next GOTO ALLOC_LOOP ALLOC_MIDDLE: REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R) REM set free pointer (ZK) to next free IF R=ZK THEN ZK=Z%(R+1) REM set previous free to next free IF R<>ZK THEN Z%(U+1)=Z%(R+1) GOTO ALLOC_DONE ALLOC_UNUSED: REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R) IF R+SZ>Z1 THEN GOSUB PR_MEMORY_SUMMARY_SMALL:PRINT "Out of mal memory!":END ZI=ZI+SZ IF U=R THEN ZK=ZI REM set previous free to new memory top IF U<>R THEN Z%(U+1)=ZI GOTO ALLOC_DONE ALLOC_DONE: Z%(R)=T+32 REM set Z%(R+1) to default L Z%(R+1)=L IF T>5 AND T<>9 THEN Z%(L)=Z%(L)+32: REM value is a Z% idx IF SZ>2 THEN Z%(M)=Z%(M)+32:Z%(R+2)=M IF SZ>3 THEN Z%(N)=Z%(N)+32:Z%(R+3)=N RETURN REM FREE(AY, SZ) -> nil FREE: REM assumes reference count cleanup already (see RELEASE) Z%(AY)=(SZ*32)+15: REM set type(15) and size Z%(AY+1)=ZK ZK=AY IF SZ>=3 THEN Z%(AY+2)=0 IF SZ=4 THEN Z%(AY+3)=0 REM TODO: fail if SZ>4 RETURN REM RELEASE(AY) -> nil REM R should not be affected by this call RELEASE: RC=0 GOTO RELEASE_ONE RELEASE_TOP: IF RC=0 THEN RETURN REM pop next object to release, decrease remaining count GOSUB POP_Q:AY=Q RC=RC-1 RELEASE_ONE: IF AY=-1 THEN RETURN U=Z%(AY)AND 31: REM type V=Z%(AY+1): REM main value/reference REM set the size REM TODO: share with ALLOC calculation SZ=3 IF U<6 OR U=9 OR U=12 THEN SZ=2 IF U=8 OR U=10 OR U=11 THEN SZ=4 REM AZ=AY: B=1: GOSUB PR_STR REM PRINT "RELEASE AY:"+STR$(AY)+" ["+R$+"] (byte0:"+STR$(Z%(AY))+", SZ:"+STR$(SZ)+")" REM sanity check not already freed REM MEMORY DEBUGGING: REM IF U=15 THEN PRINT "RELEASE of free:"+STR$(AY):END REM IF Z%(AY)<15 THEN PRINT "RELEASE of unowned:"+STR$(AY):END REM decrease reference count by one Z%(AY)=Z%(AY)-32 REM nil, false, true, empty sequences REM MEMORY DEBUGGING: REM IF AY<16 AND Z%(AY)<32 THEN PRINT "RELEASE of empty:"+STR$(AY):END IF AY<16 THEN GOTO RELEASE_TOP REM our reference count is not 0, so don't release IF Z%(AY)>=32 GOTO RELEASE_TOP REM switch on type ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_HASH_MAP,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV,RELEASE_METADATA REM free the current element and continue, SZ already set GOSUB FREE GOTO RELEASE_TOP RELEASE_SIMPLE: RETURN RELEASE_STRING: REM string type, release interned string, then FREE reference REM MEMORY DEBUGGING: REM IF S%(V)=0 THEN PRINT "RELEASE of free string:"+STR$(S%(V)):END S%(V)=S%(V)-1 IF S%(V)=0 THEN S$(V)="": REM free BASIC string REM free the atom itself RETURN RELEASE_SEQ: IF V=0 THEN RETURN REM add value and next element to stack RC=RC+2 Q=Z%(AY+2):GOSUB PUSH_Q Q=V:GOSUB PUSH_Q RETURN RELEASE_HASH_MAP: IF V=0 THEN RETURN REM add key, value and next element to stack RC=RC+3 Q=Z%(AY+2):GOSUB PUSH_Q Q=Z%(AY+3):GOSUB PUSH_Q Q=V:GOSUB PUSH_Q RETURN RELEASE_ATOM: REM add contained/referred value RC=RC+1 Q=V:GOSUB PUSH_Q REM free the atom itself RETURN RELEASE_MAL_FUNCTION: REM add ast, params and environment to stack RC=RC+3 Q=V:GOSUB PUSH_Q Q=Z%(AY+2):GOSUB PUSH_Q Q=Z%(AY+3):GOSUB PUSH_Q REM free the current 3 element mal_function RETURN RELEASE_ENV: REM add the hashmap data to the stack RC=RC+1 Q=V:GOSUB PUSH_Q REM if outer set, add outer env to stack IF Z%(AY+2)<>0 THEN RC=RC+1:Q=Z%(AY+2):GOSUB PUSH_Q RETURN RELEASE_METADATA: REM add object and metadata object RC=RC+2 Q=V:GOSUB PUSH_Q Q=Z%(AY+2):GOSUB PUSH_Q RETURN REM INC_REF_R(R) -> R REM - return R with 1 ref cnt increase REM - call with GOTO to return at caller callsite REM - call with GOSUB to return to caller INC_REF_R: Z%(R)=Z%(R)+32 RETURN REM RETURN_TRUE_FALSE(R) -> R REM - take BASIC true/false R, return mal true/false R with ref cnt REM - called with GOTO as a return RETURN RETURN_TRUE_FALSE: IF R THEN R=4 IF R=0 THEN R=2 GOTO INC_REF_R REM release stack functions #qbasic PEND_A_LV: #qbasic Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV:RETURN #qbasic #qbasic REM RELEASE_PEND(LV) -> nil #qbasic RELEASE_PEND: #qbasic IF Y<0 THEN RETURN #qbasic IF Y%(Y,1)<=LV THEN RETURN #qbasic REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0)) #qbasic AY=Y%(Y,0):GOSUB RELEASE #qbasic Y=Y-1 #qbasic GOTO RELEASE_PEND #cbm PEND_A_LV: #cbm Y=Y+4:POKE Y,A AND255:POKE Y+1,A/256 #cbm POKE Y+2,LV AND255:POKE Y+3,LV/256:RETURN #cbm #cbm REM RELEASE_PEND(LV) -> nil #cbm RELEASE_PEND: #cbm IF Y=0 : pointer to error object ER=-2 E$="" REM Predefine nil, false, true, and an empty sequences FOR I=0 TO 15:Z%(I)=0:NEXT I Z%(0)=32: REM nil Z%(2)=1+32: REM false Z%(4)=1+32:Z%(5)=1: REM true Z%(6)=6+32: REM emtpy list Z%(9)=7+32: REM empty vector Z%(12)=8+32: REM empty hash-map REM start of unused memory ZI=16 REM start of free list ZK=16 REM start of time clock #cbm BT=TI #qbasic BT#=TIMER() RETURN ================================================ FILE: impls/basic/printer.in.bas ================================================ REM PR_STR(AZ, B) -> R$ PR_STR: R$="" PR_STR_RECUR: T=Z%(AZ)AND 31 U=Z%(AZ+1) REM PRINT "AZ: "+STR$(AZ)+", T: "+STR$(T)+", U: "+STR$(U) IF T=0 THEN R$="nil":RETURN REM if metadata, then get actual object IF T>=14 THEN AZ=U:GOTO PR_STR_RECUR ON T GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING_MAYBE,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_MAL_FUNCTION,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE PR_UNKNOWN: REM MEMORY DEBUGGING: REM R$="#" RETURN PR_RECUR: AZ=U GOTO PR_STR_RECUR PR_BOOLEAN: R$="true" IF U=0 THEN R$="false" RETURN PR_INTEGER: T$=STR$(U) REM Remove initial space IF U>=0 THEN T$=RIGHT$(T$,LEN(T$)-1) R$=R$+T$ RETURN PR_STRING_MAYBE: R$=S$(U) IF LEN(R$)=0 THEN GOTO PR_STRING IF MID$(R$,1,1)=CHR$(127) THEN R$=":"+MID$(R$,2,LEN(R$)-1):RETURN PR_STRING: IF B=1 THEN GOTO PR_STRING_READABLY RETURN PR_STRING_READABLY: S1$="\":S2$="\\":GOSUB REPLACE: REM escape backslash " S1$=CHR$(34):S2$="\"+CHR$(34):GOSUB REPLACE: REM escape quotes " #cbm S1$=CHR$(13):S2$="\n":GOSUB REPLACE: REM escape newlines #qbasic S1$=CHR$(10):S2$="\n":GOSUB REPLACE: REM escape newlines R$=CHR$(34)+R$+CHR$(34) RETURN PR_SYMBOL: R$=S$(U) RETURN PR_SEQ: REM push the type and where we are in the sequence Q=T:GOSUB PUSH_Q Q=AZ:GOSUB PUSH_Q REM save the current rendered string S$(S)=R$:S=S+1 PR_SEQ_LOOP: IF Z%(AZ+1)=0 THEN GOTO PR_SEQ_DONE AZ=Z%(AZ+2):GOSUB PR_STR:GOSUB PEEK_Q_1:T=Q REM append what we just rendered it S$(S-1)=S$(S-1)+R$ REM if this is a hash-map, print the next element IF T=8 THEN GOSUB PEEK_Q:AZ=Z%(Q+3):GOSUB PR_STR:S$(S-1)=S$(S-1)+" "+R$ REM restore current seq type GOSUB PEEK_Q_1:T=Q REM Go to next list element GOSUB PEEK_Q AZ=Z%(Q+1) Q=AZ:GOSUB PUT_Q IF Z%(AZ+1)<>0 THEN S$(S-1)=S$(S-1)+" " GOTO PR_SEQ_LOOP PR_SEQ_DONE: REM restore the current string S=S-1:R$=S$(S) REM pop where we are the sequence and type GOSUB POP_Q GOSUB POP_Q:T=Q: REM get type IF T=6 THEN R$="("+R$+")" IF T=7 THEN R$="["+R$+"]" IF T=8 THEN R$="{"+R$+"}" RETURN PR_FUNCTION: R$="#" RETURN PR_MAL_FUNCTION: T1=AZ AZ=Z%(T1+2):GOSUB PR_STR REM append what we just rendered it S$(S)="(fn* "+R$:S=S+1 AZ=Z%(T1+1):GOSUB PR_STR S=S-1 R$=S$(S)+" "+R$+")" RETURN PR_ATOM: AZ=U:GOSUB PR_STR R$="(atom "+R$+")" RETURN PR_ENV: R$="#" RETURN PR_FREE: R$="#" RETURN REM PR_STR_SEQ(AZ, B, B$) -> R$ REM - B is print_readably REM - B$ is the separator PR_STR_SEQ: V=AZ S$(S)="":S=S+1 PR_STR_SEQ_LOOP: IF Z%(V+1)=0 THEN S=S-1:R$=S$(S):RETURN AZ=Z%(V+2):GOSUB PR_STR REM goto the next sequence element V=Z%(V+1) IF Z%(V+1)=0 THEN S$(S-1)=S$(S-1)+R$ IF Z%(V+1)<>0 THEN S$(S-1)=S$(S-1)+R$+B$ GOTO PR_STR_SEQ_LOOP ================================================ FILE: impls/basic/reader.in.bas ================================================ REM READ_TOKEN(RF=0, A$, RI) -> T$ REM READ_TOKEN(RF=1) -> T$ READ_TOKEN: IF RF=1 THEN RF=2:T$="(":RETURN IF RF=2 THEN RF=3:T$="do":RETURN GOSUB SKIP_SPACES REM PRINT "READ_TOKEN: "+STR$(RI)+", "+MID$(A$,RI,1) GOSUB READ_CHAR IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_TOKEN T$=C$ IF T$="(" OR T$=")" OR T$="[" OR T$="]" OR T$="{" OR T$="}" OR T$="'" OR T$="`" OR T$="@" THEN RETURN IF T$="^" THEN RETURN GOSUB PEEK_CHAR: REM peek at next character IF T$="~" AND C$<>"@" THEN RETURN S1=0:S2=0: REM S1: INSTRING?, S2: ESCAPED? IF T$=CHR$(34) THEN S1=1 READ_TOKEN_LOOP: GOSUB PEEK_CHAR: REM peek at next character IF C$="" THEN RETURN IF S1 THEN GOTO READ_TOKEN_CONT IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN IF C$="(" OR C$=")" OR C$="[" OR C$="]" OR C$="{" OR C$="}" THEN RETURN READ_TOKEN_CONT: GOSUB READ_CHAR T$=T$+C$ IF T$="~@" THEN RETURN IF S1=0 OR S2=1 THEN S2=0:GOTO READ_TOKEN_LOOP REM S1=1 (INSTRING?) and S2=0 (not ESCAPED?) IF C$=CHR$(92) THEN S2=1 IF C$=CHR$(34) THEN RETURN GOTO READ_TOKEN_LOOP REM READ_CHAR(A$, RI) -> C$ READ_CHAR: RJ=1:GOSUB DO_READ_CHAR RETURN REM PEEK_CHAR(A$, RI) -> C$ PEEK_CHAR: RJ=0:GOSUB DO_READ_CHAR RETURN REM DO_READ_CHAR(RJ, A$, RI): REM - RI is position in A$ REM - RJ=1 is read, RJ=0 is peek DO_READ_CHAR: C$="" IF RF>0 THEN GOTO READ_FILE_CHAR IF RI<=LEN(A$) THEN C$=MID$(A$,RI,1):RI=RI+RJ RETURN REM READ_FILE_CHAR(RJ) -> C$ REM - RJ=1 is read, RJ=0 is peek REM - D$ is global used for already read pending character REM - EZ is global used for end of file state READ_FILE_CHAR: IF D$<>"" THEN C$=D$:IF RJ=0 THEN RETURN IF D$<>"" AND RJ=1 THEN D$="":RETURN D$="" IF EZ>2 THEN C$="" IF EZ=2 THEN C$=")" IF EZ=1 THEN C$=CHR$(10) IF EZ>0 THEN EZ=EZ+RJ:RETURN #cbm GET#2,C$ #qbasic C$=INPUT$(1,2) #qbasic IF EOF(2) THEN EZ=1:RETURN IF RJ=0 THEN D$=C$ #cbm IF (ST AND 64) THEN EZ=1:RETURN #cbm IF (ST AND 255) THEN EZ=1:ER=-1:E$="File read error"+STR$(ST) RETURN SKIP_SPACES: GOSUB PEEK_CHAR: REM peek at next character IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN GOSUB READ_CHAR:GOTO SKIP_SPACES RETURN SKIP_TO_EOL: GOSUB READ_CHAR IF C$="" OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN GOTO SKIP_TO_EOL REM READ_FORM(A$, RI, RF) -> R SUB READ_FORM Q=T:GOSUB PUSH_Q: REM save current value of T READ_FORM_RECUR: IF ER<>-2 THEN GOTO READ_FORM_RETURN GOSUB READ_TOKEN REM PRINT "READ_FORM T$: ["+T$+"]" IF T$="" THEN R=0:GOSUB INC_REF_R:GOTO READ_FORM_RETURN IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL IF T$="false" THEN T=1:GOTO READ_NIL_BOOL IF T$="true" THEN T=2:GOTO READ_NIL_BOOL IF T$="'" THEN B$="quote":GOTO READ_MACRO IF T$="`" THEN B$="quasiquote":GOTO READ_MACRO IF T$="~" THEN B$="unquote":GOTO READ_MACRO IF T$="~@" THEN B$="splice-unquote":GOTO READ_MACRO IF T$="^" THEN B$="with-meta":GOTO READ_MACRO IF T$="@" THEN B$="deref":GOTO READ_MACRO C$=MID$(T$,1,1) REM PRINT "C$: ["+C$+"]("+STR$(ASC(C$))+")" IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER IF C$="-" THEN GOTO READ_SYMBOL_MAYBE IF C$=CHR$(34) THEN GOTO READ_STRING IF C$=":" THEN GOTO READ_KEYWORD REM set end character in Q and read the sequence IF C$="(" THEN T=6:Q=41:GOTO READ_SEQ_START: REM ")" IF C$="[" THEN T=7:Q=93:GOTO READ_SEQ_START: REM "]" IF C$="{" THEN T=8:Q=125:GOTO READ_SEQ_START: REM "}" IF C$=")" OR C$="]" OR C$="}" THEN R=-1:ER=-1:E$="unexpected "+C$:GOTO READ_FORM_RETURN GOTO READ_SYMBOL READ_NIL_BOOL: REM PRINT "READ_NIL_BOOL" R=T*2 GOSUB INC_REF_R GOTO READ_FORM_RETURN READ_NUMBER: REM PRINT "READ_NUMBER" T=2:L=VAL(T$):GOSUB ALLOC GOTO READ_FORM_RETURN READ_MACRO: REM push macro type Q=-1*(T$="^"):GOSUB PUSH_Q REM B$ is set above T=5:GOSUB STRING REM push string GOSUB PUSH_R CALL READ_FORM REM push first form GOSUB PUSH_R IF ER>-2 THEN GOTO READ_MACRO_DONE GOSUB PEEK_Q_2 IF Q THEN GOTO READ_MACRO_3 READ_MACRO_2: GOSUB PEEK_Q_1:B=Q GOSUB PEEK_Q:A=Q GOSUB LIST2 GOTO READ_MACRO_DONE READ_MACRO_3: CALL READ_FORM GOSUB PEEK_Q_1:C=Q B=R GOSUB PEEK_Q:A=Q GOSUB LIST3 AY=C:GOSUB RELEASE READ_MACRO_DONE: REM release values, list has ownership AY=B:GOSUB RELEASE AY=A:GOSUB RELEASE REM pop the stack GOSUB POP_Q: REM pop first form GOSUB POP_Q: REM pop string GOSUB POP_Q: REM pop macro type T$="": REM necessary to prevent unexpected EOF errors GOTO READ_FORM_RETURN READ_STRING: REM PRINT "READ_STRING" C=ASC(MID$(T$,LEN(T$),1)) IF C<>34 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN J=2:R$="" READ_STRING_LOOP: #qbasic I=INSTR(J,T$,CHR$(92)) #cbm I=J #cbm INSTR_LOOP: #cbm IF I>LEN(T$) THEN I=0:GOTO INSTR_DONE #cbm IF MID$(T$,I,1)=CHR$(92) THEN GOTO INSTR_DONE #cbm I=I+1 #cbm GOTO INSTR_LOOP #cbm INSTR_DONE: IF I=0 THEN GOTO READ_STRING_DONE R$=R$+MID$(T$,J,I-J) C$=MID$(T$,I+1,1) #qbasic IF C$="n" THEN R$=R$+CHR$(10) ELSE R$=R$+C$ #cbm IF C$="n" THEN R$=R$+CHR$(13) #cbm IF C$<>"n" THEN R$=R$+C$ J=I+2 GOTO READ_STRING_LOOP READ_STRING_DONE: IF J=LEN(T$)+1 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN R$=R$+MID$(T$,J,LEN(T$)-J) REM intern string value B$=R$:T=4:GOSUB STRING GOTO READ_FORM_RETURN READ_KEYWORD: R$=CHR$(127)+MID$(T$,2,LEN(T$)-1) B$=R$:T=4:GOSUB STRING GOTO READ_FORM_RETURN READ_SYMBOL_MAYBE: C$=MID$(T$,2,1) IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER READ_SYMBOL: REM PRINT "READ_SYMBOL" B$=T$:T=5:GOSUB STRING GOTO READ_FORM_RETURN READ_SEQ_START: SD=SD+1 GOSUB PUSH_Q: REM push return character REM setup the stack for the loop, T has type GOSUB MAP_LOOP_START READ_SEQ_LOOP: REM TODO: reduce redundancy with READ_TOKEN GOSUB SKIP_SPACES GOSUB PEEK_CHAR: REM peek at next character IF C$="" THEN ER=-1:E$="unexpected EOF":GOTO READ_SEQ_DONE IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_SEQ_LOOP Q=3:GOSUB PEEK_Q_Q IF C$=CHR$(Q) THEN GOSUB READ_CHAR:GOTO READ_SEQ_DONE CALL READ_FORM M=R: REM value (or key for hash-maps) REM if error, release the unattached element IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO READ_SEQ_DONE REM if this is a hash-map, READ_FORM again IF T=8 THEN GOSUB PUSH_R:CALL READ_FORM IF T=8 THEN N=R:GOSUB POP_Q:M=Q: REM set key and value REM update the return sequence structure REM release N since list takes full ownership C=1:GOSUB MAP_LOOP_UPDATE GOTO READ_SEQ_LOOP READ_SEQ_DONE: SD=SD-1 REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOSUB POP_Q: REM pop end character ptr GOTO READ_FORM_RETURN READ_FORM_RETURN: GOSUB POP_Q:T=Q: REM restore current value of T END SUB REM READ_STR(A$) -> R READ_STR: RI=1: REM index into A$ RF=0: REM not reading from file SD=0: REM sequence read depth CALL READ_FORM RETURN REM READ_FILE(A$) -> R READ_FILE: RF=1: REM reading from file EZ=0: REM file read state (1: EOF) SD=0: REM sequence read depth D$="": REM pending read/peek character #cbm OPEN 2,8,0,A$ #qbasic OPEN A$ FOR INPUT AS #2 #qbasic IF ERR()<>0 THEN ER=-1:E$="File not found":RETURN REM READ_TOKEN adds "(do ... )" CALL READ_FORM CLOSE 2 EZ=0 RETURN ================================================ FILE: impls/basic/readline.in.bas ================================================ REM READLINE(A$) -> R$ READLINE: EZ=0 PRINT A$; C$="":R$="":C=0 READCH: #cbm GET C$ #qbasic C$=INKEY$ IF C$="" THEN GOTO READCH C=ASC(C$) #qbasic IF ASC(C$)=8 THEN C=20:C$=CHR$(20) IF C=4 OR C=0 THEN EZ=1:GOTO RL_DONE: REM EOF IF C=127 OR C=20 THEN GOSUB RL_BACKSPACE IF C=127 OR C=20 THEN GOTO READCH IF (C<32 OR C>127) AND C<>13 THEN GOTO READCH PRINT C$; IF LEN(R$)<255 AND C$<>CHR$(13) THEN R$=R$+C$ IF LEN(R$)<255 AND C$<>CHR$(13) THEN GOTO READCH RL_DONE: #qbasic PRINT RETURN REM Assumes R$ has input buffer RL_BACKSPACE: IF LEN(R$)=0 THEN RETURN R$=LEFT$(R$,LEN(R$)-1) #cbm PRINT CHR$(157)+" "+CHR$(157); #qbasic LOCATE ,POS(0)-1 #qbasic PRINT " "; #qbasic LOCATE ,POS(0)-1 RETURN ================================================ FILE: impls/basic/run ================================================ #!/usr/bin/env bash cd $(dirname $0) (echo "(def! -*ARGS*- (list $(for a in "${@}"; do echo -n " \"${a}\""; done)))") > .args.mal case ${basic_MODE:-cbm} in cbm) exec cbmbasic ${STEP:-stepA_mal}.bas "${@}" ;; qbasic) exec ./${STEP:-stepA_mal} "${@}" ;; *) echo "Invalid basic_MODE: ${basic_MODE}"; exit 2 ;; esac ================================================ FILE: impls/basic/step0_repl.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL(A$) -> R$ SUB EVAL R$=A$ END SUB REM PRINT is inlined in REP REM REP(A$) -> R$ SUB REP REM inlined READ (not affecting A$) CALL EVAL REM inlined PRINT (not affecting A$) END SUB REM MAIN program MAIN: GOSUB DIM_MEMORY REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL #cbm END #qbasic SYSTEM ================================================ FILE: impls/basic/step1_read_print.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL(A) -> R SUB EVAL R=A END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:CALL EVAL RE_DONE: RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY ZT=ZI: REM top of memory after base repl_env REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step2_eval.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A on the stack GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A off the stack GOSUB POP_A END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A on the stack GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) IF ER<>-2 THEN GOTO EVAL_RETURN REM AZ=A:B=1:GOSUB PR_STR REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" GOSUB TYPE_A T=T-4 IF 0-2 THEN GOTO EVAL_RETURN AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 0 R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env GOSUB HASHMAP:D=R REM + function T=9:L=1:GOSUB ALLOC: REM native function H=D:B$="+":C=R:GOSUB ASSOC1_S:D=R REM - function T=9:L=2:GOSUB ALLOC: REM native function H=D:B$="-":C=R:GOSUB ASSOC1_S:D=R REM * function T=9:L=3:GOSUB ALLOC: REM native function H=D:B$="*":C=R:GOSUB ASSOC1_S:D=R REM / function T=9:L=4:GOSUB ALLOC: REM native function H=D:B$="/":C=R:GOSUB ASSOC1_S:D=R ZT=ZI: REM top of memory after base repl_env REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step3_env.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) IF ER<>-2 THEN GOTO EVAL_RETURN B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 05 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:A2=Q: REM pop A2 A=A2:CALL EVAL: REM eval A2 using let_env GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST W=R REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 0 R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R E=D REM + function T=9:L=1:GOSUB ALLOC: REM native function B$="+":C=R:GOSUB ENV_SET_S REM - function T=9:L=2:GOSUB ALLOC: REM native function B$="-":C=R:GOSUB ENV_SET_S REM * function T=9:L=3:GOSUB ALLOC: REM native function B$="*":C=R:GOSUB ENV_SET_S REM / function T=9:L=4:GOSUB ALLOC: REM native function B$="/":C=R:GOSUB ENV_SET_S ZT=ZI: REM top of memory after base repl_env REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step4_if_fn_do.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 05 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:A2=Q: REM pop A2 A=A2:CALL EVAL: REM eval A2 using let_env GOTO EVAL_RETURN EVAL_DO: A=Z%(A+1): REM rest CALL EVAL_AST GOSUB PUSH_R: REM push eval'd list A=R:GOSUB LAST: REM return the last element GOSUB POP_Q:AY=Q: REM pop eval'd list GOSUB RELEASE: REM release the eval'd list GOTO EVAL_RETURN EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step5_tco.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 05 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE REPL_LOOP: A$="user> ":GOSUB READLINE: REM call input parser IF EZ=1 THEN GOTO QUIT IF R$="" THEN GOTO REPL_LOOP A$=R$:CALL REP IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step6_file.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 05 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" GOSUB RE:AY=R:GOSUB RELEASE REM load the args file A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE IF ER>-2 THEN GOSUB PRINT_ERROR:END REM set the argument list A$="(def! *ARGV* (rest -*ARGS*-))" GOSUB RE:AY=R:GOSUB RELEASE REM get the first argument A$="(first -*ARGS*-)" GOSUB RE REM no arguments, start REPL loop REM if there is an argument, then run it as a program IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP RUN_PROG: REM free up first arg because we get it again AY=R:GOSUB RELEASE REM run a single mal program and exit A$="(load-file (first -*ARGS*-))" GOSUB RE IF ER<>-2 THEN GOSUB PRINT_ERROR QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step7_quote.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM QUASIQUOTE(A) -> R SUB QUASIQUOTE GOSUB TYPE_A T=T-4 IF 05 THEN GOTO QQ_LIST_NORMAL IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL REM Indeed. Return a list containing 'unquote and the form. R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO QQ_DONE QQ_LIST_NORMAL: REM Normal list, process with QQ_FOLDR. 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 A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A REM Set A to elt = (first A) A=Z%(A+2) 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 GOTO QQ_DEFAULT REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) A=R B$="concat":T=5:GOSUB STRING:C=R GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE GOTO QQ_FOLDR_DONE 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 QQ_FOLDR_DONE: END SUB REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 05 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_QUOTE: R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO EVAL_RETURN EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE A=R REM add quasiquote result to pending release queue to free when REM next lower EVAL level returns (LV) GOSUB PEND_A_LV GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" GOSUB RE:AY=R:GOSUB RELEASE REM load the args file A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE IF ER>-2 THEN GOSUB PRINT_ERROR:END REM set the argument list A$="(def! *ARGV* (rest -*ARGS*-))" GOSUB RE:AY=R:GOSUB RELEASE REM get the first argument A$="(first -*ARGS*-)" GOSUB RE REM no arguments, start REPL loop REM if there is an argument, then run it as a program IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP RUN_PROG: REM free up first arg because we get it again AY=R:GOSUB RELEASE REM run a single mal program and exit A$="(load-file (first -*ARGS*-))" GOSUB RE IF ER<>-2 THEN GOSUB PRINT_ERROR QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step8_macros.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM QUASIQUOTE(A) -> R SUB QUASIQUOTE GOSUB TYPE_A T=T-4 IF 05 THEN GOTO QQ_LIST_NORMAL IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL REM Indeed. Return a list containing 'unquote and the form. R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO QQ_DONE QQ_LIST_NORMAL: REM Normal list, process with QQ_FOLDR. 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 A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A REM Set A to elt = (first A) A=Z%(A+2) 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 GOTO QQ_DEFAULT REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) A=R B$="concat":T=5:GOSUB STRING:C=R GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE GOTO QQ_FOLDR_DONE 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 QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: SUB MACROEXPAND GOSUB PUSH_A MACROEXPAND_LOOP: REM list? GOSUB TYPE_A IF T<>6 THEN GOTO MACROEXPAND_DONE REM non-empty? IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE B=Z%(A+2) REM symbol? in first position IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE REM defined in environment? B$=S$(Z%(B+1)):CALL ENV_GET IF R3=0 THEN GOTO MACROEXPAND_DONE B=R REM macro? IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE GOSUB INC_REF_R F=B:AR=Z%(A+1):CALL APPLY A=R GOSUB PEEK_Q:AY=Q REM if previous A was not the first A into macroexpand (i.e. an REM intermediate form) then free it IF A<>AY THEN GOSUB PEND_A_LV IF ER<>-2 THEN GOTO MACROEXPAND_DONE GOTO MACROEXPAND_LOOP MACROEXPAND_DONE: GOSUB POP_Q: REM pop original A END SUB REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN EVAL_NOT_LIST: B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 01 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN A0=Z%(A+2) REM get symbol in A$ IF (Z%(A0)AND 31)<>5 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_QUOTE: R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO EVAL_RETURN EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE A=R REM add quasiquote result to pending release queue to free when REM next lower EVAL level returns (LV) GOSUB PEND_A_LV GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DEFMACRO: REM PRINT "defmacro!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q: REM push A1 A=A2:CALL EVAL: REM eval A2 GOSUB POP_Q:A1=Q: REM pop A1 REM change function to macro Z%(R)=Z%(R)+1 REM set A1 in env to A2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" GOSUB RE:AY=R:GOSUB RELEASE REM load the args file A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE IF ER>-2 THEN GOSUB PRINT_ERROR:END REM set the argument list A$="(def! *ARGV* (rest -*ARGS*-))" GOSUB RE:AY=R:GOSUB RELEASE REM get the first argument A$="(first -*ARGS*-)" GOSUB RE REM no arguments, start REPL loop REM if there is an argument, then run it as a program IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP RUN_PROG: REM free up first arg because we get it again AY=R:GOSUB RELEASE REM run a single mal program and exit A$="(load-file (first -*ARGS*-))" GOSUB RE IF ER<>-2 THEN GOSUB PRINT_ERROR QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/step9_try.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM QUASIQUOTE(A) -> R SUB QUASIQUOTE GOSUB TYPE_A T=T-4 IF 05 THEN GOTO QQ_LIST_NORMAL IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL REM Indeed. Return a list containing 'unquote and the form. R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO QQ_DONE QQ_LIST_NORMAL: REM Normal list, process with QQ_FOLDR. 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 A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A REM Set A to elt = (first A) A=Z%(A+2) 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 GOTO QQ_DEFAULT REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) A=R B$="concat":T=5:GOSUB STRING:C=R GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE GOTO QQ_FOLDR_DONE 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 QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: SUB MACROEXPAND GOSUB PUSH_A MACROEXPAND_LOOP: REM list? GOSUB TYPE_A IF T<>6 THEN GOTO MACROEXPAND_DONE REM non-empty? IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE B=Z%(A+2) REM symbol? in first position IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE REM defined in environment? B$=S$(Z%(B+1)):CALL ENV_GET IF R3=0 THEN GOTO MACROEXPAND_DONE B=R REM macro? IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE GOSUB INC_REF_R F=B:AR=Z%(A+1):CALL APPLY A=R GOSUB PEEK_Q:AY=Q REM if previous A was not the first A into macroexpand (i.e. an REM intermediate form) then free it IF A<>AY THEN GOSUB PEND_A_LV IF ER<>-2 THEN GOTO MACROEXPAND_DONE GOTO MACROEXPAND_LOOP MACROEXPAND_DONE: GOSUB POP_Q: REM pop original A END SUB REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN EVAL_NOT_LIST: B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 01 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN A0=Z%(A+2) REM get symbol in A$ IF (Z%(A0)AND 31)<>5 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="try*" THEN GOTO EVAL_TRY IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_QUOTE: R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO EVAL_RETURN EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE A=R REM add quasiquote result to pending release queue to free when REM next lower EVAL level returns (LV) GOSUB PEND_A_LV GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DEFMACRO: REM PRINT "defmacro!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q: REM push A1 A=A2:CALL EVAL: REM eval A2 GOSUB POP_Q:A1=Q: REM pop A1 REM change function to macro Z%(R)=Z%(R)+1 REM set A1 in env to A2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_TRY: REM PRINT "try*" GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL: REM eval A1 GOSUB POP_A: REM pop/restore A GOSUB EVAL_GET_A2: REM set A1 and A2 REM if there is no error or catch block then return IF ER=-2 OR A2=0 THEN GOTO EVAL_RETURN REM create environment for the catch block eval C=E:GOSUB ENV_NEW:E=R A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block REM create object for ER=-1 type raw string errors IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R REM bind the catch symbol to the error object K=A1:C=ER:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, env took ownership REM unset error for catch eval ER=-2:E$="" A=A2:CALL EVAL GOTO EVAL_RETURN EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" GOSUB RE:AY=R:GOSUB RELEASE REM load the args file A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE IF ER>-2 THEN GOSUB PRINT_ERROR:END REM set the argument list A$="(def! *ARGV* (rest -*ARGS*-))" GOSUB RE:AY=R:GOSUB RELEASE REM get the first argument A$="(first -*ARGS*-)" GOSUB RE REM no arguments, start REPL loop REM if there is an argument, then run it as a program IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP RUN_PROG: REM free up first arg because we get it again AY=R:GOSUB RELEASE REM run a single mal program and exit A$="(load-file (first -*ARGS*-))" GOSUB RE IF ER<>-2 THEN GOSUB PRINT_ERROR QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: REM if the error is an object, then print and free it IF ER>=0 THEN AZ=ER:B=0:GOSUB PR_STR:E$=R$:AY=ER:GOSUB RELEASE PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/stepA_mal.in.bas ================================================ GOTO MAIN REM $INCLUDE: 'mem.in.bas' REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'readline.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' REM $INCLUDE: 'core.in.bas' REM $INCLUDE: 'debug.in.bas' REM READ is inlined in RE REM QUASIQUOTE(A) -> R SUB QUASIQUOTE GOSUB TYPE_A T=T-4 IF 05 THEN GOTO QQ_LIST_NORMAL IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST_NORMAL REM Indeed. Return a list containing 'unquote and the form. R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO QQ_DONE QQ_LIST_NORMAL: REM Normal list, process with QQ_FOLDR. 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 A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A REM Set A to elt = (first A) A=Z%(A+2) 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 GOTO QQ_DEFAULT REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) A=R B$="concat":T=5:GOSUB STRING:C=R GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE GOTO QQ_FOLDR_DONE 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 QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: SUB MACROEXPAND GOSUB PUSH_A MACROEXPAND_LOOP: REM list? GOSUB TYPE_A IF T<>6 THEN GOTO MACROEXPAND_DONE REM non-empty? IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE B=Z%(A+2) REM symbol? in first position IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE REM defined in environment? B$=S$(Z%(B+1)):CALL ENV_GET IF R3=0 THEN GOTO MACROEXPAND_DONE B=R REM macro? IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE GOSUB INC_REF_R F=B:AR=Z%(A+1):CALL APPLY A=R GOSUB PEEK_Q:AY=Q REM if previous A was not the first A into macroexpand (i.e. an REM intermediate form) then free it IF A<>AY THEN GOSUB PEND_A_LV IF ER<>-2 THEN GOTO MACROEXPAND_DONE GOTO MACROEXPAND_LOOP MACROEXPAND_DONE: GOSUB POP_Q: REM pop original A END SUB REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A IF T<6 OR 88 THEN A=Z%(A+2) IF T=8 THEN A=Z%(A+3) Q=T:GOSUB PUSH_Q: REM push/save type CALL EVAL GOSUB POP_Q:T=Q: REM pop/restore type GOSUB POP_A M=R REM if error, release the unattached element REM TODO: is R=0 correct? IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE REM for hash-maps, copy the key (inc ref since we are going to REM release it below) IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 REM update the return sequence structure REM release N (and M if T=8) since seq takes full ownership C=1:GOSUB MAP_LOOP_UPDATE REM process the next sequence entry from source list A=Z%(A+1) GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: REM cleanup stack and get return value GOSUB MAP_LOOP_DONE GOTO EVAL_AST_RETURN EVAL_AST_RETURN: REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM EVAL(A, E) -> R SUB EVAL LV=LV+1: REM track basic return stack level REM push A and E on the stack Q=E:GOSUB PUSH_Q GOSUB PUSH_A REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) EVAL_TCO_RECUR: IF ER<>-2 THEN GOTO EVAL_RETURN EVAL_NOT_LIST: B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" DEBUG_EVAL_DONE: GOSUB TYPE_A T=T-4 IF 01 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN A0=Z%(A+2) REM get symbol in A$ IF (Z%(A0)AND 31)<>5 THEN A$="" IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="try*" THEN GOTO EVAL_TRY IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF IF A$="fn*" THEN GOTO EVAL_FN GOTO EVAL_INVOKE EVAL_GET_A3: A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) EVAL_GET_A2: A2=Z%(Z%(Z%(A+1)+1)+2) EVAL_GET_A1: A1=Z%(Z%(A+1)+2) RETURN EVAL_DEF: REM PRINT "def!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q A=A2:CALL EVAL: REM eval a2 GOSUB POP_Q:A1=Q IF ER<>-2 THEN GOTO EVAL_RETURN REM set a1 in env to a2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_LET: REM PRINT "let*" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A2:GOSUB PUSH_Q: REM push/save A2 Q=E:GOSUB PUSH_Q: REM push env for for later release REM create new environment with outer as current environment C=E:GOSUB ENV_NEW E=R EVAL_LET_LOOP: IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE Q=A1:GOSUB PUSH_Q: REM push A1 REM eval current A1 odd element A=Z%(Z%(A1+1)+2):CALL EVAL GOSUB POP_Q:A1=Q: REM pop A1 IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE REM set key/value in the environment K=Z%(A1+2):C=R:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership REM skip to the next pair of A1 elements A1=Z%(Z%(A1+1)+1) GOTO EVAL_LET_LOOP EVAL_LET_LOOP_DONE: GOSUB POP_Q:AY=Q: REM pop previous env REM release previous environment if not the current EVAL env GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE GOSUB POP_Q:A2=Q: REM pop A2 A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DO: A=Z%(A+1): REM rest GOSUB PUSH_A: REM push/save A REM this must be EVAL_AST call #2 for EVAL_AST to return early REM and for TCO to work CALL EVAL_AST REM cleanup AY=R: REM get eval'd list for release GOSUB POP_A: REM pop/restore original A for LAST GOSUB LAST: REM get last element for return A=R: REM new recur AST REM cleanup GOSUB RELEASE: REM release eval'd list AY=A:GOSUB RELEASE: REM release LAST value (not sure why) GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_QUOTE: R=Z%(Z%(A+1)+2) GOSUB INC_REF_R GOTO EVAL_RETURN EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE A=R REM add quasiquote result to pending release queue to free when REM next lower EVAL level returns (LV) GOSUB PEND_A_LV GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_DEFMACRO: REM PRINT "defmacro!" GOSUB EVAL_GET_A2: REM set A1 and A2 Q=A1:GOSUB PUSH_Q: REM push A1 A=A2:CALL EVAL: REM eval A2 GOSUB POP_Q:A1=Q: REM pop A1 REM change function to macro Z%(R)=Z%(R)+1 REM set A1 in env to A2 K=A1:C=R:GOSUB ENV_SET GOTO EVAL_RETURN EVAL_TRY: REM PRINT "try*" GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL: REM eval A1 GOSUB POP_A: REM pop/restore A GOSUB EVAL_GET_A2: REM set A1 and A2 REM if there is no error or catch block then return IF ER=-2 OR A2=0 THEN GOTO EVAL_RETURN REM create environment for the catch block eval C=E:GOSUB ENV_NEW:E=R A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block REM create object for ER=-1 type raw string errors IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R REM bind the catch symbol to the error object K=A1:C=ER:GOSUB ENV_SET AY=R:GOSUB RELEASE: REM release our use, env took ownership REM unset error for catch eval ER=-2:E$="" A=A2:CALL EVAL GOTO EVAL_RETURN EVAL_IF: GOSUB EVAL_GET_A1: REM set A1 GOSUB PUSH_A: REM push/save A A=A1:CALL EVAL GOSUB POP_A: REM pop/restore A IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE EVAL_IF_TRUE: AY=R:GOSUB RELEASE GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_IF_FALSE: AY=R:GOSUB RELEASE REM if no false case (A3), return nil GOSUB COUNT IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_FN: GOSUB EVAL_GET_A2: REM set A1 and A2 T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function GOTO EVAL_RETURN EVAL_INVOKE: CALL EVAL_AST REM if error, return f/args for release by caller IF ER<>-2 THEN GOTO EVAL_RETURN REM push f/args for release after call GOSUB PUSH_R AR=Z%(R+1): REM rest F=Z%(R+2) REM if metadata, get the actual object GOSUB TYPE_F IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F T=T-8 IF 064 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS REM release previous env if it is not the top one on the REM stack (X%(X-2)) because our new env refers to it and REM we no longer need to track it (since we are TCO recurring) GOSUB POP_Q:AY=Q GOSUB PEEK_Q_2 IF AY<>Q THEN GOSUB RELEASE REM claim the AST before releasing the list containing it A=Z%(F+1):Z%(A)=Z%(A)+32 REM add AST to pending release queue to free as soon as EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args GOSUB POP_Q:AY=Q GOSUB RELEASE REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) REM release environment if not the top one on the stack GOSUB PEEK_Q_1 IF E<>Q THEN AY=E:GOSUB RELEASE LV=LV-1: REM track basic return stack level REM release everything we couldn't release earlier GOSUB RELEASE_PEND REM trigger GC #cbm T=FRE(0) #qbasic T=0 REM pop A and E off the stack GOSUB POP_A GOSUB POP_Q:E=Q END SUB REM PRINT is inlined in REP REM RE(A$) -> R REM Assume D has repl_env REM caller must release result RE: R1=-1 GOSUB READ_STR: REM inlined READ R1=R IF ER<>-2 THEN GOTO RE_DONE A=R:E=D:CALL EVAL RE_DONE: REM Release memory from READ AY=R1:GOSUB RELEASE RETURN: REM caller must release result of EVAL REM REP(A$) -> R$ REM Assume D has repl_env SUB REP R2=-1 GOSUB RE R2=R IF ER<>-2 THEN GOTO REP_DONE AZ=R:B=1:GOSUB PR_STR: REM inlined PRINT REP_DONE: REM Release memory from EVAL AY=R2:GOSUB RELEASE END SUB REM MAIN program MAIN: GOSUB INIT_MEMORY LV=0 REM create repl_env C=0:GOSUB ENV_NEW:D=R REM core.EXT: defined in Basic E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env ZT=ZI: REM top of memory after base repl_env REM core.mal: defined using the language itself #cbm A$="(def! *host-language* "+CHR$(34)+"C64 BASIC"+CHR$(34)+")" #qbasic A$="(def! *host-language* "+CHR$(34)+"QBasic"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! not (fn* (a) (if a false true)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(def! load-file (fn* (f) (do (eval (read-file f)) nil)))" GOSUB RE:AY=R:GOSUB RELEASE A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)" A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of" A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))" GOSUB RE:AY=R:GOSUB RELEASE REM load the args file A$="(load-file "+CHR$(34)+".args.mal"+CHR$(34)+")" GOSUB RE:AY=R:GOSUB RELEASE IF ER>-2 THEN GOSUB PRINT_ERROR:END REM set the argument list A$="(def! *ARGV* (rest -*ARGS*-))" GOSUB RE:AY=R:GOSUB RELEASE REM get the first argument A$="(first -*ARGS*-)" GOSUB RE REM no arguments, start REPL loop REM if there is an argument, then run it as a program IF 15-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP PRINT R$ GOTO REPL_LOOP RUN_PROG: REM free up first arg because we get it again AY=R:GOSUB RELEASE REM run a single mal program and exit A$="(load-file (first -*ARGS*-))" GOSUB RE IF ER<>-2 THEN GOSUB PRINT_ERROR QUIT: REM GOSUB PR_MEMORY_SUMMARY_SMALL REM GOSUB PR_MEMORY_MAP REM P1=0:P2=ZI:GOSUB PR_MEMORY REM P1=D:GOSUB PR_OBJECT REM P1=ZK:GOSUB PR_OBJECT #cbm END #qbasic SYSTEM PRINT_ERROR: REM if the error is an object, then print and free it IF ER>=0 THEN AZ=ER:B=0:GOSUB PR_STR:E$=R$:AY=ER:GOSUB RELEASE PRINT "Error: "+E$ ER=-2:E$="" RETURN ================================================ FILE: impls/basic/types.in.bas ================================================ REM general functions REM TYPE_A(A) -> T TYPE_A: T=Z%(A)AND 31 RETURN REM TYPE_F(F) -> T TYPE_F: T=Z%(F)AND 31 RETURN REM EQUAL_Q(A, B) -> R EQUAL_Q: ED=0: REM recursion depth R=-1: REM return value EQUAL_Q_RECUR: REM push A and B GOSUB PUSH_A Q=B:GOSUB PUSH_Q ED=ED+1 GOSUB TYPE_A T2=Z%(B)AND 31 IF T>5 AND T<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ IF T=8 AND T2=8 THEN GOTO EQUAL_Q_HM IF T<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0 GOTO EQUAL_Q_DONE EQUAL_Q_SEQ: IF Z%(A+1)=0 AND Z%(B+1)=0 THEN GOTO EQUAL_Q_DONE IF Z%(A+1)=0 OR Z%(B+1)=0 THEN R=0:GOTO EQUAL_Q_DONE REM compare the elements A=Z%(A+2):B=Z%(B+2) GOTO EQUAL_Q_RECUR EQUAL_Q_SEQ_CONTINUE: REM next elements of the sequences GOSUB PEEK_Q_1:A=Q GOSUB PEEK_Q:B=Q A=Z%(A+1):B=Z%(B+1) Q=A:GOSUB PUT_Q_1 Q=B:GOSUB PUT_Q GOTO EQUAL_Q_SEQ EQUAL_Q_HM: R=0 GOTO EQUAL_Q_DONE EQUAL_Q_DONE: REM pop current A and B GOSUB POP_Q GOSUB POP_Q ED=ED-1 IF R>-1 AND ED>0 THEN GOTO EQUAL_Q_DONE: REM unwind IF ED=0 AND R=-1 THEN R=1 IF ED=0 THEN RETURN GOTO EQUAL_Q_SEQ_CONTINUE REM string functions REM STRING(B$, T) -> R REM intern string and allocate reference (return Z% index) STRING: IF S=0 THEN GOTO STRING_NOT_FOUND REM search for matching string in S$ I=0 STRING_FIND_LOOP: IF I>S-1 THEN GOTO STRING_NOT_FOUND IF S%(I)>0 AND B$=S$(I) THEN GOTO STRING_DONE I=I+1 GOTO STRING_FIND_LOOP STRING_NOT_FOUND: I=S-1 STRING_FIND_GAP_LOOP: REM TODO: don't search core function names (store position) IF I=-1 THEN GOTO STRING_NEW IF S%(I)=0 THEN GOTO STRING_SET I=I-1 GOTO STRING_FIND_GAP_LOOP STRING_NEW: I=S S=S+1 REM fallthrough STRING_SET: S$(I)=B$ REM fallthrough STRING_DONE: S%(I)=S%(I)+1 L=I:GOSUB ALLOC RETURN REM REPLACE(R$, S1$, S2$) -> R$ REPLACE: T3$=R$ R$="" I=1 J=LEN(T3$) REPLACE_LOOP: IF I>J THEN RETURN C$=MID$(T3$,I,LEN(S1$)) IF C$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$) IF C$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1 GOTO REPLACE_LOOP REM sequence functions REM FORCE_SEQ_TYPE(A,T) -> R FORCE_SEQ_TYPE: REM if it's already the right type, inc ref cnt and return it IF (Z%(A)AND 31)=T THEN R=A:GOTO INC_REF_R REM if it's empty, return the empty sequence match T IF A<16 THEN R=(T-4)*3:GOTO INC_REF_R REM otherwise, copy first element to turn it into correct type B=Z%(A+2): REM value to copy L=Z%(A+1):M=B:GOSUB ALLOC: REM T already set IF Z%(A+1)=0 THEN RETURN RETURN REM MAP_LOOP_START(T): REM - setup stack for map loop MAP_LOOP_START: REM point to empty sequence to start off R=(T-4)*3: REM calculate location of empty seq GOSUB PUSH_R: REM push return ptr GOSUB PUSH_R: REM push empty ptr GOSUB PUSH_R: REM push current ptr GOTO INC_REF_R REM MAP_LOOP_UPDATE(C,M): REM MAP_LOOP_UPDATE(C,M,N): REM - called after M (and N if T=8) are set REM - C indicates whether to free M (and N if T=8) REM - update the structure of the return sequence MAP_LOOP_UPDATE: GOSUB PEEK_Q_1:L=Q: REM empty ptr GOSUB ALLOC: REM allocate new sequence element REM sequence took ownership AY=L:GOSUB RELEASE IF C THEN AY=M:GOSUB RELEASE IF C AND T=8 THEN AY=N:GOSUB RELEASE REM if not first element, set current next to point to new element GOSUB PEEK_Q IF Q>14 THEN Z%(Q+1)=R REM if first element, set return to new element IF Q<15 THEN Q=R:GOSUB PUT_Q_2 Q=R:GOSUB PUT_Q: REM update current ptr to new element RETURN REM MAP_LOOP_DONE() -> R REM - cleanup stack and set return value MAP_LOOP_DONE: GOSUB POP_Q: REM pop current ptr GOSUB POP_Q: REM pop empty ptr GOSUB POP_R: REM pop return ptr RETURN REM LIST_Q(A) -> R LIST_Q: R=0 GOSUB TYPE_A IF T=6 THEN R=1 RETURN REM EMPTY_Q(A) -> R EMPTY_Q: R=0 IF Z%(A+1)=0 THEN R=1 RETURN REM COUNT(A) -> R REM - returns length of list, not a Z% index COUNT: GOSUB PUSH_A R=-1 DO_COUNT_LOOP: R=R+1 IF Z%(A+1)<>0 THEN A=Z%(A+1):GOTO DO_COUNT_LOOP GOSUB POP_A RETURN REM LAST(A) -> R LAST: REM TODO check that actually a list/vector IF Z%(A+1)=0 THEN R=0:RETURN: REM empty seq, return nil W=0 LAST_LOOP: IF Z%(A+1)=0 THEN GOTO LAST_DONE: REM end, return previous value W=A: REM current becomes previous entry A=Z%(A+1): REM next entry GOTO LAST_LOOP LAST_DONE: R=Z%(W+2) GOTO INC_REF_R REM SLICE(A,B,C) -> R REM make copy of sequence A from index B to C REM returns R6 as reference to last element of slice before empty REM returns A as next element following slice (of original) SLICE: I=0 R=6: REM always a list GOSUB INC_REF_R R6=-1: REM last list element before empty W=R: REM temporary for return as R REM advance A to position B SLICE_FIND_B: IF I0 THEN A=Z%(A+1):I=I+1:GOTO SLICE_FIND_B SLICE_LOOP: REM if current position is C, then return IF C<>-1 AND I>=C THEN R=W:RETURN REM if we reached end of A, then return IF Z%(A+1)=0 THEN R=W:RETURN REM allocate new list element with copied value T=6:L=6:M=Z%(A+2):GOSUB ALLOC REM sequence took ownership AY=L:GOSUB RELEASE REM if not first element, set last to point to new element IF R6>-1 THEN Z%(R6+1)=R REM if first element, set return value to new element IF R6=-1 THEN W=R R6=R: REM update last list element REM advance to next element of A A=Z%(A+1) I=I+1 GOTO SLICE_LOOP REM LIST2(B,A) -> R LIST2: REM last element is 3 (empty list), second element is A T=6:L=6:M=A:GOSUB ALLOC REM first element is B T=6:L=R:M=B:GOSUB ALLOC AY=L:GOSUB RELEASE: REM new list takes ownership of previous RETURN REM LIST3(C,B,A) -> R LIST3: GOSUB LIST2 REM first element is C T=6:L=R:M=C:GOSUB ALLOC AY=L:GOSUB RELEASE: REM new list takes ownership of previous RETURN REM hashmap functions REM HASHMAP() -> R HASHMAP: REM just point to static empty hash-map R=12 GOTO INC_REF_R REM ASSOC1(H, K, C) -> R ASSOC1: REM create key/value entry T=8:L=H:M=K:N=C:GOSUB ALLOC AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap RETURN REM ASSOC1_S(H, B$, C) -> R ASSOC1_S: REM add the key string T=4:GOSUB STRING K=R:GOSUB ASSOC1 AY=K:GOSUB RELEASE: REM map took ownership of key RETURN REM HASHMAP_GET(H, B$) -> R REM - returns R3 with whether we found it or not HASHMAP_GET: R3=0: REM whether found or not (for HASHMAP_CONTAINS) R=0 HASHMAP_GET_LOOP: REM no matching key found IF Z%(H+1)=0 THEN R=0:RETURN REM get search string is equal to key string we found it IF B$=S$(Z%(Z%(H+2)+1)) THEN R3=1:R=Z%(H+3):RETURN REM skip to next key/value H=Z%(H+1) GOTO HASHMAP_GET_LOOP REM HASHMAP_CONTAINS(H, K) -> R HASHMAP_CONTAINS: GOSUB HASHMAP_GET R=R3 RETURN ================================================ FILE: impls/basic/variables.txt ================================================ Global Unique: Z% : boxed memory values Z1 : Z% size Z2 : S$ size Z3 : stack start address (cbm) or X% size (qbasic) Z4 : release stack start address (cbm) or Y% size (qbasic) ZI : start of unused memory (index into Z%) ZK : start of free list (index into Z%) ZT : top of memory after repl env allocations S$ : string memory storage S : next free index in S$ X% : logic/call stack (Z% indexes) X : top element of X% stack Y% : pending release stack [index into Z%, eval level] Y : top element of Y% stack D : root repl environment BT : begin time (TI) ER : error type (-2: none, -1: string, >=0: object) E$ : error string (ER=-1) EZ : READLINE EOF return, READ_FILE EOF temp LV : EVAL stack call level/depth RI : reader current string position RJ : READ_TOKEN current character index Calling arguments/temporaries: A : common call argument (especially EVAL, EVAL_AST) A$ : common call argument (READLINE, reader, string temp, key value) B : common call argument B$ : STRING arg for HASHMAP_GET, PR_STR_SEQ separator : INIT_CORE_SET_FUNCTION, ENV_SET_S, ASSOC1_S C : common call argument, DO_TCO_FUNCTION temp in DO_APPLY E : environment (EVAL, EVAL_AST) F : function H : hash map K : hash map key (Z% index) L : ALLOC* Z%(R,1) default M : ALLOC* Z%(R+1,0) default N : ALLOC* Z%(R+1,1) default R : common return value R$ : common string return value T : type arg, common temp Q : PUSH*, POP*, PEEK* return value (and PEEK_Q_Q call arg) AR : APPLY, DO_*_FUNCTION arg list AY : RELEASE/FREE arg AZ : PR_STR arg P1 : PR_MEMORY*, PR_OBJECT, CHECK_FREE_LIST start P2 : PR_MEMORY*, PR_OBJECT, CHECK_FREE_LIST end P3 : PR_OBJECT, PR_MEMORY_VALUE R1 : REP, RE - MAL_READ result temp R2 : REP, RE - EVAL result temp R3 : HASHMAP_GET, DO_HASH_MAP, DO_KEYS_VALS temp and return value R6 : SLICE return value (last element) SZ : size argument to ALLOC S1$ : REPLACE needle S2$ : REPLACE replacement Other temporaries: A0 : EVAL ast elements A1 : EVAL ast elements, DO_FUNCTION temp A2 : EVAL ast elements, DO_FUNCTION temp A3 : EVAL ast elements B1 : DO_FUNCTION temp CZ : DO_CONCAT stack position ED : EQUAL_Q recursion depth counter RD : PR_OBJECT recursion depth SD : READ_STR sequence read recursion depth C$ : READ_TOKEN, SKIP_SPACES, SKIP_TO_EOL current character D$ : READ_TOKEN/READ_FILE_CHAR temp G : function value ON GOTO switch flag, EVAL_AST changed flag I : STRING, REPLACE, SLICE, PR_MEMORY, PR_OBJECT, PR_MEMORY_VALUE J : REPLACE, PR_MEMORY_VALUE U : ALLOC, RELEASE, PR_STR temp V : RELEASE, PR_STR_SEQ temp W : SLICE, LAST, QUASIQUOTE, DO_HASH_MAP, DO_KEYS_VALS, step2-3 EVAL temp P : PR_MEMORY_SUMMARY_SMALL RC : RELEASE remaining number of elements to release RF : reader reading from file flag S1 : READ_TOKEN in a string? S2 : READ_TOKEN escaped? T$ : READ_* current token string T1 : EQUAL_Q, PR_STR, DO_KEYS_VALS temp T2 : EQUAL_Q, DO_KEY_VALS, HASH_MAP_GET T3$ : REPLACE temp Unused: O Counting number of times each variable is assigned: sed 's/:/\n /g' readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas stepA_mal.in.bas | grep "[A-Z][A-Z0-9]*[%$]*=" | sed 's/.*[^A-Z]\([A-Z][A-Z0-9]*[%$]*\)=.*/\1/g' | sort | uniq -c | sort -n ================================================ FILE: impls/bbc-basic/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install brandy ================================================ FILE: impls/bbc-basic/Makefile ================================================ all: .PHONY: clean clean: ================================================ FILE: impls/bbc-basic/README.md ================================================ # Introduction This is an implementation of mal in BBC BASIC V. While there is already an implementation of mal in BASIC (in the "basic" directory), it's targeted at much more primitive versions of BASIC and relies on a pre-processor, both of which make it fairly un-idiomatic as a BBC BASIC V program. BBC BASIC V is the version of BBC BASIC supplied with Acorn's ARM-based computers from the mid-1980s. It has substantial enhancements from the 6502-based versions of BBC BASIC, which were themselves at the advanced end of 8-bit BASICs. Mal uses many of the advanced features of BBC BASIC V and porting it to older versions would be difficult. Mal is intended to run on all versions of BBC BASIC V and BBC BASIC VI, as well as on Brandy 1.20.1. For compatibility with Brandy, it avoids operating system calls where possible. The only exception is that is has separate mechanisms for reading command-line arguments under Brandy and RISC OS. # Running under Unix On Unix systems, this mal implementation can run on the Brandy interpreter. The tests require the "simple text" build, but mal will work interactively in graphical builds as well. You can invoke mal like this: ``` cd bbc-basic brandy stepA_mal.bbc ``` # Running under RISC OS To run mal under RISC OS, you obviously need to get the files onto your RISC OS system, and you also need to arrange to tokenize the BASIC source files. There are scripts to do the latter in the `riscos` directory, but they do require that the mal source tree be available under RISC OS without its filenames' being truncated, which may restrict with filing systems can be used. The HostFS supplied with ArcEm works fine. Once you have the files in RISC OS, you can set things up by running: ``` *Dir bbc-basic.riscos *Run setup ``` Then you can invoke the interpreter directly: ``` *Run stepA_mal ``` At present, there's no filename translation in the `slurp` function, so many of the example mal programs will fail because they can't load `core.mal`. # Interesting features This appears to be the first mal implementation that uses an table-driven deterministic finite automoton (a state machine) to implement its tokenizer. The mal heap is represented as a large array of fixed-size objects. Lists and vectors are linked lists of these objects, while hash-maps are crit-bit trees. Mal exceptions are implemented as BBC BASIC errors. Errors generated by mal are numbered from &40E80900. ## Assigned error numbers No.| Description ---|------------ &00| Native mal error generated by 'throw' &1x| Object not of type 'x' &1F| Miscellaneous type mismatch &20| Invalid operation on empty list &21| Wrong number of arguments to function &22| Undefined symbol &23| Subscript out of range &24| Invalid 'catch*' clause &30| Unexpected end of input &31| Unexpected ')' &32| Hash-map key mush be a string &40| File not found &50| Out of memory &Fx| Internal errors (indicating a bug in mal) &F0| Unprintable value &F1| Call to non-existent core function ================================================ FILE: impls/bbc-basic/core.bas ================================================ REM > core function library for mal in BBC BASIC REM BBC BASIC doesn't have function pointers. There are essentially REM two ways to work around this. One is to use the BASIC EVAL function, REM constructing a string that will call an arbitrary function with the REM specified arguments. The other is to us a big CASE statement. REM Following the suggestion in Hints.md, this code takes the latter REM approach. DEF PROCcore_ns RESTORE +0 REM The actual DATA statements are embedded in the dispatch table below. ENDPROC REM Call a core function, taking the function number and a mal list of REM objects to pass as arguments. DEF FNcore_call(fn%, args%) LOCAL args%(), arg$ DIM args%(1) CASE fn% OF DATA +, 0 WHEN 0 PROCcore_prepare_args("ii", "+") =FNalloc_int(args%(0) + args%(1)) DATA -, 1 WHEN 1 PROCcore_prepare_args("ii", "-") =FNalloc_int(args%(0) - args%(1)) DATA *, 2 WHEN 2 PROCcore_prepare_args("ii", "*") =FNalloc_int(args%(0) * args%(1)) DATA /, 3 WHEN 3 PROCcore_prepare_args("ii", "/") =FNalloc_int(args%(0) DIV args%(1)) DATA list, 5 WHEN 5 =FNas_list(args%) DATA list?, 6 WHEN 6 PROCcore_prepare_args("?", "list?") =FNalloc_boolean(FNis_list(args%(0))) DATA empty?, 7 WHEN 7 PROCcore_prepare_args("l", "empty?") =FNalloc_boolean(FNis_empty(args%(0))) DATA count, 8 WHEN 8 PROCcore_prepare_args("C", "count") IF FNis_nil(args%(0)) THEN =FNalloc_int(0) =FNalloc_int(FNcount(args%(0))) DATA =, 9 WHEN 9 PROCcore_prepare_args("??", "=") =FNalloc_boolean(FNcore_equal(args%(0), args%(1))) DATA <, 10 WHEN 10 PROCcore_prepare_args("ii", "<") =FNalloc_boolean(args%(0) < args%(1)) DATA <=, 11 WHEN 11 PROCcore_prepare_args("ii", "<=") =FNalloc_boolean(args%(0) <= args%(1)) DATA >, 12 WHEN 12 PROCcore_prepare_args("ii", ">") =FNalloc_boolean(args%(0) > args%(1)) DATA >=, 13 WHEN 13 PROCcore_prepare_args("ii", ">=") =FNalloc_boolean(args%(0) >= args%(1)) DATA read-string, 14 WHEN 14 PROCcore_prepare_args("t", "read-string") =FNread_str(args%(0)) DATA slurp, 15 WHEN 15 PROCcore_prepare_args("s", "slurp") =FNcore_slurp(arg$) DATA eval, 16 WHEN 16 PROCcore_prepare_args("?", "eval") =FNEVAL(args%(0), repl_env%) DATA pr-str, 17 WHEN 17 =FNcore_print(TRUE, " ", args%) DATA str, 18 WHEN 18 =FNcore_print(FALSE, "", args%) DATA prn, 4 WHEN 4 PRINT FNunbox_string(FNcore_print(TRUE, " ", args%)) =FNnil DATA println, 19 WHEN 19 PRINT FNunbox_string(FNcore_print(FALSE, " ", args%)) =FNnil DATA atom, 20 WHEN 20 PROCcore_prepare_args("?", "atom") =FNalloc_atom(args%(0)) DATA atom?, 21 WHEN 21 PROCcore_prepare_args("?", "atom?") =FNalloc_boolean(FNis_atom(args%(0))) DATA deref, 22 WHEN 22 PROCcore_prepare_args("a", "deref") =FNatom_deref(args%(0)) DATA reset!, 23 WHEN 23 PROCcore_prepare_args("a?", "reset!") PROCatom_reset(args%(0), args%(1)) =args%(1) DATA swap!, 24 WHEN 24 PROCcore_prepare_args("af*", "swap!") PROCatom_reset(args%(0), FNcore_apply(args%(1), FNalloc_pair(FNatom_deref(args%(0)), args%))) =FNatom_deref(args%(0)) DATA cons, 25 WHEN 25 PROCcore_prepare_args("?l", "cons") =FNalloc_pair(args%(0), args%(1)) DATA concat, 26 WHEN 26 =FNcore_concat(args%) DATA nth, 27 WHEN 27 PROCcore_prepare_args("li", "nth") =FNnth(args%(0), args%(1)) DATA first, 28 WHEN 28 PROCcore_prepare_args("C", "first") IF FNis_nil(args%(0)) THEN =FNnil =FNfirst(args%(0)) DATA rest, 29 WHEN 29 PROCcore_prepare_args("C", "rest") IF FNis_nil(args%(0)) THEN =FNempty =FNas_list(FNrest(args%(0))) DATA throw, 30 WHEN 30 PROCcore_prepare_args("?", "throw") MAL_ERR% = args%(0) ERROR &40E80900, "Mal exception: " + FNunbox_string(FNpr_str(args%(0), FALSE)) DATA apply, 31 WHEN 31 PROCcore_prepare_args("f?*", "apply") =FNcore_apply(args%(0), FNcore_apply_args(FNalloc_pair(args%(1), args%))) DATA map, 32 WHEN 32 PROCcore_prepare_args("fl", "map") =FNcore_map(args%(0), args%(1)) DATA nil?, 33 WHEN 33 PROCcore_prepare_args("?", "nil?") =FNalloc_boolean(FNis_nil(args%(0))) DATA true?, 34 WHEN 34 PROCcore_prepare_args("?", "true?") IF NOT FNis_boolean(args%(0)) THEN =FNalloc_boolean(FALSE) =args%(0) DATA false?, 35 WHEN 35 PROCcore_prepare_args("?", "false?") IF NOT FNis_boolean(args%(0)) THEN =FNalloc_boolean(FALSE) =FNalloc_boolean(NOT FNunbox_boolean(args%(0))) DATA symbol?, 36 WHEN 36 PROCcore_prepare_args("?", "symbol?") =FNalloc_boolean(FNis_symbol(args%(0))) DATA symbol, 37 WHEN 37 PROCcore_prepare_args("s", "symbol") =FNalloc_symbol(arg$) DATA keyword, 38 WHEN 38 PROCcore_prepare_args("s", "keyword") IF LEFT$(arg$, 1) <> CHR$(127) THEN arg$ = CHR$(127) + arg$ =FNalloc_string(arg$) DATA keyword?, 39 WHEN 39 PROCcore_prepare_args("?", "keyword?") IF FNis_string(args%(0)) THEN =FNalloc_boolean(LEFT$(FNunbox_string(args%(0)), 1) = CHR$(127)) ENDIF =FNalloc_boolean(FALSE) DATA vector, 40 WHEN 40 =FNas_vector(args%) DATA vector?, 41 WHEN 41 PROCcore_prepare_args("?", "vector?") =FNalloc_boolean(FNis_vector(args%(0))) DATA sequential?, 42 WHEN 42 PROCcore_prepare_args("?", "sequential?") =FNalloc_boolean(FNis_seq(args%(0))) DATA hash-map, 43 WHEN 43 =FNcore_assoc(FNempty_hashmap, args%) DATA map?, 44 WHEN 44 PROCcore_prepare_args("?", "map?") =FNalloc_boolean(FNis_hashmap(args%(0))) DATA assoc, 45 WHEN 45 PROCcore_prepare_args("h*", "assoc") =FNcore_assoc(args%(0), args%) DATA dissoc, 46 WHEN 46 PROCcore_prepare_args("h*", "dissoc") WHILE NOT FNis_empty(args%) args%(0) = FNhashmap_remove(args%(0), FNunbox_string(FNfirst(args%))) args% = FNrest(args%) ENDWHILE =args%(0) DATA get, 47 WHEN 47 IF FNis_nil(FNfirst(args%)) THEN =FNnil PROCcore_prepare_args("hs", "get") =FNhashmap_get(args%(0), arg$) DATA contains?, 48 WHEN 48 PROCcore_prepare_args("hs", "contains?") =FNalloc_boolean(FNhashmap_contains(args%(0), arg$)) DATA keys, 49 WHEN 49 PROCcore_prepare_args("h", "keys") =FNhashmap_keys(args%(0)) DATA vals, 50 WHEN 50 PROCcore_prepare_args("h", "vals") =FNhashmap_vals(args%(0)) DATA readline, 51 WHEN 51 PROCcore_prepare_args("s", "readline") PRINT arg$; LINE INPUT "" arg$ =FNalloc_string(arg$) DATA meta, 52 WHEN 52 PROCcore_prepare_args("?", "meta") =FNmeta(args%(0)) DATA with-meta, 53 WHEN 53 PROCcore_prepare_args("??", "with-meta") =FNwith_meta(args%(0), args%(1)) DATA time-ms, 54 WHEN 54 PROCcore_prepare_args("", "time-ms") =FNalloc_int(TIME * 10) DATA conj, 55 WHEN 55 PROCcore_prepare_args("l*", "conj") IF FNis_list(args%(0)) THEN WHILE NOT FNis_empty(args%) args%(0) = FNalloc_pair(FNfirst(args%), args%(0)) args% = FNrest(args%) ENDWHILE =args%(0) ELSE : REM args%(0) is a vector =FNas_vector(FNcore_concat1(args%(0), args%)) ENDIF DATA string?, 56 WHEN 56 PROCcore_prepare_args("?", "string?") IF FNis_string(args%(0)) THEN =FNalloc_boolean(LEFT$(FNunbox_string(args%(0)), 1) <> CHR$(127)) ENDIF =FNalloc_boolean(FALSE) DATA number?, 57 WHEN 57 PROCcore_prepare_args("?", "number?") =FNalloc_boolean(FNis_int(args%(0))) DATA fn?, 58 WHEN 58 PROCcore_prepare_args("?", "fn?") =FNalloc_boolean(FNis_nonmacro_fn(args%(0)) OR FNis_corefn(args%(0))) DATA macro?, 59 WHEN 59 PROCcore_prepare_args("?", "macro?") =FNalloc_boolean(FNis_macro(args%(0))) DATA seq, 60 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" DEF PROCcore_prepare_args(spec$, fn$) REM Check that a core function is being provided with the correct REM number and type of arguments and unbox them as appropriate. REM spec$ is the argument specification as a string. Each character REM represents an argument: REM "i" - Must be an integer; unbox into args%() REM "s" - Must be a string; unbox into arg$ REM "t" - Must be a string; stuff into args%() REM "l" - Must be a sequence; stuff into args%() REM "f" - Must be a function; stuff into args%() REM "a" - Must be an atom; stuff into args%() REM "h" - Must be a hash-map; stuff into args%() REM "C" - Must be 'count'able stuff into args%() REM "?" - Any single argument stuff into args%() REM "*" - Any number of (trailing) arguments; leave in args% REM This function shares some local variables with FNcore_call. LOCAL i%, val% IF RIGHT$(spec$) = "*" THEN spec$ = LEFT$(spec$) IF FNcount(args%) < LEN(spec$) THEN ERROR &40E80921, "Core function '"+fn$+"' requires at least "+STR$(LEN(spec$))+" arguments" ENDIF ELSE IF FNcount(args%) <> LEN(spec$) THEN ERROR &40E80921, "Core function '"+fn$+"' requires "+STR$(LEN(spec$))+" arguments" ENDIF ENDIF FOR i% = 1 TO LEN(spec$) val% = FNfirst(args%) CASE MID$(spec$, i%, 1) OF WHEN "i" IF NOT FNis_int(val%) THEN ERROR &40E80911, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be an integer" ENDIF args%(i% - 1) = FNunbox_int(val%) WHEN "s" IF NOT FNis_string(val%) THEN ERROR &40E80914, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a string" ENDIF arg$ = FNunbox_string(val%) WHEN "t" IF NOT FNis_string(val%) THEN ERROR &40E80914, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a string" ENDIF args%(i% - 1) = val% WHEN "l" IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a sequence" ENDIF args%(i% - 1) = val% WHEN "f" IF NOT FNis_fn(val%) AND NOT FNis_corefn(val%) THEN ERROR &40E80919, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a function" ENDIF args%(i% - 1) = val% WHEN "a" IF NOT FNis_atom(val%) THEN ERROR &40E8091C, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be an atom" ENDIF args%(i% - 1) = val% WHEN "h" IF NOT FNis_hashmap(val%) THEN ERROR &40E8091D, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a hash-map" ENDIF args%(i% - 1) = val% WHEN "C" IF NOT FNis_seq(val%) AND NOT FNis_nil(val%) THEN ERROR &40E8091F, "Argument "+STR$(i%)+" to core function '"+fn$+"' must be a countable value" ENDIF args%(i% - 1) = val% WHEN "?" args%(i% - 1) = val% ENDCASE args% = FNrest(args%) NEXT i% ENDPROC REM Innards of the '=' function. DEF FNcore_equal(a%, b%) IF a% = b% THEN =TRUE IF FNis_int(a%) AND FNis_int(b%) THEN =FNunbox_int(a%) = FNunbox_int(b%) IF FNis_symbol(a%) AND FNis_symbol(b%) THEN =FNunbox_symbol(a%) = FNunbox_symbol(b%) ENDIF IF FNis_string(a%) AND FNis_string(b%) THEN =FNunbox_string(a%) = FNunbox_string(b%) ENDIF IF FNis_seq(a%) AND FNis_seq(b%) THEN IF FNis_empty(a%) AND FNis_empty(b%) THEN =TRUE IF FNis_empty(a%) <> FNis_empty(b%) THEN =FALSE IF NOT FNcore_equal(FNfirst(a%), FNfirst(b%)) THEN =FALSE =FNcore_equal(FNrest(a%), FNrest(b%)) ENDIF IF FNis_hashmap(a%) AND FNis_hashmap(b%) THEN REM Take advantage of the sorted keys in our hash-maps. IF FNcore_equal(FNhashmap_keys(a%), FNhashmap_keys(b%)) THEN IF FNcore_equal(FNhashmap_vals(a%), FNhashmap_vals(b%)) THEN =TRUE ENDIF ENDIF =FALSE REM Innards of the 'slurp' function. DEF FNcore_slurp(file$) LOCAL f%, out% f% = OPENIN(file$) IF f% = 0 THEN ERROR &40E80940, "File '"+file$+"' not found" out% = FNcore_slurp_channel(f%) CLOSE#f% =out% DEF FNcore_slurp_channel(f%) LOCAL this% IF EOF#f% THEN =FNalloc_string("") REM GET$# doesn't include a trailing newline. this% = FNalloc_string(GET$#f% + CHR$(10)) =FNstring_concat(this%, FNcore_slurp_channel(f%)) REM General-purpose printing function DEF FNcore_print(print_readably%, sep$, args%) LOCAL out% IF FNis_empty(args%) THEN =FNalloc_string("") out% = FNpr_str(FNfirst(args%), print_readably%) args% = FNrest(args%) WHILE NOT FNis_empty(args%) out% = FNstring_append(out%, sep$) out% = FNstring_concat(out%, FNpr_str(FNfirst(args%), print_readably%)) args% = FNrest(args%) ENDWHILE =out% REM Innards of the 'apply' function, also used by 'swap!' DEF FNcore_apply(fn%, args%) LOCAL ast%, env% IF FNis_corefn(fn%) THEN =FNcore_call(FNunbox_corefn(fn%), args%) IF FNis_fn(fn%) THEN ast% = FNfn_ast(fn%) env% = FNnew_env(FNfn_env(fn%), FNfn_params(fn%), args%) =FNEVAL(ast%, env%) ENDIF ERROR &40E80918, "Not a function" REM Innards of 'concat' function DEF FNcore_concat(args%) LOCAL tail% IF FNis_empty(args%) THEN =FNempty tail% = FNcore_concat(FNrest(args%)) =FNcore_concat1(FNfirst(args%), tail%) DEF FNcore_concat1(prefix%, tail%) IF FNis_empty(prefix%) THEN =tail% =FNalloc_pair(FNfirst(prefix%), FNcore_concat1(FNrest(prefix%), tail%)) REM Recursively assemble the argument list for 'apply' DEF FNcore_apply_args(args%) IF FNis_empty(FNrest(args%)) THEN =FNfirst(args%) =FNalloc_pair(FNfirst(args%), FNcore_apply_args(FNrest(args%))) REM Innards of the 'map' function DEF FNcore_map(fn%, args%) LOCAL car%, cdr% IF FNis_empty(args%) THEN =args% car% = FNcore_apply(fn%, FNalloc_pair(FNfirst(args%), FNempty)) cdr% = FNcore_map(fn%, FNrest(args%)) =FNalloc_pair(car%, cdr%) REM Innards of the 'hash-map' function DEF FNcore_assoc(map%, args%) LOCAL args%() DIM args%(1) WHILE NOT FNis_empty(args%) PROCcore_prepare_args("s?*", "hash-map") map% = FNhashmap_set(map%, arg$, args%(1)) ENDWHILE =map% REM Innards of the 'seq' function DEF FNcore_seq(val%) LOCAL s$, i% IF FNis_empty(val%) OR FNis_nil(val%) THEN =FNnil IF FNis_list(val%) THEN =val% IF FNis_vector(val%) THEN =FNas_list(val%) IF FNis_string(val%) THEN s$ = FNunbox_string(val%) IF s$ = "" THEN =FNnil val% = FNempty FOR i% = LEN(s$) TO 1 STEP -1 val% = FNalloc_pair(FNalloc_string(MID$(s$, i%, 1)), val%) NEXT i% =val% ENDIF ERROR &40E8091F, "Argument to 'seq' must be list, vector, string, or nil" REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/env.bas ================================================ REM > env library for mal in BBC BASIC DEF FNnew_env(outer%, binds%, exprs%) LOCAL env%, key$ env% = FNalloc_environment(outer%) WHILE NOT FNis_empty(binds%) key$ = FNunbox_symbol(FNfirst(binds%)) IF key$ = "&" THEN PROCenv_set(env%, FNunbox_symbol(FNnth(binds%, 1)), FNas_list(exprs%)) binds% = FNempty ELSE PROCenv_set(env%, key$, FNfirst(exprs%)) binds% = FNrest(binds%) : exprs% = FNrest(exprs%) ENDIF ENDWHILE =env% DEF PROCenv_set(env%, key$, val%) LOCAL data% data% = FNenvironment_data(env%) data% = FNhashmap_set(data%, key$, val%) PROCenvironment_set_data(env%, data%) ENDPROC DEF FNenv_find(env%, key$) WHILE NOT FNis_nil(env%) IF FNhashmap_contains(FNenvironment_data(env%), key$) THEN =env% env% = FNenvironment_outer(env%) ENDWHILE =FNnil DEF FNenv_get(env%, key$) env% = FNenv_find(env%, key$) IF FNis_nil(env%) THEN ERROR &40E80922, "'"+key$+"' not found" =FNhashmap_get(FNenvironment_data(env%), key$) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/printer.bas ================================================ REM > printer library for mal in BBC BASIC DEF FNpr_str(val%, print_readably%) LOCAL ret%, term$, val$, keys%, vals% IF FNis_nil(val%) THEN =FNalloc_string("nil") IF FNis_boolean(val%) THEN IF FNunbox_boolean(val%) THEN =FNalloc_string("true") =FNalloc_string("false") ENDIF IF FNis_int(val%) THEN =FNalloc_string(STR$(FNunbox_int(val%))) IF FNis_string(val%) THEN IF FNstring_chr(val%, 1) = CHR$(127) THEN =FNalloc_string(":" + MID$(FNunbox_string(val%), 2)) IF print_readably% THEN =FNalloc_string(FNformat_string(FNunbox_string(val%))) ELSE =val% ENDIF IF FNis_symbol(val%) THEN =FNalloc_string(FNunbox_symbol(val%)) IF FNis_corefn(val%) OR FNis_fn(val%) THEN =FNalloc_string("#") IF FNis_seq(val%) THEN IF FNis_vector(val%) THEN ret% = FNalloc_string("[") : term$ = "]" ELSE ret% = FNalloc_string("(") : term$ = ")" ENDIF WHILE NOT FNis_empty(val%) IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ") ret% = FNstring_concat(ret%, FNpr_str(FNfirst(val%), print_readably%)) val% = FNrest(val%) ENDWHILE =FNstring_append(ret%, term$) ENDIF IF FNis_hashmap(val%) THEN ret% = FNalloc_string("{") keys% = FNhashmap_keys(val%) vals% = FNhashmap_vals(val%) WHILE NOT FNis_empty(keys%) IF FNstring_len(ret%) > 1 THEN ret% = FNstring_append(ret%, " ") ret% = FNstring_concat(ret%, FNpr_str(FNfirst(keys%), print_readably%)) ret% = FNstring_append(ret%, " ") ret% = FNstring_concat(ret%, FNpr_str(FNfirst(vals%), print_readably%)) keys% = FNrest(keys%) vals% = FNrest(vals%) ENDWHILE =FNstring_append(ret%, "}") ENDIF IF FNis_atom(val%) THEN ret% = FNalloc_string("(atom ") ret% = FNstring_concat(ret%, FNpr_str(FNatom_deref(val%), print_readably%)) =FNstring_append(ret%, ")") ENDIF ERROR &40E809F0, "Unprintable value" DEF FNformat_string(strval$) LOCAL ptr%, c$, out$ IF strval$ = "" THEN ="""""" FOR ptr% = 1 TO LEN(strval$) c$ = MID$(strval$, ptr%, 1) CASE c$ OF WHEN "\", """": out$ += "\" + c$ WHEN CHR$(10): out$ += "\n" OTHERWISE: out$ += c$ ENDCASE NEXT ptr% ="""" + out$ + """" REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/reader.bas ================================================ REM > reader library for mal in BBC BASIC REM ** Reader ** REM The Reader object is implemented as an array and a mutable pointer. DEF FNreader_peek(tokens$(), RETURN tokptr%) =tokens$(tokptr%) DEF FNreader_next(token$(), RETURN tokptr%) tokptr% += 1 =tokens$(tokptr% - 1) DEF FNread_str(src%) LOCAL ntokens%, tokptr%, tokens$() DIM tokens$(2048) ntokens% = FNtokenize(src%, tokens$()) tokptr% = 0 =FNread_form(tokens$(), tokptr%) REM ** Tokenizer ** DEF FNtokenize(src%, tokens$()) REM The tokenizer is implemented explicitly as a deterministic REM finite automaton. LOCAL p%, state%, tok$, tokptr%, c$, rc$, match$, action% LOCAL DATA state% = 1 tokptr% = 0 tok$ = "" FOR p% = 1 TO FNstring_len(src%) c$ = FNstring_chr(src%, p%) rc$ = c$ REM Convert some characters to ones that are easier to put into REM DATA statements. These substitutions are only used for REM matching: the token still contains the original character. CASE ASC(c$) OF REM Fold some upper-case letters together so that we can re-use REM them to represent more awkward characters. WHEN 78, 81: c$ = "A" REM Now convert newlines into "N" WHEN 10: c$ = "N" REM These are the other characters that Perl's "\s" escape matches. WHEN 9, 11, 12, 13: c$ = " " REM Brandy has a bug whereby it doesn't correctly parse strings REM in DATA statements that begin with quotation marks, so convert REM quotation marks to "Q". WHEN 34: c$ = "Q" ENDCASE REM The state table consists of a DATA statement for each current REM state, which triples representing transitions. Each triple REM consists of a string of characters to match, an action, and a REM next state. A matching string of "" matches any character, REM and hence marks the end of a state. REM Actions are: REM 0: Add this character to the current token REM 1: Emit token; start a new token with this character REM 5: Emit token; skip this character RESTORE +state% REM state 1: Initial state, or inside a bare word DATA " N,",5,1, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",0,1 REM state 3: Just seen the end of a token DATA " N,",5,1, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",1,1 REM state 5: Just seen a "~" DATA " N,",5,1, "@",0,3, "~",1,5, "[]{}()'`^@",1,3, Q,1,7, ";",5,11, "",1,1 REM state 7: Inside a quoted string DATA "\",0,9, Q,0,3, "",0,7 REM state 9: After a backslash in a string DATA "",0,7 REM state 11: Inside a comment DATA N,5,3, "",5,11 REM Find a matching transition from the current state. REM PRINT ;state%;"-->"; REPEAT READ match$, action%, state% REM PRINT "[";match$;"](";action%;",";state%;")"; UNTIL match$ = "" OR INSTR(match$, c$) > 0 REM PRINT ;"-->";state% REM Execute any actions. IF action% AND 1 AND tokens$(tokptr%) <> "" THEN tokptr% += 1 IF (action% AND 4) = 0 THEN tokens$(tokptr%) += rc$ NEXT p% IF tokens$(tokptr%) <> "" THEN tokptr% += 1 =tokptr% REM ** More Reader ** DEF FNread_form(tokens$(), RETURN tokptr%) LOCAL tok$, x% tok$ = FNreader_peek(tokens$(), tokptr%) CASE tok$ OF WHEN "" : ERROR &40E80930, "Unexpected end of input" WHEN "(": =FNread_list(tokens$(), tokptr%) WHEN "[": =FNread_vector(tokens$(), tokptr%) WHEN "{": =FNread_hashmap(tokens$(), tokptr%) WHEN ")", "]", "}": ERROR &40E80931, "Unexpected '"+tok$ +"'" WHEN "'": =FNreader_macro("quote", tokens$(), tokptr%) WHEN "`": =FNreader_macro("quasiquote", tokens$(), tokptr%) WHEN "~": =FNreader_macro("unquote", tokens$(), tokptr%) WHEN "~@":=FNreader_macro("splice-unquote", tokens$(), tokptr%) WHEN "@": =FNreader_macro("deref", tokens$(), tokptr%) WHEN "^": =FNread_with_meta(tokens$(), tokptr%) ENDCASE =FNread_atom(tokens$(), tokptr%) DEF FNread_list(tokens$(), RETURN tokptr%) LOCAL tok$ tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "(" =FNread_list_tail(tokens$(), tokptr%, ")") DEF FNread_vector(tokens$(), RETURN tokptr%) LOCAL tok$ tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "[" =FNas_vector(FNread_list_tail(tokens$(), tokptr%, "]")) DEF FNread_list_tail(tokens$(), RETURN tokptr%, term$) LOCAL tok$, car%, cdr% IF FNreader_peek(tokens$(), tokptr%) = term$ THEN tok$ = FNreader_next(tokens$(), tokptr%) =FNempty ENDIF car% = FNread_form(tokens$(), tokptr%) cdr% = FNread_list_tail(tokens$(), tokptr%, term$) =FNalloc_pair(car%, cdr%) DEF FNread_hashmap(tokens$(), RETURN tokptr%) LOCAL tok$, map%, key%, val% tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "{" map% = FNempty_hashmap WHILE FNreader_peek(tokens$(), tokptr%) <> "}" key% = FNread_form(tokens$(), tokptr%) IF NOT FNis_string(key%) ERROR &40E80932, "Hash-map key must be a string" val% = FNread_form(tokens$(), tokptr%) map% = FNhashmap_set(map%, FNunbox_string(key%), val%) ENDWHILE tok$ = FNreader_next(tokens$(), tokptr%) : REM skip over "}" =map% DEF FNreader_macro(quote$, token$(), RETURN tokptr%) LOCAL tok$ tok$ = FNreader_next(tokens$(), tokptr%) : REM skip quoting token =FNalloc_list2(FNalloc_symbol(quote$), FNread_form(tokens$(), tokptr%)) DEF FNread_with_meta(token$(), RETURN tokptr%) LOCAL tok$, wm%, base%, meta% tok$ = FNreader_next(tokens$(), tokptr%) : REM skip '^' token wm% = FNalloc_symbol("with-meta") meta% = FNread_form(tokens$(), tokptr%) base% = FNread_form(tokens$(), tokptr%) =FNalloc_list3(wm%, base%, meta%) DEF FNis_token_numeric(tok$) LOCAL i%, c% IF LEFT$(tok$, 1) = "-" THEN tok$ = MID$(tok$, 2) IF LEN(tok$) = 0 THEN =FALSE FOR i% = 1 TO LEN(tok$) c% = ASC(MID$(tok$, i%, 1)) IF c% < &30 OR c% > &39 THEN =FALSE NEXT i% =TRUE DEF FNread_atom(tokens$(), RETURN tokptr%) LOCAL strval$ strval$ = FNreader_next(tokens$(), tokptr%) IF strval$ = "nil" THEN =FNnil IF strval$ = "true" THEN =FNalloc_boolean(TRUE) IF strval$ = "false" THEN =FNalloc_boolean(FALSE) IF LEFT$(strval$, 1) = """" THEN =FNalloc_string(FNunquote_string(strval$)) IF LEFT$(strval$, 1) = ":" THEN =FNalloc_string(CHR$(127) + MID$(strval$, 2)) IF FNis_token_numeric(strval$) THEN =FNalloc_int(VAL(strval$)) =FNalloc_symbol(strval$) DEF FNunquote_string(strval$) LOCAL inptr%, bs%, out$, c$ IF RIGHT$(strval$, 1) <> """" THEN ERROR &40E80930, "Unexpected end of input" inptr% = 2 REPEAT bs% = INSTR(strval$, "\", inptr%) IF bs% > 0 THEN out$ += MID$(strval$, inptr%, bs% - inptr%) c$ = MID$(strval$, bs% + 1, 1) IF c$ = "n" THEN c$ = CHR$(10) out$ += c$ inptr% = bs% + 2 ENDIF UNTIL bs% = 0 IF inptr% = LEN(strval$) + 1 THEN ERROR &40E80930, "Unexpected end of input" out$ += MID$(strval$, inptr%, LEN(strval$) - inptr%) =out$ REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/riscos/.gitignore ================================================ *,ffb ================================================ FILE: impls/bbc-basic/riscos/setup,feb ================================================ | This Obey file sets up the environment for running mal on RISC OS. BASIC { < tokenize } ================================================ FILE: impls/bbc-basic/riscos/tokenize,ffe ================================================ REM Tokenizing libraries... TEXTLOAD "^.core/bas" SAVE "core" TEXTLOAD "^.env/bas" SAVE "env" TEXTLOAD "^.printer/bas" SAVE "printer" TEXTLOAD "^.reader/bas" SAVE "reader" TEXTLOAD "^.types/bas" SAVE "types" REM Tokenizing steps... TEXTLOAD "^.step0_repl/bas" SAVE "step0_repl" TEXTLOAD "^.step1_read_print/bas" SAVE "step1_read_print" TEXTLOAD "^.step2_eval/bas" SAVE "step2_eval" TEXTLOAD "^.step3_env/bas" SAVE "step3_env" TEXTLOAD "^.step4_if_fn_do/bas" SAVE "step4_if_fn_do" TEXTLOAD "^.step5_tco/bas" SAVE "step5_tco" TEXTLOAD "^.step6_file/bas" SAVE "step6_file" TEXTLOAD "^.step7_quote/bas" SAVE "step7_quote" TEXTLOAD "^.step8_macros/bas" SAVE "step8_macros" TEXTLOAD "^.step9_try/bas" SAVE "step9_try" TEXTLOAD "^.stepA_mal/bas" SAVE "stepA_mal" REM All done. QUIT ================================================ FILE: impls/bbc-basic/run ================================================ #!/usr/bin/env bash exec "${BRANDY:-sbrandy}" -size 1024k \ -path ../bbc-basic -quit $(dirname $0)/${STEP:-stepA_mal}.bas "${@}" ================================================ FILE: impls/bbc-basic/step0_repl.bas ================================================ REM Step 0 of mal in BBC BASIC REPEAT PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =a$ DEF FNEVAL(a$) =a$ DEF FNPRINT(a$) =a$ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$))) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step1_read_print.bas ================================================ REM Step 1 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" PROCtypes_init sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(a%) =a% DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$))) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step2_eval.bas ================================================ REM Step 2 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" PROCtypes_init REM These correspond with the CASE statement in FNcore_call repl_env% = FNempty_hashmap repl_env% = FNhashmap_set(repl_env%, "+", FNalloc_corefn(0)) repl_env% = FNhashmap_set(repl_env%, "-", FNalloc_corefn(1)) repl_env% = FNhashmap_set(repl_env%, "*", FNalloc_corefn(2)) repl_env% = FNhashmap_set(repl_env%, "/", FNalloc_corefn(3)) sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) LOCAL car%, val%, key$ REM PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) IF FNis_symbol(ast%) THEN val% = FNhashmap_get(env%, FNunbox_symbol(ast%)) IF val% = FNnil THEN ERROR &40E80922, "Symbol not in environment" =val% ENDIF IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNEVAL(FNfirst(ast%), env%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, FNeval_ast(FNrest(ast%), env%)) =FNcore_call(FNunbox_corefn(car%), FNeval_ast(FNrest(ast%), env%)) DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Call a core function, taking the function number and a mal list of REM objects to pass as arguments. DEF FNcore_call(fn%, args%) LOCAL x%, y%, z% x% = FNunbox_int(FNfirst(args%)) y% = FNunbox_int(FNfirst(FNrest(args%))) CASE fn% OF WHEN 0 : z% = x% + y% WHEN 1 : z% = x% - y% WHEN 2 : z% = x% * y% WHEN 3 : z% = x% DIV y% OTHERWISE : ERROR &40E809F1, "Call to non-existent core function" ENDCASE =FNalloc_int(z%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step3_env.bas ================================================ REM Step 3 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" PROCtypes_init REM These correspond with the CASE statement in FNcore_call repl_env% = FNalloc_environment(FNnil) PROCenv_set(repl_env%, "+", FNalloc_corefn(0)) PROCenv_set(repl_env%, "-", FNalloc_corefn(1)) PROCenv_set(repl_env%, "*", FNalloc_corefn(2)) PROCenv_set(repl_env%, "/", FNalloc_corefn(3)) sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) LOCAL car%, val%, bindings%, key$ val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE =FNEVAL(FNnth(ast%, 2), env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNeval_ast(FNrest(ast%), env%) =FNcore_call(FNunbox_corefn(car%), ast%) DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Call a core function, taking the function number and a mal list of REM objects to pass as arguments. DEF FNcore_call(fn%, args%) LOCAL x%, y%, z% x% = FNunbox_int(FNfirst(args%)) y% = FNunbox_int(FNfirst(FNrest(args%))) CASE fn% OF WHEN 0 : z% = x% + y% WHEN 1 : z% = x% - y% WHEN 2 : z% = x% * y% WHEN 3 : z% = x% DIV y% OTHERWISE : ERROR &40E809F1, "Call to non-existent core function" ENDCASE =FNalloc_int(z%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step4_if_fn_do.bas ================================================ REM Step 4 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" val$ = FNrep("(def! not (fn* (a) (if a false true)))") sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) PROCgc PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE =FNEVAL(FNnth(ast%, 2), env%) WHEN "do" WHILE TRUE ast% = FNrest(ast%) IF FNis_empty(ast%) THEN = val% val% = FNEVAL(FNfirst(ast%), env%) ENDWHILE WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN =FNEVAL(FNnth(ast%, 2), env%) IF FNcount(ast%) = 3 THEN =FNnil =FNEVAL(FNnth(ast%, 3), env%) WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNeval_ast(FNrest(ast%), env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) =FNEVAL(FNfn_ast(car%), env%) ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step5_tco.bas ================================================ REM Step 5 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" val$ = FNrep("(def! not (fn* (a) (if a false true)))") sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNeval_ast(FNrest(ast%), env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step6_file.bas ================================================ REM Step 6 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" REM Initial forms to evaluate RESTORE +0 DATA (def! not (fn* (a) (if a false true))) DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) DATA "" REPEAT READ form$ IF form$ <> "" THEN val$ = FNrep(form$) UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNeval_ast(FNrest(ast%), env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter LOCAL argv%, rargv%, cmdptr%, arg$, len% argv% = FNempty IF !PAGE = &D7C1C7C5 THEN REM Running under Brandy, so ARGC and ARGV$ are usable. IF ARGC >= 1 THEN FOR i% = ARGC TO 1 STEP -1 argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) NEXT i% ENDIF ELSE IF (INKEY(-256) AND &F0) = &A0 THEN rargv% = FNempty REM Running under RISC OS REM Vexingly, we can only get the command line that was passed to REM the BASIC interpreter. This means that we need to extract REM the arguments from that. Typically, we will have been started REM with "BASIC -quit ". DIM q% 256 SYS "OS_GetEnv" TO cmdptr% WHILE ?cmdptr% >= 32 SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% q%?len% = 13 rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) ENDWHILE REM Put argv back into the right order. WHILE NOT FNis_empty(rargv%) argv% = FNalloc_pair(FNfirst(rargv%), argv%) rargv% = FNrest(rargv%) ENDWHILE IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "BASIC" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "-quit" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip filename ENDIF ENDIF =FNgc_exit(argv%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step7_quote.bas ================================================ REM Step 7 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" REM Initial forms to evaluate RESTORE +0 DATA (def! not (fn* (a) (if a false true))) DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) DATA "" REPEAT READ form$ IF form$ <> "" THEN val$ = FNrep(form$) UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) 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%) 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_symbol(ast%) OR FNis_hashmap(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF =ast% DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) GOTO 31416 OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNeval_ast(FNrest(ast%), env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter LOCAL argv%, rargv%, cmdptr%, arg$, len% argv% = FNempty IF !PAGE = &D7C1C7C5 THEN REM Running under Brandy, so ARGC and ARGV$ are usable. IF ARGC >= 1 THEN FOR i% = ARGC TO 1 STEP -1 argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) NEXT i% ENDIF ELSE IF (INKEY(-256) AND &F0) = &A0 THEN rargv% = FNempty REM Running under RISC OS REM Vexingly, we can only get the command line that was passed to REM the BASIC interpreter. This means that we need to extract REM the arguments from that. Typically, we will have been started REM with "BASIC -quit ". DIM q% 256 SYS "OS_GetEnv" TO cmdptr% WHILE ?cmdptr% >= 32 SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% q%?len% = 13 rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) ENDWHILE REM Put argv back into the right order. WHILE NOT FNis_empty(rargv%) argv% = FNalloc_pair(FNfirst(rargv%), argv%) rargv% = FNrest(rargv%) ENDWHILE IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "BASIC" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "-quit" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip filename ENDIF ENDIF =FNgc_exit(argv%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step8_macros.bas ================================================ REM Step 8 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" REM Initial forms to evaluate RESTORE +0 DATA (def! not (fn* (a) (if a false true))) DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) DATA (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))))))) DATA "" REPEAT READ form$ IF form$ <> "" THEN val$ = FNrep(form$) UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) 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%) 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_symbol(ast%) OR FNis_hashmap(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF =ast% DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "defmacro!" val% = FNEVAL(FNnth(ast%, 2), env%) IF FNis_fn(val%) THEN val% = FNas_macro(val%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) GOTO 31416 OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNrest(ast%) IF FNis_macro(car%) THEN ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) GOTO 31416 ENDIF ast% = FNeval_ast(ast%, env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter LOCAL argv%, rargv%, cmdptr%, arg$, len% argv% = FNempty IF !PAGE = &D7C1C7C5 THEN REM Running under Brandy, so ARGC and ARGV$ are usable. IF ARGC >= 1 THEN FOR i% = ARGC TO 1 STEP -1 argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) NEXT i% ENDIF ELSE IF (INKEY(-256) AND &F0) = &A0 THEN rargv% = FNempty REM Running under RISC OS REM Vexingly, we can only get the command line that was passed to REM the BASIC interpreter. This means that we need to extract REM the arguments from that. Typically, we will have been started REM with "BASIC -quit ". DIM q% 256 SYS "OS_GetEnv" TO cmdptr% WHILE ?cmdptr% >= 32 SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% q%?len% = 13 rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) ENDWHILE REM Put argv back into the right order. WHILE NOT FNis_empty(rargv%) argv% = FNalloc_pair(FNfirst(rargv%), argv%) rargv% = FNrest(rargv%) ENDWHILE IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "BASIC" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "-quit" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip filename ENDIF ENDIF =FNgc_exit(argv%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/step9_try.bas ================================================ REM Step 9 of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" REM Initial forms to evaluate RESTORE +0 DATA (def! not (fn* (a) (if a false true))) DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) DATA (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))))))) DATA "" REPEAT READ form$ IF form$ <> "" THEN val$ = FNrep(form$) UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) 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%) 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_symbol(ast%) OR FNis_hashmap(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF =ast% DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. IF FNcount(ast%) < 3 THEN =FNEVAL(FNnth(ast%, 1), env%) IF FNunbox_symbol(FNfirst(FNnth(ast%, 2))) <> "catch*" THEN ERROR &40E80924, "Invalid 'catch*' clause" ENDIF ret% = FNtry(FNnth(ast%, 1), env%, is_error%) IF is_error% THEN =FNcatch(FNnth(ast%, 2), env%, ret%) =ret% REM Evaluate an expression, returning either the result or an exception REM raised during evaluation. is_error% indicates which it was. DEF FNtry(ast%, env%, RETURN is_error%) LOCAL trysav% trysav% = FNgc_save is_error% = FALSE LOCAL ERROR ON ERROR LOCAL is_error% = TRUE : =FNgc_restore(trysav%, FNwrap_exception) =FNgc_restore(trysav%, FNEVAL(ast%, env%)) REM Return a mal value corresponding to the most-recently thrown exception. DEF FNwrap_exception REM There are three cases to handle. When the error was generated REM by 'throw', we should return the value that 'throw' stashed in REM MAL_ERR%. When the error was generated by mal, we should just REM return the error message. When the error was generated by BASIC REM or the OS, we should wrap the message and the error number in REM a hash-map. IF ERR = &40E80900 THEN =MAL_ERR% : REM Error generated by 'throw' IF (ERR AND &FFFFFF00) = &40E80900 THEN =FNalloc_string(REPORT$) LOCAL e% e% = FNhashmap_set(FNempty_hashmap, "err", FNalloc_int(ERR)) =FNhashmap_set(e%, "message", FNalloc_string(REPORT$)) DEF FNcatch(ast%, env%, err%) LOCAL binds%, exprs% binds% = FNalloc_pair(FNnth(ast%, 1), FNempty) exprs% = FNalloc_pair(err%, FNempty) env% = FNnew_env(env%, binds%, exprs%) =FNEVAL(FNnth(ast%, 2), env%) DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "defmacro!" val% = FNEVAL(FNnth(ast%, 2), env%) IF FNis_fn(val%) THEN val% = FNas_macro(val%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) GOTO 31416 WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNrest(ast%) IF FNis_macro(car%) THEN ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) GOTO 31416 ENDIF ast% = FNeval_ast(ast%, env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter LOCAL argv%, rargv%, cmdptr%, arg$, len% argv% = FNempty IF !PAGE = &D7C1C7C5 THEN REM Running under Brandy, so ARGC and ARGV$ are usable. IF ARGC >= 1 THEN FOR i% = ARGC TO 1 STEP -1 argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) NEXT i% ENDIF ELSE IF (INKEY(-256) AND &F0) = &A0 THEN rargv% = FNempty REM Running under RISC OS REM Vexingly, we can only get the command line that was passed to REM the BASIC interpreter. This means that we need to extract REM the arguments from that. Typically, we will have been started REM with "BASIC -quit ". DIM q% 256 SYS "OS_GetEnv" TO cmdptr% WHILE ?cmdptr% >= 32 SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% q%?len% = 13 rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) ENDWHILE REM Put argv back into the right order. WHILE NOT FNis_empty(rargv%) argv% = FNalloc_pair(FNfirst(rargv%), argv%) rargv% = FNrest(rargv%) ENDWHILE IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "BASIC" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "-quit" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip filename ENDIF ENDIF =FNgc_exit(argv%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/stepA_mal.bas ================================================ REM Step A of mal in BBC BASIC LIBRARY "types" LIBRARY "reader" LIBRARY "printer" LIBRARY "env" LIBRARY "core" PROCtypes_init repl_env% = FNalloc_environment(FNnil) PROCcore_ns : REM This sets the data pointer REPEAT READ sym$, i% IF sym$ <> "" THEN PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%)) ENDIF UNTIL sym$ = "" REM Initial forms to evaluate RESTORE +0 DATA (def! not (fn* (a) (if a false true))) DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) DATA (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))))))) DATA (def! *host-language* "BBC BASIC V") DATA "" REPEAT READ form$ IF form$ <> "" THEN val$ = FNrep(form$) UNTIL form$ = "" argv% = FNget_argv IF FNis_empty(argv%) THEN PROCenv_set(repl_env%, "*ARGV*", FNempty) ELSE PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%)) val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")") END ENDIF val$ = FNrep("(println (str ""Mal ["" *host-language* ""]""))") sav% = FNgc_save REPEAT REM Catch all errors apart from "Escape". ON ERROR LOCAL IF ERR = 17 ON ERROR OFF: ERROR ERR, REPORT$ ELSE PRINT REPORT$ PROCgc_restore(sav%) sav% = FNgc_save PRINT "user> "; LINE INPUT "" line$ PRINT FNrep(line$) UNTIL FALSE END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) 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%) 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_symbol(ast%) OR FNis_hashmap(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF =ast% DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. IF FNcount(ast%) < 3 THEN =FNEVAL(FNnth(ast%, 1), env%) IF FNunbox_symbol(FNfirst(FNnth(ast%, 2))) <> "catch*" THEN ERROR &40E80924, "Invalid 'catch*' clause" ENDIF ret% = FNtry(FNnth(ast%, 1), env%, is_error%) IF is_error% THEN =FNcatch(FNnth(ast%, 2), env%, ret%) =ret% REM Evaluate an expression, returning either the result or an exception REM raised during evaluation. is_error% indicates which it was. DEF FNtry(ast%, env%, RETURN is_error%) LOCAL trysav% trysav% = FNgc_save is_error% = FALSE LOCAL ERROR ON ERROR LOCAL is_error% = TRUE : =FNgc_restore(trysav%, FNwrap_exception) =FNgc_restore(trysav%, FNEVAL(ast%, env%)) REM Return a mal value corresponding to the most-recently thrown exception. DEF FNwrap_exception REM There are three cases to handle. When the error was generated REM by 'throw', we should return the value that 'throw' stashed in REM MAL_ERR%. When the error was generated by mal, we should just REM return the error message. When the error was generated by BASIC REM or the OS, we should wrap the message and the error number in REM a hash-map. IF ERR = &40E80900 THEN =MAL_ERR% : REM Error generated by 'throw' IF (ERR AND &FFFFFF00) = &40E80900 THEN =FNalloc_string(REPORT$) LOCAL e% e% = FNhashmap_set(FNempty_hashmap, "err", FNalloc_int(ERR)) =FNhashmap_set(e%, "message", FNalloc_string(REPORT$)) DEF FNcatch(ast%, env%, err%) LOCAL binds%, exprs% binds% = FNalloc_pair(FNnth(ast%, 1), FNempty) exprs% = FNalloc_pair(err%, FNempty) env% = FNnew_env(env%, binds%, exprs%) =FNEVAL(FNnth(ast%, 2), env%) DEF FNEVAL(ast%, env%) PROCgc_enter =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) LOCAL car%, val%, bindings%, key$ 31416 REM tail call optimization loop PROCgc_keep_only2(ast%, env%) val% = FNenv_find(env%, "DEBUG-EVAL") IF NOT FNis_nil(val%) THEN IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE)) ENDIF ENDIF IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(ast%)) IF FNis_hashmap(ast%) THEN val% = FNempty_hashmap bindings% = FNhashmap_keys(ast%) WHILE NOT FNis_empty(bindings%) key$ = FNunbox_string(FNfirst(bindings%)) val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) bindings% = FNrest(bindings%) ENDWHILE =val% ENDIF IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% car% = FNfirst(ast%) IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) IF FNis_symbol(car%) THEN key$ = FNunbox_symbol(car%) CASE key$ OF REM Special forms WHEN "def!" val% = FNEVAL(FNnth(ast%, 2), env%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "defmacro!" val% = FNEVAL(FNnth(ast%, 2), env%) IF FNis_fn(val%) THEN val% = FNas_macro(val%) PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%) =val% WHEN "let*" env% = FNalloc_environment(env%) bindings% = FNnth(ast%, 1) WHILE NOT FNis_empty(bindings%) PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%)) bindings% = FNrest(FNrest(bindings%)) ENDWHILE ast% = FNnth(ast%, 2) GOTO 31416 WHEN "do" REM The guide has us call FNeval_ast on the sub-list that excludes REM the last element of ast%, but that's a bit painful without REM native list slicing, so it's easier to just re-implement the REM bit of FNeval_ast that we need. ast% = FNrest(ast%) WHILE NOT FNis_empty(FNrest(ast%)) val% = FNEVAL(FNfirst(ast%), env%) ast% = FNrest(ast%) ENDWHILE ast% = FNfirst(ast%) GOTO 31416 WHEN "if" IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN ast% = FNnth(ast%, 2) ELSE IF FNcount(ast%) = 3 THEN =FNnil ast% = FNnth(ast%, 3) ENDIF GOTO 31416 WHEN "fn*" =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) GOTO 31416 WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE car% = FNenv_get(env%, key$) ENDCASE ELSE car% = FNEVAL(car%, env%) ENDIF REM This is the "apply" part. ast% = FNrest(ast%) IF FNis_macro(car%) THEN ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) GOTO 31416 ENDIF ast% = FNeval_ast(ast%, env%) IF FNis_corefn(car%) THEN =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) GOTO 31416 ENDIF ERROR &40E80918, "Not a function" DEF FNPRINT(a%) =FNunbox_string(FNpr_str(a%, TRUE)) DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) IF FNis_empty(ast%) THEN =ast% =FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%)) DEF FNget_argv PROCgc_enter LOCAL argv%, rargv%, cmdptr%, arg$, len% argv% = FNempty IF !PAGE = &D7C1C7C5 THEN REM Running under Brandy, so ARGC and ARGV$ are usable. IF ARGC >= 1 THEN FOR i% = ARGC TO 1 STEP -1 argv% = FNalloc_pair(FNalloc_string(ARGV$(i%)), argv%) NEXT i% ENDIF ELSE IF (INKEY(-256) AND &F0) = &A0 THEN rargv% = FNempty REM Running under RISC OS REM Vexingly, we can only get the command line that was passed to REM the BASIC interpreter. This means that we need to extract REM the arguments from that. Typically, we will have been started REM with "BASIC -quit ". DIM q% 256 SYS "OS_GetEnv" TO cmdptr% WHILE ?cmdptr% >= 32 SYS "OS_GSTrans", cmdptr%, q%, &20000000 + 256 TO cmdptr%, , len% q%?len% = 13 rargv% = FNalloc_pair(FNalloc_string($q%), rargv%) ENDWHILE REM Put argv back into the right order. WHILE NOT FNis_empty(rargv%) argv% = FNalloc_pair(FNfirst(rargv%), argv%) rargv% = FNrest(rargv%) ENDWHILE IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "BASIC" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) IF FNunbox_string(FNfirst(argv%)) <> "-quit" THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip "-quit" IF FNis_empty(argv%) THEN =FNgc_exit(argv%) argv% = FNrest(argv%) : REM skip filename ENDIF ENDIF =FNgc_exit(argv%) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/bbc-basic/types.bas ================================================ REM > types library for mal in BBC BASIC REM This library should be the only thing that understands the REM implementation of mal data types in BBC BASIC. All other REM code should use routines in this library to access them. REM As far as other code is concerned, a mal object is just an REM opaque 32-bit integer, which might be a pointer, or might not. REM All mal objects live in an array, Z%(), with string values held REM in a parallel array, Z$(). There's one row in Z%(), and one REM entry in Z$(), for each mal object. REM Z%(x,0) holds the type of an object and other small amounts of REM information. The bottom bit indicates the semantics of Z%(x,1): REM &01 : Z%(x,1) is a pointer into Z%() REM Z%(x,2) and Z%(x,3) are always pointers into Z%(), to 'nil' if nothing REM else. REM The &40 bit is used to distinguish empty lists, vectors and hash-maps. REM The &80 bit distinguishes vectors from lists and macros from functions. REM sS%() is a shadow stack, used to keep track of which mal values might REM be referenced from local variables at a given depth of the BASIC call REM stack. It grows upwards. sSP% points to the first unused word. sFP% REM points to the start of the current shadow stack frame. The first word REM of each shadow stack frame is the saved value of sFP%. The rest are REM mal values. REM Types are: REM &00 nil REM &04 boolean REM &08 integer REM &0C core function REM &01 atom REM &05 free block REM &09 list/vector (each object is a cons cell) REM &0D environment REM &11 hash-map internal node REM &15 mal function (first part) REM &19 mal function (second part) REM &02 string/keyword REM &06 symbol REM &0A hash-map leaf node REM Formats of individual objects are defined below. DEF PROCtypes_init REM Mal's heap has to be statically dimensioned, but we also REM need to leave enough space for BASIC's stack and heap. REM The BASIC heap is where all strings live. REM REM Each row of Z%() consumes 16 bytes. The size of each entry REM in Z$() varies by platform: 5 bytes in ARM BBC BASIC V, REM 8 bytes in Brandy on a 32-bit system, 16 bytes in Brandy on REM a 64-bit system. DIM Z%((HIMEM-LOMEM)/110,3), Z$((HIMEM-LOMEM)/110) DIM sS%((HIMEM-LOMEM)/64) Z%(1,0) = &04 : REM false Z%(2,0) = &04 : Z%(2,1) = TRUE : REM true Z%(3,0) = &49 : Z%(3,1) = 3 : REM empty list Z%(4,0) = &C9 : Z%(4,1) = 4 : REM empty vector Z%(5,0) = &51 : REM empty hashmap next_Z% = 6 sSP% = 1 sFP% = 0 F% = 0 ENDPROC DEF FNtype_of(val%) =Z%(val%,0) AND &1F DEF PROCgc_enter REM PRINT ;sFP%; sS%(sSP%) = sFP% sFP% = sSP% sSP% += 1 REM PRINT " >>> ";sFP% ENDPROC REM FNgc_save is equivalent to PROCgc_enter except that it returns a REM value that can be passed to PROCgc_restore to pop all the stack REM frames back to (and including) the one pushed by FNgc_save. DEF FNgc_save PROCgc_enter =sFP% DEF PROCgc_exit REM PRINT ;sS%(sFP%);" <<< ";sFP% sSP% = sFP% sFP% = sS%(sFP%) ENDPROC DEF PROCgc_restore(oldFP%) sFP% = oldFP% REM PRINT "!!! FP reset" PROCgc_exit ENDPROC DEF FNref_local(val%) sS%(sSP%) = val% sSP% += 1 =val% DEF FNgc_exit(val%) PROCgc_exit =FNref_local(val%) DEF FNgc_restore(oldFP%, val%) PROCgc_restore(oldFP%) =FNref_local(val%) DEF PROCgc_keep_only2(val1%, val2%) PROCgc_exit PROCgc_enter val1% = FNref_local(val1%) val2% = FNref_local(val2%) ENDPROC DEF FNmalloc(type%) LOCAL val% REM If the heap is full, collect garbage first. IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN PROCgc IF F% = 0 ERROR &40E80950, "Out of mal heap memory" ENDIF IF F% <> 0 THEN val% = F% F% = Z%(val%,1) ELSE val% = next_Z% next_Z% += 1 ENDIF Z%(val%,0) = type% =FNref_local(val%) DEF PROCfree(val%) Z%(val%,0) = &05 Z%(val%,1) = F% Z%(val%,2) = 0 Z%(val%,3) = 0 Z$(val%) = "" F% = val% ENDPROC DEF PROCgc REM PRINT "** START GC **" PROCgc_markall PROCgc_sweep REM PRINT "** FINISH GC **" ENDPROC DEF PROCgc_markall LOCAL sp%, fp% fp% = sFP% REM PRINT ">>marking..."; FOR sp% = sSP% - 1 TO 0 STEP -1 IF sp% = fp% THEN fp% = sS%(sp%) REM PRINT " / "; ELSE PROCgc_mark(sS%(sp%)) ENDIF NEXT sp% REM PRINT ENDPROC DEF PROCgc_mark(val%) IF (Z%(val%,0) AND &100) = 0 THEN REM PRINT " ";val%; Z%(val%,0) += &100 IF (Z%(val%,0) AND &01) THEN PROCgc_mark(Z%(val%,1)) PROCgc_mark(Z%(val%,2)) PROCgc_mark(Z%(val%,3)) ENDIF ENDPROC DEF PROCgc_sweep LOCAL val% REM PRINT ">>sweeping ..."; FOR val% = 6 TO next_Z% - 1 IF FNtype_of(val%) <> &05 AND (Z%(val%,0) AND &100) = 0 THEN REM PRINT " ";val%; PROCfree(val%) ELSE Z%(val%,0) -= &100 ENDIF NEXT val% REM PRINT ENDPROC DEF FNmeta(val%) =Z%(val%,3) DEF FNwith_meta(val%, meta%) LOCAL newval% newval% = FNmalloc(Z%(val%,0)) Z%(newval%,1) = Z%(val%,1) Z%(newval%,2) = Z%(val%,2) Z%(newval%,3) = meta% Z$(newval%) = Z$(val%) =newval% REM ** Nil ** DEF FNis_nil(val%) =FNtype_of(val%) = 0 DEF FNnil =0 REM ** Boolean ** REM Z%(x,1) = TRUE or FALSE DEF FNis_boolean(val%) =FNtype_of(val%) = &04 DEF FNalloc_boolean(bval%) IF bval% THEN =2 =1 DEF FNunbox_boolean(val%) IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean" =Z%(val%,1) DEF FNis_truish(val%) IF FNis_nil(val%) THEN =FALSE IF FNis_boolean(val%) THEN =FNunbox_boolean(val%) =TRUE REM ** Integers ** REM Z%(x,1) = integer value DEF FNis_int(val%) =FNtype_of(val%) = &08 DEF FNalloc_int(ival%) LOCAL val% val% = FNmalloc(&08) Z%(val%,1) = ival% =val% DEF FNunbox_int(val%) IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer" =Z%(val%,1) REM ** Strings and keywords ** REM Z$(x) is the string value REM Z%(x,2) points to the next part of the string REM A keyword is a string with first character CHR$(127). DEF FNis_string(val%) =FNtype_of(val%) = &02 DEF FNalloc_string(sval$) LOCAL val% val% = FNmalloc(&02) Z$(val%) = sval$ =val% DEF FNunbox_string(val%) IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" IF NOT FNis_nil(Z%(val%,2)) ERROR &40E80914, "Cannot unbox a long string" =Z$(val%) DEF FNstring_append(val%, add$) LOCAL newval% IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" newval% = FNalloc_string(Z$(val%)) IF FNis_nil(Z%(val%,2)) THEN IF LEN(Z$(newval%)) + LEN(add$) <= 255 THEN Z$(newval%) += add$ ELSE Z%(newval%,2) = FNalloc_string(add$) ENDIF ELSE Z%(newval%,2) = FNstring_append(Z%(val%,2), add$) ENDIF =newval% DEF FNstring_concat(val%, add%) LOCAL newval% IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" IF NOT FNis_string(add%) THEN ERROR &40E80914, "Not a string" newval% = FNalloc_string(Z$(val%)) IF FNis_nil(Z%(val%,2)) THEN IF LEN(Z$(newval%)) + LEN(Z$(add%)) <= 255 THEN Z$(newval%) += Z$(add%) Z%(newval%,2) = Z%(add%,2) ELSE Z%(newval%,2) = add% ENDIF ELSE Z%(newval%,2) = FNstring_concat(Z%(val%,2), add%) ENDIF =newval% DEF FNstring_len(val%) LOCAL len% WHILE NOT FNis_nil(val%) len% += LEN(Z$(val%)) val% = Z%(val%,2) ENDWHILE =len% DEF FNstring_chr(val%, pos%) WHILE pos% > LEN(Z$(val%)) pos% -= LEN(Z$(val%)) val% = Z%(val%,2) IF FNis_nil(val%) THEN ="" ENDWHILE =MID$(Z$(val%), pos%, 1) REM ** Symbols ** REM Z$(x) = value of the symbol DEF FNis_symbol(val%) =FNtype_of(val%) = &06 DEF FNalloc_symbol(sval$) LOCAL val% val% = FNmalloc(&06) Z$(val%) = sval$ =val% DEF FNunbox_symbol(val%) IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol" =Z$(val%) REM ** Lists and vectors ** REM Lists and vectors are both represented as linked lists: the only REM difference is in the state of the is_vector flag in the head cell REM of the list. Note that this means that the tail of a list may be REM a vector, and vice versa. FNas_list and FNas_vector can be used REM to convert a sequence to a particular type as necessary. REM Z%(x,0) AND &80 = is_vector flag REM Z%(x,1) = index in Z%() of next pair REM Z%(x,2) = index in Z%() of first element REM The empty list is a distinguished value, with elements that match REM the spec of 'first' and 'rest'. DEF FNempty =3 DEF FNempty_vector =4 DEF FNalloc_pair(car%, cdr%) LOCAL val% val% = FNmalloc(&09) Z%(val%,2) = car% Z%(val%,1) = cdr% =val% DEF FNalloc_vector_pair(car%, cdr%) LOCAL val% val% = FNalloc_pair(car%, cdr%) Z%(val%,0) = Z%(val%,0) OR &80 =val% DEF FNis_empty(val%) =(Z%(val%,0) AND &40) = &40 DEF FNis_seq(val%) =FNtype_of(val%) = &09 DEF FNis_list(val%) =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &00 DEF FNis_vector(val%) =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &80 DEF FNas_list(val%) IF FNis_list(val%) THEN =val% IF FNis_empty(val%) THEN =FNempty =FNalloc_pair(FNfirst(val%), FNrest(val%)) DEF FNas_vector(val%) IF FNis_vector(val%) THEN =val% IF FNis_empty(val%) THEN =FNempty_vector =FNalloc_vector_pair(FNfirst(val%), FNrest(val%)) DEF FNfirst(val%) IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get car of non-sequence" =FNref_local(Z%(val%,2)) DEF FNrest(val%) IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get cdr of non-sequence" =FNref_local(Z%(val%,1)) DEF FNalloc_list2(val0%, val1%) =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty)) DEF FNalloc_list3(val0%, val1%, val2%) =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty))) DEF FNcount(val%) LOCAL i% WHILE NOT FNis_empty(val%) val% = FNrest(val%) i% += 1 ENDWHILE = i% DEF FNnth(val%, n%) WHILE n% > 0 IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" val% = FNrest(val%) n% -= 1 ENDWHILE IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" =FNfirst(val%) REM ** Core functions ** REM Z%(x,1) = index of function in FNcore_call DEF FNis_corefn(val%) =FNtype_of(val%) = &0C DEF FNalloc_corefn(fn%) LOCAL val% val% = FNmalloc(&0C) Z%(val%,1) = fn% =val% DEF FNunbox_corefn(val%) IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function" =Z%(val%,1) REM ** Hash-maps ** REM Hash-maps are represented as a crit-bit tree. REM An internal node has: REM Z%(x,0) >> 16 = next bit of key to check REM Z%(x,1) = index in Z%() of left child (if next bit of key is 0) REM Z%(x,2) = index in Z%() of right child (if next bit of key is 1) REM A leaf node has REM Z$(x) = key REM Z%(x,2) = index in Z%() of value REM The empty hash-map is a special value containing no data. DEF FNempty_hashmap =5 DEF FNhashmap_alloc_leaf(key$, val%) LOCAL entry% entry% = FNmalloc(&0A) Z$(entry%) = key$ Z%(entry%,2) = val% =entry% DEF FNhashmap_alloc_node(bit%, left%, right%) LOCAL entry% entry% = FNmalloc(&11) Z%(entry%,0) += (bit% << 16) Z%(entry%,1) = left% Z%(entry%,2) = right% =entry% DEF FNis_hashmap(val%) LOCAL t% t% = FNtype_of(val%) =t% = &11 OR t% = &0A DEF FNkey_bit(key$, bit%) LOCAL cnum% cnum% = bit% >> 3 IF cnum% >= LEN(key$) THEN =FALSE =ASC(MID$(key$, cnum% + 1, 1)) AND (&80 >> (bit% AND 7)) DEF FNkey_bitdiff(key1$, key2$) LOCAL bit% WHILE FNkey_bit(key1$, bit%) = FNkey_bit(key2$, bit%) bit% += 1 ENDWHILE =bit% DEF FNhashmap_set(map%, key$, val%) LOCAL bit%, nearest% IF FNis_empty(map%) THEN =FNhashmap_alloc_leaf(key$, val%) nearest% = FNhashmap_find(map%, key$) IF Z$(nearest%) = key$ THEN =FNhashmap_replace(map%, key$, val%) bit% = FNkey_bitdiff(key$, Z$(nearest%)) =FNhashmap_insert(map%, bit%, key$, val%) DEF FNhashmap_insert(map%, bit%, key$, val%) LOCAL left%, right% IF FNtype_of(map%) = &11 AND (Z%(map%,0) >> 16) < bit% THEN IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN left% = Z%(map%,1) right% = FNhashmap_insert(Z%(map%,2), bit%, key$, val%) ELSE left% = FNhashmap_insert(Z%(map%,1), bit%, key$, val%) right% = Z%(map%,2) ENDIF =FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) ENDIF IF FNkey_bit(key$, bit%) THEN left% = map% right% = FNhashmap_alloc_leaf(key$, val%) ELSE left% = FNhashmap_alloc_leaf(key$, val%) right% = map% ENDIF =FNhashmap_alloc_node(bit%, left%, right%) REM Replace a known-present key in a non-empty hashmap. DEF FNhashmap_replace(map%, key$, val%) LOCAL left%, right% IF FNtype_of(map%) = &0A THEN =FNhashmap_alloc_leaf(key$, val%) IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN left% = Z%(map%,1) right% = FNhashmap_replace(Z%(map%,2), key$, val%) ELSE left% = FNhashmap_replace(Z%(map%,1), key$, val%) right% = Z%(map%,2) ENDIF =FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) DEF FNhashmap_remove(map%, key$) LOCAL child% IF FNis_empty(map%) THEN =map% IF FNtype_of(map%) = &0A THEN IF Z$(map%) = key$ THEN =FNempty_hashmap ENDIF IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN child% = FNhashmap_remove(Z%(map%,2), key$) IF FNis_empty(child%) THEN =Z%(map%,1) =FNhashmap_alloc_node(Z%(map%,0)>>16, Z%(map%,1), child%) ELSE child% = FNhashmap_remove(Z%(map%,1), key$) IF FNis_empty(child%) THEN =Z%(map%,2) =FNhashmap_alloc_node(Z%(map%,0)>>16, child%, Z%(map%,2)) ENDIF REM FNhashmap_find finds the nearest entry in a non-empty hash-map to REM the key requested, and returns the entire entry. DEF FNhashmap_find(map%, key$) WHILE FNtype_of(map%) = &11 IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN map% = Z%(map%,2) ELSE map% = Z%(map%,1) ENDWHILE =map% DEF FNhashmap_get(map%, key$) IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" IF FNis_empty(map%) THEN =FNnil map% = FNhashmap_find(map%, key$) IF Z$(map%) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil DEF FNhashmap_contains(map%, key$) IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" IF FNis_empty(map%) THEN =FALSE map% = FNhashmap_find(map%, key$) =Z$(map%) = key$ DEF FNhashmap_keys(map%) =FNhashmap_keys1(map%, FNempty) DEF FNhashmap_keys1(map%, acc%) IF FNis_empty(map%) THEN =acc% IF FNtype_of(map%) = &0A THEN =FNalloc_pair(FNalloc_string(Z$(map%)), acc%) ENDIF =FNhashmap_keys1(Z%(map%,1), FNhashmap_keys1(Z%(map%,2), acc%)) DEF FNhashmap_vals(map%) =FNhashmap_vals1(map%, FNempty) DEF FNhashmap_vals1(map%, acc%) IF FNis_empty(map%) THEN =acc% IF FNtype_of(map%) = &0A THEN =FNalloc_pair(Z%(map%,2), acc%) ENDIF =FNhashmap_vals1(Z%(map%,1), FNhashmap_vals1(Z%(map%,2), acc%)) DEF PROChashmap_dump(map%) IF FNis_empty(map%) THEN PRINT "[empty]" ELSE PRINT "[-----]" PROChashmap_dump_internal(map%, "") ENDIF ENDPROC DEF PROChashmap_dump_internal(map%, prefix$) IF FNtype_of(map%) = &0A PRINT prefix$;Z$(map%) IF FNtype_of(map%) = &11 THEN PRINT prefix$;"<";Z%(map%,0) >> 16;">" PROChashmap_dump_internal(Z%(map%,1), prefix$ + "L ") PROChashmap_dump_internal(Z%(map%,2), prefix$ + "R ") ENDIF ENDPROC REM ** Functions ** REM A function is represented by two cells: REM Z%(x,0) AND &80 = is_macro flag REM Z%(x,1) = index in Z%() of ast REM Z%(x,2) = y REM Z%(y,1) = index in Z%() of params REM Z%(y,2) = index in Z%() of env DEF FNis_fn(val%) =FNtype_of(val%) = &15 DEF FNis_nonmacro_fn(val%) =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &00 DEF FNis_macro(val%) =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &80 DEF FNalloc_fn(ast%, params%, env%) LOCAL val1%, val2% val1% = FNmalloc(&15) Z%(val1%,1) = ast% val2% = FNmalloc(&19) Z%(val1%,2) = val2% Z%(val2%,1) = params% Z%(val2%,2) = env% =val1% DEF FNas_macro(val%) IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" LOCAL newval% newval% = FNmalloc(Z%(val%,0) OR &80) Z%(newval%,1) = Z%(val%,1) Z%(newval%,2) = Z%(val%,2) Z%(newval%,3) = Z%(val%,3) =newval% DEF FNfn_ast(val%) IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" =FNref_local(Z%(val%,1)) DEF FNfn_params(val%) IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" =FNref_local(Z%(Z%(val%,2),1)) DEF FNfn_env(val%) IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" =FNref_local(Z%(Z%(val%,2),2)) REM ** Atoms ** REM Z%(x,1) = index in Z% of current referent DEF FNis_atom(val%) =FNtype_of(val%) = &01 DEF FNalloc_atom(contents%) LOCAL val% val% = FNmalloc(&01) Z%(val%,1) = contents% =val% DEF FNatom_deref(val%) =FNref_local(Z%(val%,1)) DEF PROCatom_reset(val%, contents%) Z%(val%,1) = contents% ENDPROC REM ** Environments ** REM Z%(x,1) = index in Z% of hash-map REM Z%(x,2) = index in Z% of outer environment DEF FNis_environment(val%) =FNtype_of(val%) = &0D DEF FNalloc_environment(outer%) LOCAL val% val% = FNmalloc(&0D) Z%(val%,1) = FNempty_hashmap Z%(val%,2) = outer% =val% DEF FNenvironment_data(val%) IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" =FNref_local(Z%(val%,1)) DEF PROCenvironment_set_data(val%, data%) IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" Z%(val%,1) = data% ENDPROC DEF FNenvironment_outer(val%) IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" =FNref_local(Z%(val%,2)) REM Local Variables: REM indent-tabs-mode: nil REM End: ================================================ FILE: impls/c/Dockerfile ================================================ FROM ubuntu:vivid MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Install g++ for any C/C++ based implementations RUN apt-get -y install g++ # Libraries needed for the C impl RUN apt-get -y install libglib2.0 libglib2.0-dev libffi-dev libgc-dev ================================================ FILE: impls/c/Makefile ================================================ USE_READLINE ?= USE_GC ?= 1 CFLAGS ?= -g -O2 LDFLAGS ?= -g ##################### SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \ step4_if_fn_do.c step5_tco.c step6_file.c step7_quote.c \ step8_macros.c step9_try.c stepA_mal.c OBJS = $(SRCS:%.c=%.o) BINS = $(OBJS:%.o=%) OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o OTHER_HDRS = types.h readline.h reader.h printer.h core.h interop.h GLIB_CFLAGS ?= $(shell pkg-config --cflags glib-2.0) GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0) FFI_CFLAGS ?= $(shell pkg-config libffi --cflags) FFI_LDFLAGS ?= $(shell pkg-config libffi --libs) ifeq ($(shell uname -s),Darwin) darwin_CPPFLAGS ?= -DOSX=1 endif ifeq (,$(USE_READLINE)) RL_LIBRARY ?= edit else RL_LIBRARY ?= readline rl_CFLAGS ?= -DUSE_READLINE=1 endif ifneq (,$(USE_GC)) gc_CFLAGS ?= -DUSE_GC=1 gc_LIBS ?= -lgc endif # Rewrite CPPFLAGS for the Make recipes, but let existing user options # take precedence. override CPPFLAGS := \ ${darwin_CPPFLAGS} ${rl_CFLAGS} ${gc_CFLAGS} ${GLIB_CFLAGS} ${FFI_CFLAGS} \ ${CPPFLAGS} override LDLIBS += \ ${gc_LIBS} -l${RL_LIBRARY} ${GLIB_LDFLAGS} ${FFI_LDFLAGS} -ldl ##################### all: $(BINS) dist: mal mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ $(OBJS) $(OTHER_OBJS): %.o: %.c $(OTHER_HDRS) $(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) $(BINS): %: %.o clean: rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal ================================================ FILE: impls/c/core.c ================================================ #include #include #include #include #include #include #include #include #include "types.h" #include "core.h" #include "reader.h" #include "printer.h" // Errors/Exceptions void throw(MalVal *obj) { mal_error = obj; } // General functions MalVal *equal_Q(MalVal *a, MalVal *b) { if (_equal_Q(a, b)) { return &mal_true; } else { return &mal_false; } } // Misc predicates MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; } MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; } MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; } MalVal *string_Q(MalVal *seq) { if ((seq->type & MAL_STRING) && (seq->val.string[0] != '\x7f')) { return &mal_true; } else { return &mal_false; } } MalVal *number_Q(MalVal *obj) { return obj->type & MAL_INTEGER || obj->type & MAL_FLOAT ? &mal_true : &mal_false; } MalVal *fn_Q(MalVal *obj) { return (obj->type & MAL_FUNCTION_C || obj->type & MAL_FUNCTION_MAL) && !obj->ismacro ? &mal_true : &mal_false; } MalVal *macro_Q(MalVal *obj) { return obj->ismacro ? &mal_true : &mal_false; } // Symbol functions MalVal *symbol(MalVal *args) { assert_type(args, MAL_STRING, "symbol called with non-string value"); args->type = MAL_SYMBOL; // change string to symbol return args; } MalVal *symbol_Q(MalVal *seq) { return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; } // Keyword functions MalVal *keyword(MalVal *args) { assert_type(args, MAL_STRING, "keyword called with non-string value"); if (args->val.string[0] == '\x7f') { return args; } else { return malval_new_keyword(args->val.string); } } MalVal *keyword_Q(MalVal *seq) { return seq->type & MAL_STRING && seq->val.string[0] == '\x7f' ? &mal_true : &mal_false; } // String functions // Return a string representation of a MalVal sequence (in a format that can // be read by the reader). Returned string must be freed by caller. MalVal *pr_str(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "pr_str called with non-sequential args"); return malval_new_string(_pr_str_args(args, " ", 1)); } // Return a string representation of a MalVal sequence with every item // concatenated together. Returned string must be freed by caller. MalVal *str(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "str called with non-sequential args"); return malval_new_string(_pr_str_args(args, "", 0)); } // Print a string representation of a MalVal sequence (in a format that can // be read by the reader) followed by a newline. Returns nil. MalVal *prn(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "prn called with non-sequential args"); char *repr = _pr_str_args(args, " ", 1); puts(repr); MAL_GC_FREE(repr); return &mal_nil; } // Print a string representation of a MalVal sequence (for human consumption) // followed by a newline. Returns nil. MalVal *println(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "println called with non-sequential args"); char *repr = _pr_str_args(args, " ", 0); puts(repr); MAL_GC_FREE(repr); return &mal_nil; } MalVal *mal_readline(MalVal *str) { assert_type(str, MAL_STRING, "readline of non-string"); char * line = _readline(str->val.string); if (line) { return malval_new_string(line); } else { return &mal_nil; } } MalVal *read_string(MalVal *str) { assert_type(str, MAL_STRING, "read_string of non-string"); return read_str(str->val.string); } char *slurp_raw(char *path) { char *data; struct stat fst; int fd = open(path, O_RDONLY), sz; if (fd < 0) { abort("slurp failed to open '%s'", path); } if (fstat(fd, &fst) < 0) { abort("slurp failed to stat '%s'", path); } data = MAL_GC_MALLOC(fst.st_size+1); sz = read(fd, data, fst.st_size); if (sz < fst.st_size) { abort("slurp failed to read '%s'", path); } data[sz] = '\0'; return data; } MalVal *slurp(MalVal *path) { assert_type(path, MAL_STRING, "slurp of non-string"); char *data = slurp_raw(path->val.string); if (!data || mal_error) { return NULL; } return malval_new_string(data); } // Number functions WRAP_INTEGER_OP(plus,+) WRAP_INTEGER_OP(minus,-) WRAP_INTEGER_OP(multiply,*) WRAP_INTEGER_OP(divide,/) WRAP_INTEGER_CMP_OP(gt,>) WRAP_INTEGER_CMP_OP(gte,>=) WRAP_INTEGER_CMP_OP(lt,<) WRAP_INTEGER_CMP_OP(lte,<=) MalVal *time_ms(MalVal *_) { struct timeval tv; long msecs; gettimeofday(&tv, NULL); msecs = tv.tv_sec * 1000 + tv.tv_usec/1000.0 + 0.5; return malval_new_integer(msecs); } // List functions MalVal *list(MalVal *args) { return _list(args); } MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; } // Vector functions MalVal *vector(MalVal *args) { return _vector(args); } MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; } // Hash map functions MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; } MalVal *assoc(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "assoc called with non-sequential arguments"); assert(_count(args) >= 2, "assoc needs at least 2 arguments"); GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); MalVal *hm = malval_new_hash_map(htable); return _assoc_BANG(hm, _rest(args)); } MalVal *dissoc(MalVal* args) { GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table); MalVal *hm = malval_new_hash_map(htable); return _dissoc_BANG(hm, _rest(args)); } MalVal *keys(MalVal *obj) { assert_type(obj, MAL_HASH_MAP, "keys called on non-hash-map"); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(obj))); g_hash_table_iter_init (&iter, obj->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); } return seq; } MalVal *vals(MalVal *obj) { assert_type(obj, MAL_HASH_MAP, "vals called on non-hash-map"); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(obj))); g_hash_table_iter_init (&iter, obj->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { g_array_append_val(seq->val.array, value); } return seq; } // hash map and vector functions MalVal *get(MalVal *obj, MalVal *key) { MalVal *val; switch (obj->type) { case MAL_VECTOR: return _nth(obj, key->val.intnum); case MAL_HASH_MAP: if (g_hash_table_lookup_extended(obj->val.hash_table, key->val.string, NULL, (gpointer*)&val)) { return val; } else { return &mal_nil; } case MAL_NIL: return &mal_nil; default: abort("get called on unsupported type %d", obj->type); } } MalVal *contains_Q(MalVal *obj, MalVal *key) { switch (obj->type) { case MAL_VECTOR: if (key->val.intnum < obj->val.array->len) { return &mal_true; } else { return &mal_false; } case MAL_HASH_MAP: if (g_hash_table_contains(obj->val.hash_table, key->val.string)) { return &mal_true; } else { return &mal_false; } default: abort("contains? called on unsupported type %d", obj->type); } } // Sequence functions MalVal *sequential_Q(MalVal *seq) { return _sequential_Q(seq) ? &mal_true : &mal_false; } MalVal *cons(MalVal *x, MalVal *seq) { assert_type(seq, MAL_LIST|MAL_VECTOR, "second argument to cons is non-sequential"); int i, len = _count(seq); GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len+1); g_array_append_val(new_arr, x); for (i=0; ival.array, MalVal*, i)); } return malval_new_list(MAL_LIST, new_arr); } MalVal *concat(MalVal *args) { MalVal *arg, *e, *lst; int i, j, arg_cnt = _count(args); lst = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt)); for (i=0; ival.array, MalVal*, i); assert_type(arg, MAL_LIST|MAL_VECTOR, "concat called with non-sequential"); for (j=0; j<_count(arg); j++) { e = g_array_index(arg->val.array, MalVal*, j); g_array_append_val(lst->val.array, e); } } 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); } MalVal *empty_Q(MalVal *seq) { assert_type(seq, MAL_LIST|MAL_VECTOR, "empty? called with non-sequential"); return (seq->val.array->len == 0) ? &mal_true : &mal_false; } MalVal *count(MalVal *seq) { return malval_new_integer(_count(seq)); } MalVal *apply(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "apply called with non-sequential"); MalVal *f = _nth(args, 0); MalVal *last_arg = _last(args); assert_type(last_arg, MAL_LIST|MAL_VECTOR, "last argument to apply is non-sequential"); int i, len = _count(args) - 2 + _count(last_arg); GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len); // Initial arguments for (i=1; i<_count(args)-1; i++) { g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); } // Add arguments from last_arg for (i=0; i<_count(last_arg); i++) { g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i)); } return _apply(f, malval_new_list(MAL_LIST, new_arr)); } MalVal *map(MalVal *mvf, MalVal *lst) { MalVal *res, *el; assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "map called with non-function"); assert_type(lst, MAL_LIST|MAL_VECTOR, "map called with non-sequential"); int i, len = _count(lst); el = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); for (i=0; itype & MAL_FUNCTION_MAL) { Env *fn_env = new_env(mvf->val.func.env, mvf->val.func.args, _slice(lst, i, i+1)); res = mvf->val.func.evaluator(mvf->val.func.body, fn_env); } else { res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i)); } if (!res || mal_error) return NULL; g_array_append_val(el->val.array, res); } return el; } MalVal *sconj(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "conj called with non-sequential"); MalVal *src_lst = _nth(args, 0); assert_type(args, MAL_LIST|MAL_VECTOR, "first argument to conj is non-sequential"); int i, len = _count(src_lst) + _count(args) - 1; GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len); // Copy in src_lst for (i=0; i<_count(src_lst); i++) { g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i)); } // Conj extra args for (i=1; i<_count(args); i++) { if (src_lst->type & MAL_LIST) { g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i)); } else { g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); } } return malval_new_list(src_lst->type, new_arr); } MalVal *seq(MalVal *obj) { assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_STRING|MAL_NIL, "seq: called with non-sequential"); int cnt, i; MalVal *lst, *mstr; switch (obj->type) { case MAL_LIST: cnt = _count(obj); if (cnt == 0) { return &mal_nil; } return obj; case MAL_VECTOR: cnt = _count(obj); if (cnt == 0) { return &mal_nil; } lst = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), cnt)); lst->val.array = obj->val.array; return lst; case MAL_STRING: cnt = strlen(obj->val.string); if (cnt == 0) { return &mal_nil; } lst = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), cnt)); for (i=0; ival.string[i])); g_array_append_val(lst->val.array, mstr); } return lst; case MAL_NIL: return &mal_nil; } } // Metadata functions MalVal *with_meta(MalVal *obj, MalVal *meta) { MalVal *new_obj = malval_new(obj->type, meta); new_obj->val = obj->val; return new_obj; } MalVal *meta(MalVal *obj) { assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP| MAL_FUNCTION_C|MAL_FUNCTION_MAL|MAL_ATOM, "attempt to get metadata from non-collection type"); if (obj->metadata == NULL) { return &mal_nil; } else { return obj->metadata; } } // Atoms MalVal *atom(MalVal *val) { return malval_new_atom(val); } MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; } MalVal *deref(MalVal *atm) { assert_type(atm, MAL_ATOM, "deref called on non-atom"); return atm->val.atom_val; } MalVal *reset_BANG(MalVal *atm, MalVal *val) { assert_type(atm, MAL_ATOM, "reset! called with non-atom"); atm->val.atom_val = val; return val; } MalVal *swap_BANG(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "swap! called with invalid arguments"); assert(_count(args) >= 2, "swap! called with %d args, needs at least 2", _count(args)); MalVal *atm = _nth(args, 0), *f = _nth(args, 1), *sargs = _slice(args, 2, _count(args)), *fargs = cons(atm->val.atom_val, sargs), *new_val = _apply(f, fargs); if (mal_error) { return NULL; } atm->val.atom_val = new_val; return new_val; } core_ns_entry core_ns[] = { {"=", (void*(*)(void*))equal_Q, 2}, {"throw", (void*(*)(void*))throw, 1}, {"nil?", (void*(*)(void*))nil_Q, 1}, {"true?", (void*(*)(void*))true_Q, 1}, {"false?", (void*(*)(void*))false_Q, 1}, {"string?", (void*(*)(void*))string_Q, 1}, {"symbol", (void*(*)(void*))symbol, 1}, {"symbol?", (void*(*)(void*))symbol_Q, 1}, {"keyword", (void*(*)(void*))keyword, 1}, {"keyword?", (void*(*)(void*))keyword_Q, 1}, {"number?", (void*(*)(void*))number_Q, 1}, {"fn?", (void*(*)(void*))fn_Q, 1}, {"macro?", (void*(*)(void*))macro_Q, 1}, {"pr-str", (void*(*)(void*))pr_str, -1}, {"str", (void*(*)(void*))str, -1}, {"prn", (void*(*)(void*))prn, -1}, {"println", (void*(*)(void*))println, -1}, {"readline", (void*(*)(void*))mal_readline, 1}, {"read-string", (void*(*)(void*))read_string, 1}, {"slurp", (void*(*)(void*))slurp, 1}, {"<", (void*(*)(void*))int_lt, 2}, {"<=", (void*(*)(void*))int_lte, 2}, {">", (void*(*)(void*))int_gt, 2}, {">=", (void*(*)(void*))int_gte, 2}, {"+", (void*(*)(void*))int_plus, 2}, {"-", (void*(*)(void*))int_minus, 2}, {"*", (void*(*)(void*))int_multiply, 2}, {"/", (void*(*)(void*))int_divide, 2}, {"time-ms", (void*(*)(void*))time_ms, 0}, {"list", (void*(*)(void*))list, -1}, {"list?", (void*(*)(void*))list_Q, 1}, {"vector", (void*(*)(void*))vector, -1}, {"vector?", (void*(*)(void*))vector_Q, 1}, {"hash-map", (void*(*)(void*))_hash_map, -1}, {"map?", (void*(*)(void*))hash_map_Q, 1}, {"assoc", (void*(*)(void*))assoc, -1}, {"dissoc", (void*(*)(void*))dissoc, -1}, {"get", (void*(*)(void*))get, 2}, {"contains?", (void*(*)(void*))contains_Q, 2}, {"keys", (void*(*)(void*))keys, 1}, {"vals", (void*(*)(void*))vals, 1}, {"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}, {"last", (void*(*)(void*))_last, 1}, {"empty?", (void*(*)(void*))empty_Q, 1}, {"count", (void*(*)(void*))count, 1}, {"apply", (void*(*)(void*))apply, -1}, {"map", (void*(*)(void*))map, 2}, {"conj", (void*(*)(void*))sconj, -1}, {"seq", (void*(*)(void*))seq, 1}, {"with-meta", (void*(*)(void*))with_meta, 2}, {"meta", (void*(*)(void*))meta, 1}, {"atom", (void*(*)(void*))atom, 1}, {"atom?", (void*(*)(void*))atom_Q, 1}, {"deref", (void*(*)(void*))deref, 1}, {"reset!", (void*(*)(void*))reset_BANG, 2}, {"swap!", (void*(*)(void*))swap_BANG, -1}, }; ================================================ FILE: impls/c/core.h ================================================ #ifndef __MAL_CORE__ #define __MAL_CORE__ #include // namespace of type functions typedef struct { char *name; void *(*func)(void*); int arg_cnt; } core_ns_entry; extern core_ns_entry core_ns[62]; #endif ================================================ FILE: impls/c/env.c ================================================ #include #include "types.h" // Env Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { Env *e = MAL_GC_MALLOC(sizeof(Env)); e->table = g_hash_table_new(g_str_hash, g_str_equal); e->outer = outer; if (binds && exprs) { assert_type(binds, MAL_LIST|MAL_VECTOR, "new_env called with non-sequential bindings"); assert_type(exprs, MAL_LIST|MAL_VECTOR, "new_env called with non-sequential expressions"); int binds_len = _count(binds), exprs_len = _count(exprs), varargs = 0, i; for (i=0; i exprs_len) { break; } if (_nth(binds, i)->val.string[0] == '&') { varargs = 1; env_set(e, _nth(binds, i+1)->val.string, _slice(exprs, i, _count(exprs))); break; } else { env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); } } assert(varargs || (binds_len == exprs_len), "Arity mismatch: %d formal params vs %d actual params", binds_len, exprs_len); } return e; } MalVal *env_get(Env *env, const char *key) { MalVal *val = g_hash_table_lookup(env->table, key); if (val) { return val; } else if (env->outer) { return env_get(env->outer, key); } else { return NULL; } } void env_set(Env *env, char *key, MalVal *val) { g_hash_table_insert(env->table, key, val); } ================================================ FILE: impls/c/interop.c ================================================ #include #include #if OSX #include #else #include #endif #include "types.h" GHashTable *loaded_dls = NULL; int get_byte_size(char *type) { return 0; } typedef struct Raw64 { union { gdouble floatnum; gint64 integernum; char *string; } v; } Raw64; // obj must be a pointer to the object to store ffi_type *_get_ffi_type(char *type) { if ((strcmp("void", type) == 0)) { return &ffi_type_void; } else if ((strcmp("string", type) == 0) || (strcmp("char*", type) == 0) || (strcmp("char *", type) == 0)) { return &ffi_type_pointer; } else if ((strcmp("integer", type) == 0) || (strcmp("int64", type) == 0)) { return &ffi_type_sint64; } else if ((strcmp("int32", type) == 0)) { return &ffi_type_sint32; } else if (strcmp("double", type) == 0) { return &ffi_type_double; } else if (strcmp("float", type) == 0) { return &ffi_type_float; } else { abort("_get_ffi_type of unknown type '%s'", type); } } MalVal *_malval_new_by_type(char *type) { if ((strcmp("void", type) == 0)) { return NULL; } else if ((strcmp("string", type) == 0) || (strcmp("char*", type) == 0) || (strcmp("char *", type) == 0)) { return malval_new(MAL_STRING, NULL); } else if ((strcmp("integer", type) == 0) || (strcmp("int64", type) == 0)) { return malval_new(MAL_INTEGER, NULL); } else if ((strcmp("int32", type) == 0)) { return malval_new(MAL_INTEGER, NULL); } else if (strcmp("double", type) == 0) { return malval_new(MAL_FLOAT, NULL); } else if (strcmp("float", type) == 0) { return malval_new(MAL_FLOAT, NULL); } else { abort("_malval_new_by_type of unknown type '%s'", type); } } // Mal syntax: // (. {DYN_LIB_FILE|nil} RETURN_TYPE FUNC_NAME [ARG_TYPE ARG]...) MalVal *invoke_native(MalVal *call_data) { //g_print("invoke_native %s\n", pr_str(call_data)); int cd_len = call_data->val.array->len; int arg_len = (cd_len - 3)/2; char *error; void *dl_handle; assert_type(call_data, MAL_LIST, "invoke_native called with non-list call_data: %s", _pr_str(call_data,1)); assert(cd_len >= 3, "invoke_native called with %d args, needs at least 3", cd_len); assert((cd_len % 2) == 1, "invoke_native called with an even number of args (%d)", cd_len); assert(arg_len <= 3, "invoke_native called with more than 3 native args (%d)", arg_len); MalVal *dl_file = _nth(call_data, 0), *ftype = _nth(call_data, 1), *fname = _nth(call_data, 2); assert_type(dl_file, MAL_STRING|MAL_NIL, "invoke_native arg 1 (DYN_LIB_NAME) must be a string or nil"); assert_type(ftype, MAL_STRING, "invoke_native arg 2 (RETURN_TYPE) must be a string"); assert_type(fname, MAL_STRING, "invoke_native arg 3 (FUNC_NAME) must be a string"); // Cached load of the dynamic library handle if (dl_file->type == MAL_NIL) { dl_handle = dlopen(NULL, RTLD_LAZY); } else { // Load the library if (loaded_dls == NULL) { loaded_dls = g_hash_table_new(g_str_hash, g_str_equal); } dl_handle = g_hash_table_lookup(loaded_dls, dl_file->val.string); dlerror(); // clear any existing error if (!dl_handle) { dl_handle = dlopen(dl_file->val.string, RTLD_LAZY); } if ((error = dlerror()) != NULL) { abort("Could not dlopen '%s': %s", dl_file->val.string, error); } g_hash_table_insert(loaded_dls, dl_file->val.string, dl_handle); } void * func = dlsym(dl_handle, fname->val.string); if ((error = dlerror()) != NULL) { abort("Could not dlsym '%s': %s", fname->val.string, error); } // // Use FFI library to make a dynamic call // // Based on: // http://eli.thegreenplace.net/2013/03/04/flexible-runtime-interface-to-shared-libraries-with-libffi/ ffi_cif cif; ffi_type *ret_type; ffi_type *arg_types[20]; void *arg_vals[20]; ffi_status status; MalVal *ret_mv; // Set return type ret_type = _get_ffi_type(ftype->val.string); ret_mv = _malval_new_by_type(ftype->val.string); if (mal_error) { return NULL; } // Set the argument types and values int i; for (i=0; i < arg_len; i++) { arg_types[i] = _get_ffi_type(_nth(call_data, 3+i*2)->val.string); if (arg_types[i] == NULL) { return NULL; } arg_vals[i] = &_nth(call_data, 4+i*2)->val; } status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, arg_len, ret_type, arg_types); if (status != FFI_OK) { abort("ffi_prep_cif failed: %d\n", status); } // Perform the call //g_print("Calling %s[%p](%d)\n", fname->val.string, func, arg_len); ffi_call(&cif, FFI_FN(func), &ret_mv->val, arg_vals); if (ret_type == &ffi_type_void) { return &mal_nil; } else { return ret_mv; } } ================================================ FILE: impls/c/interop.h ================================================ #ifndef __MAL_INTEROP__ #define __MAL_INTEROP__ MalVal *invoke_native(MalVal *call_data); #endif ================================================ FILE: impls/c/printer.c ================================================ #include #include #include "types.h" #include "printer.h" char *_pr_str_hash_map(MalVal *obj, int print_readably) { int start = 1; char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL, *key2 = NULL; GHashTableIter iter; gpointer key, value; repr = g_strdup_printf("{"); g_hash_table_iter_init (&iter, obj->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { //g_print ("%s/%p ", (const char *) key, (void *) value); if (((char*)key)[0] == '\x7f') { key2 = g_strdup_printf("%s", (char*)key); key2[0] = ':'; } else { key2 = g_strdup_printf("\"%s\"", (char*)key); } repr_tmp1 = _pr_str((MalVal*)value, print_readably); if (start) { start = 0; repr = g_strdup_printf("{%s %s", (char*)key2, repr_tmp1); } else { repr_tmp2 = repr; repr = g_strdup_printf("%s %s %s", repr_tmp2, (char*)key2, repr_tmp1); MAL_GC_FREE(repr_tmp2); } MAL_GC_FREE(repr_tmp1); } repr_tmp2 = repr; repr = g_strdup_printf("%s}", repr_tmp2); MAL_GC_FREE(repr_tmp2); return repr; } char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) { int i; char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; repr = g_strdup_printf("%c", start); for (i=0; i<_count(obj); i++) { repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i), print_readably); if (i == 0) { repr = g_strdup_printf("%c%s", start, repr_tmp1); } else { repr_tmp2 = repr; repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1); MAL_GC_FREE(repr_tmp2); } MAL_GC_FREE(repr_tmp1); } repr_tmp2 = repr; repr = g_strdup_printf("%s%c", repr_tmp2, end); MAL_GC_FREE(repr_tmp2); return repr; } // Return a string representation of the MalVal object. Returned string must // be freed by caller. char *_pr_str(MalVal *obj, int print_readably) { char *repr = NULL; if (obj == NULL) { return NULL; } switch (obj->type) { case MAL_NIL: repr = g_strdup_printf("nil"); break; case MAL_TRUE: repr = g_strdup_printf("true"); break; case MAL_FALSE: repr = g_strdup_printf("false"); break; case MAL_STRING: if (obj->val.string[0] == '\x7f') { // Keyword repr = g_strdup_printf("%s", obj->val.string); repr[0] = ':'; } else if (print_readably) { char *repr_tmp = g_strescape(obj->val.string, ""); repr = g_strdup_printf("\"%s\"", repr_tmp); MAL_GC_FREE(repr_tmp); } else { repr = g_strdup_printf("%s", obj->val.string); } break; case MAL_SYMBOL: repr = g_strdup_printf("%s", obj->val.string); break; case MAL_INTEGER: repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum); break; case MAL_FLOAT: repr = g_strdup_printf("%f", obj->val.floatnum); break; case MAL_HASH_MAP: repr = _pr_str_hash_map(obj, print_readably); break; case MAL_LIST: repr = _pr_str_list(obj, print_readably, '(', ')'); break; case MAL_VECTOR: repr = _pr_str_list(obj, print_readably, '[', ']'); break; case MAL_ATOM: repr = g_strdup_printf("(atom %s)", _pr_str(obj->val.atom_val, print_readably)); break; case MAL_FUNCTION_C: repr = g_strdup_printf("#", obj->val.f0); break; case MAL_FUNCTION_MAL: repr = g_strdup_printf("#", _pr_str(obj->val.func.args, print_readably), _pr_str(obj->val.func.body, print_readably)); break; default: printf("pr_str unknown type %d\n", obj->type); repr = g_strdup_printf(""); } return repr; } // Return a string representation of the MalVal arguments. Returned string must // be freed by caller. char *_pr_str_args(MalVal *args, char *sep, int print_readably) { assert_type(args, MAL_LIST|MAL_VECTOR, "_pr_str called with non-sequential args"); int i; char *repr = g_strdup_printf("%s", ""), *repr2 = NULL; for (i=0; i<_count(args); i++) { MalVal *obj = g_array_index(args->val.array, MalVal*, i); if (i != 0) { repr2 = repr; repr = g_strdup_printf("%s%s", repr2, sep); MAL_GC_FREE(repr2); } repr2 = repr; repr = g_strdup_printf("%s%s", repr2, _pr_str(obj, print_readably)); MAL_GC_FREE(repr2); } char* res = MAL_GC_STRDUP(repr); MAL_GC_FREE(repr); // TODO - check why STRDUP was needed here return res; } ================================================ FILE: impls/c/printer.h ================================================ #ifndef __MAL_PRINTER__ #define __MAL_PRINTER__ #include "types.h" char *_pr_str_args(MalVal *args, char *sep, int print_readably); char *_pr_str(MalVal *obj, int print_readably); #endif ================================================ FILE: impls/c/reader.c ================================================ #include #include #include //#include //#include #include #include "types.h" #include "reader.h" // Declare MalVal *read_form(Reader *reader); Reader *reader_new() { Reader *reader = (Reader*)MAL_GC_MALLOC(sizeof(Reader)); reader->array = g_array_sized_new(TRUE, FALSE, sizeof(char *), 8); reader->position = 0; return reader; } int reader_append(Reader *reader, char* token) { g_array_append_val(reader->array, token); return TRUE; } char *reader_peek(Reader *reader) { return g_array_index(reader->array, char*, reader->position); } char *reader_next(Reader *reader) { if (reader->position >= reader->array->len) { return NULL; } else { return g_array_index(reader->array, char*, reader->position++); } } void reader_free(Reader *reader) { int i; for(i=0; i < reader->array->len; i++) { MAL_GC_FREE(g_array_index(reader->array, char*, i)); } g_array_free(reader->array, TRUE); MAL_GC_FREE(reader); } Reader *tokenize(char *line) { GRegex *regex; GMatchInfo *matchInfo; GError *err = NULL; Reader *reader = reader_new(); regex = g_regex_new ("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)", 0, 0, &err); g_regex_match (regex, line, 0, &matchInfo); if (err != NULL) { fprintf(stderr, "Tokenize error: %s\n", err->message); return NULL; } while (g_match_info_matches(matchInfo)) { gchar *result = g_match_info_fetch(matchInfo, 1); if (result[0] != '\0' && result[0] != ';') { reader_append(reader, result); } g_match_info_next(matchInfo, &err); } g_match_info_free(matchInfo); g_regex_unref(regex); if (reader->array->len == 0) { reader_free(reader); return NULL; } else { return reader; } } MalVal *read_atom(Reader *reader) { char *token; GRegex *regex; GMatchInfo *matchInfo; GError *err = NULL; gint pos; MalVal *atom; token = reader_next(reader); //g_print("read_atom token: %s\n", token); regex = g_regex_new ("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)\"?$|:(.*)|(^[^\"]*$)", 0, 0, &err); g_regex_match (regex, token, 0, &matchInfo); if (g_match_info_fetch_pos(matchInfo, 1, &pos, NULL) && pos != -1) { //g_print("read_atom integer\n"); atom = malval_new_integer(g_ascii_strtoll(token, NULL, 10)); } else if (g_match_info_fetch_pos(matchInfo, 2, &pos, NULL) && pos != -1) { //g_print("read_atom float\n"); atom = malval_new_float(g_ascii_strtod(token, NULL)); } else if (g_match_info_fetch_pos(matchInfo, 3, &pos, NULL) && pos != -1) { //g_print("read_atom nil\n"); atom = &mal_nil; } else if (g_match_info_fetch_pos(matchInfo, 4, &pos, NULL) && pos != -1) { //g_print("read_atom true\n"); atom = &mal_true; } else if (g_match_info_fetch_pos(matchInfo, 5, &pos, NULL) && pos != -1) { //g_print("read_atom false\n"); atom = &mal_false; } else if (g_match_info_fetch_pos(matchInfo, 6, &pos, NULL) && pos != -1) { //g_print("read_atom string: %s\n", token); int end = strlen(token)-1; token[end] = '\0'; atom = malval_new_string(g_strcompress(g_match_info_fetch(matchInfo, 6))); } else if (g_match_info_fetch_pos(matchInfo, 7, &pos, NULL) && pos != -1) { abort("expected '\"', got EOF"); } else if (g_match_info_fetch_pos(matchInfo, 8, &pos, NULL) && pos != -1) { //g_print("read_atom keyword\n"); atom = malval_new_keyword(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 8))); } else if (g_match_info_fetch_pos(matchInfo, 9, &pos, NULL) && pos != -1) { //g_print("read_atom symbol\n"); atom = malval_new_symbol(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 9))); } else { malval_free(atom); atom = NULL; } return atom; } MalVal *read_list(Reader *reader, MalType type, char start, char end) { MalVal *ast, *form; char *token = reader_next(reader); //g_print("read_list start token: %s\n", token); if (token[0] != start) { abort("expected '(', '[', or '{'"); } ast = malval_new_list(type, g_array_new(TRUE, TRUE, sizeof(MalVal*))); while ((token = reader_peek(reader)) && token[0] != end) { //g_print("read_list internal token %s\n", token); form = read_form(reader); if (!form) { if (!mal_error) { abort("unknown read_list failure"); } g_array_free(ast->val.array, TRUE); malval_free(ast); return NULL; } g_array_append_val(ast->val.array, form); } if (!token) { abort("expected ')', ']', or '}', got EOF"); } reader_next(reader); //g_print("read_list end token: %s\n", token); return ast; } MalVal *read_hash_map(Reader *reader) { MalVal *lst = read_list(reader, MAL_LIST, '{', '}'); if (!lst) { return NULL; } MalVal *hm = _hash_map(lst); malval_free(lst); return hm; } MalVal *read_form(Reader *reader) { char *token; MalVal *form = NULL, *tmp; // while(token = reader_next(reader)) { // printf("token: %s\n", token); // } // return NULL; token = reader_peek(reader); if (!token) { return NULL; } //g_print("read_form token: %s\n", token); switch (token[0]) { case ';': abort("comments not yet implemented"); break; case '\'': reader_next(reader); form = _listX(2, malval_new_symbol("quote"), read_form(reader)); break; case '`': reader_next(reader); form = _listX(2, malval_new_symbol("quasiquote"), read_form(reader)); break; case '~': reader_next(reader); if (token[1] == '@') { form = _listX(2, malval_new_symbol("splice-unquote"), read_form(reader)); } else { form = _listX(2, malval_new_symbol("unquote"), read_form(reader)); }; break; case '^': reader_next(reader); MalVal *meta = read_form(reader); form = _listX(3, malval_new_symbol("with-meta"), read_form(reader), meta); break; case '@': reader_next(reader); form = _listX(2, malval_new_symbol("deref"), read_form(reader)); break; // list case ')': abort("unexpected ')'"); break; case '(': form = read_list(reader, MAL_LIST, '(', ')'); break; // vector case ']': abort("unexpected ']'"); break; case '[': form = read_list(reader, MAL_VECTOR, '[', ']'); break; // hash-map case '}': abort("unexpected '}'"); break; case '{': form = read_hash_map(reader); break; default: form = read_atom(reader); break; } return form; } MalVal *read_str (char *str) { Reader *reader; char *token; MalVal *ast = NULL; reader = tokenize(str); if (reader) { ast = read_form(reader); reader_free(reader); } return ast; } ================================================ FILE: impls/c/reader.h ================================================ #ifndef __MAL_READER__ #define __MAL_READER__ #include #include #include "types.h" typedef struct { GArray *array; int position; } Reader; Reader *reader_new(); int reader_append(Reader *reader, char* token); char *reader_peek(Reader *reader); char *reader_next(Reader *reader); void reader_free(Reader *reader); char *_readline (char prompt[]); MalVal *read_str (); #endif ================================================ FILE: impls/c/readline.c ================================================ #include #include #include #if USE_READLINE #include #include #include #else #include #endif int history_loaded = 0; char HISTORY_FILE[] = "~/.mal-history"; void load_history() { if (history_loaded) { return; } int ret; char *hf = tilde_expand(HISTORY_FILE); if (access(hf, F_OK) != -1) { // TODO: check if file exists first, use non-static path #if USE_READLINE ret = read_history(hf); #else FILE *fp = fopen(hf, "r"); char *line = malloc(80); // getline reallocs as necessary size_t sz = 80; while ((ret = getline(&line, &sz, fp)) > 0) { add_history(line); // Add line to in-memory history } free(line); fclose(fp); #endif history_loaded = 1; } free(hf); } void append_to_history() { char *hf = tilde_expand(HISTORY_FILE); #ifdef USE_READLINE append_history(1, hf); #else #if defined(RL_READLINE_VERSION) HIST_ENTRY *he = history_get(history_base+history_length-1); #else // libedit-2 segfaults if we add history_base HIST_ENTRY *he = history_get(history_length-1); #endif FILE *fp = fopen(hf, "a"); if (fp) { fprintf(fp, "%s\n", he->line); fclose(fp); } #endif free(hf); } // line must be freed by caller char *_readline (char prompt[]) { char *line; load_history(); line = readline(prompt); if (!line) return NULL; // EOF add_history(line); // Add input to in-memory history append_to_history(); // Flush new line of history to disk return line; } ================================================ FILE: impls/c/readline.h ================================================ #ifndef __MAL_READLINE__ #define __MAL_READLINE__ char *_readline (char prompt[]); #endif ================================================ FILE: impls/c/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/c/step0_repl.c ================================================ #include #include #include #ifdef USE_READLINE #include #include #else #include #endif char *READ(char prompt[]) { char *line; line = readline(prompt); if (!line) return NULL; // EOF add_history(line); // Add input to history. return line; } char *EVAL(char *ast, void *env) { return ast; } char *PRINT(char *exp) { return exp; } int main() { char *ast, *exp; char prompt[100]; // Set the initial prompt snprintf(prompt, sizeof(prompt), "user> "); for(;;) { ast = READ(prompt); if (!ast) return 0; exp = EVAL(ast, NULL); puts(PRINT(exp)); free(ast); // Free input string } } ================================================ FILE: impls/c/step1_read_print.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, GHashTable *env) { if (!ast || mal_error) return NULL; return ast; } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(GHashTable *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } int main() { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt snprintf(prompt, sizeof(prompt), "user> "); // repl loop for(;;) { exp = RE(NULL, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step2_eval.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" // Declarations MalVal *EVAL(MalVal *ast, GHashTable *env); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, GHashTable *env) { if (!ast || mal_error) return NULL; //g_print("EVAL: %s\n", _pr_str(ast,1)); if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); // TODO: check if not found MalVal *res = g_hash_table_lookup(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); //g_print("eval_invoke el: %s\n", _pr_str(el,1)); return f(_nth(el, 1), _nth(el, 2)); } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(GHashTable *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment GHashTable *repl_env; WRAP_INTEGER_OP(plus,+) WRAP_INTEGER_OP(minus,-) WRAP_INTEGER_OP(multiply,*) WRAP_INTEGER_OP(divide,/) void init_repl_env() { repl_env = g_hash_table_new(g_str_hash, g_str_equal); g_hash_table_insert(repl_env, "+", int_plus); g_hash_table_insert(repl_env, "-", int_minus); g_hash_table_insert(repl_env, "*", int_multiply); g_hash_table_insert(repl_env, "/", int_divide); } int main() { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(); // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step3_env.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); int i, len; if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); assert_type(a0, MAL_SYMBOL, "Cannot apply %s", _pr_str(a0,1)); if (strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if (strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } return EVAL(a2, let_env); } else { //g_print("eval apply\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); return f(_nth(el, 1), _nth(el, 2)); } } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; WRAP_INTEGER_OP(plus,+) WRAP_INTEGER_OP(minus,-) WRAP_INTEGER_OP(multiply,*) WRAP_INTEGER_OP(divide,/) void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); env_set(repl_env, "+", (MalVal *)int_plus); env_set(repl_env, "-", (MalVal *)int_minus); env_set(repl_env, "*", (MalVal *)int_multiply); env_set(repl_env, "/", (MalVal *)int_divide); } int main() { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(); // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step4_if_fn_do.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); int i, len; if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } return EVAL(a2, let_env); } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _rest(ast), env); return _last(el); } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { return EVAL(_nth(ast, 3), env); } else { return &mal_nil; } } else { // eval true slot form MalVal *a2 = _nth(ast, 2); return EVAL(a2, env); } } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); return _apply(f, args); } } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); } int main() { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(); // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step5_tco.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); int i, len; if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast) - 1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); } int main() { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(); // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step6_file.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); int i, len; if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } void init_repl_env(int argc, char *argv[]) { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); for (i=2; i < argc; i++) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); RE(repl_env, "", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); } int main(int argc, char *argv[]) { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(argc, argv); if (argc > 1) { char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); RE(repl_env, "", cmd); return 0; } // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step7_quote.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval 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) { switch (ast->type) { case MAL_LIST: if (starts_with(ast, "unquote")) return _nth(ast, 1); 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; } } MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); int i, len; if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); MalVal *a1 = _nth(ast, 1); ast = quasiquote(a1); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } void init_repl_env(int argc, char *argv[]) { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); for (i=2; i < argc; i++) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); RE(repl_env, "", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); } int main(int argc, char *argv[]) { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(argc, argv); if (argc > 1) { char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); RE(repl_env, "", cmd); return 0; } // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step8_macros.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval 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) { switch (ast->type) { case MAL_LIST: if (starts_with(ast, "unquote")) return _nth(ast, 1); 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; } } MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list if (_count(ast) == 0) { return ast; } int i, len; MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); MalVal *a1 = _nth(ast, 1); ast = quasiquote(a1); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("defmacro!", a0->val.string) == 0) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *old = EVAL(a2, env); if (mal_error) return NULL; MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); res->val.func = old->val.func; res->ismacro = TRUE; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->ismacro = FALSE; mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *f = EVAL(a0, env); if (!f || mal_error) { return NULL; } MalVal *rest = _rest(ast); if (f->ismacro) { ast = _apply(f, rest); continue; } MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } void init_repl_env(int argc, char *argv[]) { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); for (i=2; i < argc; i++) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); RE(repl_env, "", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE(repl_env, "", "(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)))))))"); } int main(int argc, char *argv[]) { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(argc, argv); if (argc > 1) { char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); RE(repl_env, "", cmd); return 0; } // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/step9_try.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" #include "interop.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval 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) { switch (ast->type) { case MAL_LIST: if (starts_with(ast, "unquote")) return _nth(ast, 1); 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; } } MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list if (_count(ast) == 0) { return ast; } int i, len; MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); MalVal *a1 = _nth(ast, 1); ast = quasiquote(a1); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("defmacro!", a0->val.string) == 0) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *old = EVAL(a2, env); if (mal_error) return NULL; MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); res->val.func = old->val.func; res->ismacro = TRUE; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("try*", a0->val.string) == 0) { //g_print("eval apply try*\n"); MalVal *a1 = _nth(ast, 1); MalVal *res = EVAL(a1, env); if (ast->val.array->len < 3) { return &mal_nil; } MalVal *a2 = _nth(ast, 2); if (!mal_error) { return res; } MalVal *a20 = _nth(a2, 0); if (strcmp("catch*", a20->val.string) == 0) { MalVal *a21 = _nth(a2, 1); MalVal *a22 = _nth(a2, 2); Env *catch_env = new_env(env, _listX(1, a21), _listX(1, mal_error)); //malval_free(mal_error); mal_error = NULL; res = EVAL(a22, catch_env); return res; } else { return &mal_nil; } } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->ismacro = FALSE; mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *f = EVAL(a0, env); if (!f || mal_error) { return NULL; } MalVal *rest = _rest(ast); if (f->ismacro) { ast = _apply(f, rest); continue; } MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } void init_repl_env(int argc, char *argv[]) { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); for (i=2; i < argc; i++) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); RE(repl_env, "", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE(repl_env, "", "(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)))))))"); } int main(int argc, char *argv[]) { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(argc, argv); if (argc > 1) { char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); RE(repl_env, "", cmd); return 0; } // repl loop for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/stepA_mal.c ================================================ #include #include #include #include #include "types.h" #include "readline.h" #include "reader.h" #include "core.h" #include "interop.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); // read MalVal *READ(char prompt[], char *str) { char *line; MalVal *ast; if (str) { line = str; } else { line = _readline(prompt); if (!line) { _error("EOF"); return NULL; } } ast = read_str(line); if (!str) { MAL_GC_FREE(line); } return ast; } // eval 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) { switch (ast->type) { case MAL_LIST: if (starts_with(ast, "unquote")) return _nth(ast, 1); 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; } } MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { if (!ast || mal_error) return NULL; MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { g_print("EVAL: %s\n", _pr_str(ast,1)); } if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); MalVal *res = env_get(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; } else if (ast->type == MAL_LIST) { // Proceed after this conditional. } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; el->type = ast->type; return el; } else if (ast->type == MAL_HASH_MAP) { //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); GHashTableIter iter; gpointer key, value; MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), _count(ast))); g_hash_table_iter_init (&iter, ast->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { MalVal *kname = malval_new_string((char *)key); g_array_append_val(seq->val.array, kname); MalVal *new_val = EVAL((MalVal *)value, env); g_array_append_val(seq->val.array, new_val); } return _hash_map(seq); } else { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } // apply list if (_count(ast) == 0) { return ast; } int i, len; MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && strcmp("def!", a0->val.string) == 0) { //g_print("eval apply def!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2), *key, *val; assert_type(a1, MAL_LIST|MAL_VECTOR, "let* bindings must be list or vector"); len = _count(a1); assert((len % 2) == 0, "odd number of let* bindings forms"); Env *let_env = new_env(env, NULL, NULL); for(i=0; ival.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); MalVal *a1 = _nth(ast, 1); ast = quasiquote(a1); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("defmacro!", a0->val.string) == 0) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); MalVal *old = EVAL(a2, env); if (mal_error) return NULL; MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); res->val.func = old->val.func; res->ismacro = TRUE; env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp(".", a0->val.string) == 0) { //g_print("eval apply .\n"); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)), env); if (!el || mal_error) return NULL; return invoke_native(el); } else if ((a0->type & MAL_SYMBOL) && strcmp("try*", a0->val.string) == 0) { //g_print("eval apply try*\n"); MalVal *a1 = _nth(ast, 1); MalVal *res = EVAL(a1, env); if (ast->val.array->len < 3) { return &mal_nil; } MalVal *a2 = _nth(ast, 2); if (!mal_error) { return res; } MalVal *a20 = _nth(a2, 0); if (strcmp("catch*", a20->val.string) == 0) { MalVal *a21 = _nth(a2, 1); MalVal *a22 = _nth(a2, 2); Env *catch_env = new_env(env, _listX(1, a21), _listX(1, mal_error)); //malval_free(mal_error); mal_error = NULL; res = EVAL(a22, catch_env); return res; } else { return &mal_nil; } } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { //g_print("eval apply if\n"); MalVal *a1 = _nth(ast, 1); MalVal *cond = EVAL(a1, env); if (!cond || mal_error) return NULL; if (cond->type & (MAL_FALSE|MAL_NIL)) { // eval false slot form if (ast->val.array->len > 3) { ast = _nth(ast, 3); } else { return &mal_nil; } } else { // eval true slot form ast = _nth(ast, 2); } // Continue loop } else if ((a0->type & MAL_SYMBOL) && strcmp("fn*", a0->val.string) == 0) { //g_print("eval apply fn*\n"); MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); mf->ismacro = FALSE; mf->val.func.evaluator = EVAL; mf->val.func.args = _nth(ast, 1); mf->val.func.body = _nth(ast, 2); mf->val.func.env = env; return mf; } else { //g_print("eval apply\n"); MalVal *f = EVAL(a0, env); if (!f || mal_error) { return NULL; } MalVal *rest = _rest(ast); if (f->ismacro) { ast = _apply(f, rest); continue; } MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { ast = f->val.func.body; env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { return _apply(f, args); } } } // TCO while loop } // print char *PRINT(MalVal *exp) { if (mal_error) { return NULL; } return _pr_str(exp,1); } // repl // read and eval MalVal *RE(Env *env, char *prompt, char *str) { MalVal *ast, *exp; ast = READ(prompt, str); if (!ast || mal_error) return NULL; exp = EVAL(ast, env); if (ast != exp) { malval_free(ast); // Free input structure } return exp; } // Setup the initial REPL environment Env *repl_env; MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } void init_repl_env(int argc, char *argv[]) { repl_env = new_env(NULL, NULL, NULL); // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); for (i=2; i < argc; i++) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! *host-language* \"c\")"); RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); RE(repl_env, "", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE(repl_env, "", "(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)))))))"); } int main(int argc, char *argv[]) { MalVal *exp; char *output; char prompt[100]; MAL_GC_SETUP(); // Set the initial prompt and environment snprintf(prompt, sizeof(prompt), "user> "); init_repl_env(argc, argv); if (argc > 1) { char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); RE(repl_env, "", cmd); return 0; } // repl loop RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); for(;;) { exp = RE(repl_env, prompt, NULL); if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { return 0; } output = PRINT(exp); if (mal_error) { fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); malval_free(mal_error); mal_error = NULL; } else if (output) { puts(output); MAL_GC_FREE(output); // Free output string } //malval_free(exp); // Free evaluated expression } } ================================================ FILE: impls/c/tests/step5_tco.mal ================================================ ;; C: skipping non-TCO recursion ;; Reason: segfaults (unrecoverable) ================================================ FILE: impls/c/tests/stepA_mal.mal ================================================ ;; Testing FFI of "strlen" (. nil "int32" "strlen" "string" "abcde") ;=>5 (. nil "int32" "strlen" "string" "") ;=>0 ;; Testing FFI of "strcmp" (. nil "int32" "strcmp" "string" "abc" "string" "abcA") ;=>-65 (. nil "int32" "strcmp" "string" "abcA" "string" "abc") ;=>65 (. nil "int32" "strcmp" "string" "abc" "string" "abc") ;=>0 ;; Testing FFI of "pow" (libm.so) (. "libm.so" "double" "pow" "double" 2.0 "double" 3.0) ;=>8.000000 (. "libm.so" "double" "pow" "double" 3.0 "double" 2.0) ;=>9.000000 ================================================ FILE: impls/c/types.c ================================================ #include #include #include #include #include "types.h" #include "printer.h" #ifdef USE_GC void nop_free(void* ptr) { (void)ptr; // Unused argument } static GMemVTable gc_gmem_vtable = { .malloc = GC_malloc, .realloc = GC_realloc, .free = nop_free, .calloc = NULL, .try_malloc = NULL, .try_realloc = NULL }; void GC_setup() { GC_INIT(); setenv("G_SLICE", "always-malloc", 1); g_mem_gc_friendly = TRUE; g_mem_set_vtable(&gc_gmem_vtable); } char* GC_strdup(const char *src) { if (!src) { return NULL; } char* dst = (char*)MAL_GC_MALLOC(strlen(src) + 1); strcpy(dst, src); return dst; } #endif // Errors/Exceptions MalVal *mal_error = NULL; // WARNGIN: global state void _error(const char *fmt, ...) { va_list args; va_start(args, fmt); mal_error = malval_new_string(g_strdup_vprintf(fmt, args)); } // Constant atomic values MalVal mal_nil = {MAL_NIL, NULL, {0}, 0}; MalVal mal_true = {MAL_TRUE, NULL, {0}, 0}; MalVal mal_false = {MAL_FALSE, NULL, {0}, 0}; // General Functions // Print a hash table #include void g_hash_table_print(GHashTable *hash_table) { GHashTableIter iter; gpointer key, value; g_hash_table_iter_init (&iter, hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { g_print ("%s/%p ", (const char *) key, (void *) value); //g_print ("%s ", (const char *) key); } } GHashTable *g_hash_table_copy(GHashTable *src_table) { GHashTable *new_table = g_hash_table_new(g_str_hash, g_str_equal); GHashTableIter iter; gpointer key, value; g_hash_table_iter_init (&iter, src_table); while (g_hash_table_iter_next (&iter, &key, &value)) { g_hash_table_insert(new_table, key, value); } return new_table; } int min(int a, int b) { return a < b ? a : b; } int max(int a, int b) { return a > b ? a : b; } int _count(MalVal *obj) { switch (obj->type) { case MAL_NIL: return 0; case MAL_LIST: return obj->val.array->len; case MAL_VECTOR: return obj->val.array->len; case MAL_HASH_MAP: return g_hash_table_size(obj->val.hash_table); case MAL_STRING: return strlen(obj->val.string); default: _error("count unsupported for type %d\n", obj->type); return 0; } } // Allocate a malval and set its type and value MalVal *malval_new(MalType type, MalVal *metadata) { MalVal *mv = (MalVal*)MAL_GC_MALLOC(sizeof(MalVal)); mv->type = type; mv->metadata = metadata; return mv; } void malval_free(MalVal *mv) { // TODO: free collection items if (!(mv->type & (MAL_NIL|MAL_TRUE|MAL_FALSE))) { MAL_GC_FREE(mv); } } MalVal *malval_new_integer(gint64 val) { MalVal *mv = malval_new(MAL_INTEGER, NULL); mv->val.intnum = val; return mv; } MalVal *malval_new_float(gdouble val) { MalVal *mv = malval_new(MAL_FLOAT, NULL); mv->val.floatnum = val; return mv; } MalVal *malval_new_string(char *val) { MalVal *mv = malval_new(MAL_STRING, NULL); mv->val.string = val; return mv; } MalVal *malval_new_symbol(char *val) { MalVal *mv = malval_new(MAL_SYMBOL, NULL); mv->val.string = val; return mv; } MalVal *malval_new_keyword(char *val) { MalVal *mv = malval_new(MAL_STRING, NULL); mv->val.string = g_strdup_printf("\x7f%s", val); return mv; } MalVal *malval_new_list(MalType type, GArray *val) { MalVal *mv = malval_new(type, NULL); mv->val.array = val; return mv; } MalVal *malval_new_hash_map(GHashTable *val) { MalVal *mv = malval_new(MAL_HASH_MAP, NULL); mv->val.hash_table = val; return mv; } MalVal *malval_new_atom(MalVal *val) { MalVal *mv = malval_new(MAL_ATOM, NULL); mv->val.atom_val = val; return mv; } MalVal *malval_new_function(void *(*func)(void *), int arg_cnt) { MalVal *mv = malval_new(MAL_FUNCTION_C, NULL); mv->func_arg_cnt = arg_cnt; assert(mv->func_arg_cnt <= 20, "native function restricted to 20 args (%d given)", mv->func_arg_cnt); mv->ismacro = FALSE; switch (arg_cnt) { case -1: mv->val.f1 = (void *(*)(void*))func; break; case 0: mv->val.f0 = (void *(*)())func; break; case 1: mv->val.f1 = (void *(*)(void*))func; break; case 2: mv->val.f2 = (void *(*)(void*,void*))func; break; case 3: mv->val.f3 = (void *(*)(void*,void*,void*))func; break; case 4: mv->val.f4 = (void *(*)(void*,void*,void*,void*))func; break; case 5: mv->val.f5 = (void *(*)(void*,void*,void*,void*,void*))func; break; case 6: mv->val.f6 = (void *(*)(void*,void*,void*,void*,void*, void*))func; break; case 7: mv->val.f7 = (void *(*)(void*,void*,void*,void*,void*, void*,void*))func; break; case 8: mv->val.f8 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*))func; break; case 9: mv->val.f9 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*))func; break; case 10: mv->val.f10 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*))func; break; case 11: mv->val.f11 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*))func; break; case 12: mv->val.f12 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*))func; break; case 13: mv->val.f13 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*))func; break; case 14: mv->val.f14 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*))func; break; case 15: mv->val.f15 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*))func; break; case 16: mv->val.f16 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*))func; break; case 17: mv->val.f17 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*))func; break; case 18: mv->val.f18 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*))func; break; case 19: mv->val.f19 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*))func; break; case 20: mv->val.f20 = (void *(*)(void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*, void*,void*,void*,void*,void*))func; break; } return mv; } MalVal *_apply(MalVal *f, MalVal *args) { MalVal *res; assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "Cannot invoke %s", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { Env *fn_env = new_env(f->val.func.env, f->val.func.args, args); res = f->val.func.evaluator(f->val.func.body, fn_env); return res; } else { MalVal *a = args; assert((f->func_arg_cnt == -1) || (f->func_arg_cnt == _count(args)), "Length of formal params (%d) does not match actual parameters (%d)", f->func_arg_cnt, _count(args)); switch (f->func_arg_cnt) { case -1: res=f->val.f1 (a); break; case 0: res=f->val.f0 (); break; case 1: res=f->val.f1 (_nth(a,0)); break; case 2: res=f->val.f2 (_nth(a,0),_nth(a,1)); break; case 3: res=f->val.f3 (_nth(a,0),_nth(a,1),_nth(a,2)); break; case 4: res=f->val.f4 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3)); break; case 5: res=f->val.f5 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4)); break; case 6: res=f->val.f6 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5)); break; case 7: res=f->val.f7 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6)); break; case 8: res=f->val.f8 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7)); break; case 9: res=f->val.f9 (_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8)); break; case 10: res=f->val.f10(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9)); break; case 11: res=f->val.f11(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10)); break; case 12: res=f->val.f12(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11)); break; case 13: res=f->val.f13(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12)); break; case 14: res=f->val.f14(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13)); break; case 15: res=f->val.f15(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14)); break; case 16: res=f->val.f16(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), _nth(a,15)); break; case 17: res=f->val.f17(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), _nth(a,15),_nth(a,16)); break; case 18: res=f->val.f18(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), _nth(a,15),_nth(a,16),_nth(a,17)); break; case 19: res=f->val.f19(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18)); break; case 20: res=f->val.f20(_nth(a,0),_nth(a,1),_nth(a,2),_nth(a,3),_nth(a,4), _nth(a,5),_nth(a,6),_nth(a,7),_nth(a,8),_nth(a,9), _nth(a,10),_nth(a,11),_nth(a,12),_nth(a,13),_nth(a,14), _nth(a,15),_nth(a,16),_nth(a,17),_nth(a,18),_nth(a,19)); break; } return res; } } int _equal_Q(MalVal *a, MalVal *b) { GHashTableIter iter; gpointer key, value; if (a == NULL || b == NULL) { return FALSE; } // If types are the same or both are sequential then they might be equal if (!((a->type == b->type) || (_sequential_Q(a) && _sequential_Q(b)))) { return FALSE; } switch (a->type) { case MAL_NIL: case MAL_TRUE: case MAL_FALSE: return a->type == b->type; case MAL_INTEGER: return a->val.intnum == b->val.intnum; case MAL_FLOAT: return a->val.floatnum == b->val.floatnum; case MAL_SYMBOL: case MAL_STRING: if (strcmp(a->val.string, b->val.string) == 0) { return TRUE; } else { return FALSE; } case MAL_LIST: case MAL_VECTOR: if (a->val.array->len != b->val.array->len) { return FALSE; } int i; for (i=0; ival.array->len; i++) { if (! _equal_Q(g_array_index(a->val.array, MalVal*, i), g_array_index(b->val.array, MalVal*, i))) { return FALSE; } } return TRUE; case MAL_HASH_MAP: if (g_hash_table_size(a->val.hash_table) != g_hash_table_size(b->val.hash_table)) { return FALSE; } g_hash_table_iter_init (&iter, a->val.hash_table); while (g_hash_table_iter_next (&iter, &key, &value)) { if (!g_hash_table_contains(b->val.hash_table, key)) { return FALSE; } MalVal *aval = (MalVal *) g_hash_table_lookup(a->val.hash_table, key); MalVal *bval = (MalVal *) g_hash_table_lookup(b->val.hash_table, key); if (!_equal_Q(aval, bval)) { return FALSE; } } return TRUE; case MAL_FUNCTION_C: case MAL_FUNCTION_MAL: return a->val.f0 == b->val.f0; default: _error("_equal_Q unsupported comparison type %d\n", a->type); return FALSE; } } // Lists MalVal *_listX(int count, ...) { MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), count)); MalVal *v; va_list ap; va_start(ap, count); while (count-- > 0) { v = va_arg(ap, MalVal*); g_array_append_val(seq->val.array, v); } va_end(ap); return seq; } MalVal *_list(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "list called with invalid arguments"); args->type = MAL_LIST; return args; } int _list_Q(MalVal *seq) { return seq->type & MAL_LIST; } // Vectors MalVal *_vector(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "vector called with invalid arguments"); args->type = MAL_VECTOR; return args; } int _vector_Q(MalVal *seq) { return seq->type & MAL_VECTOR; } // Hash maps MalVal *_hash_map(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "hash-map called with non-sequential arguments"); GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); MalVal *hm = malval_new_hash_map(htable); return _assoc_BANG(hm, args); } int _hash_map_Q(MalVal *seq) { return seq->type & MAL_HASH_MAP; } MalVal *_assoc_BANG(MalVal* hm, MalVal *args) { assert((_count(args) % 2) == 0, "odd number of parameters to assoc!"); GHashTable *htable = hm->val.hash_table; int i; MalVal *k, *v; for (i=0; i<_count(args); i+=2) { k = g_array_index(args->val.array, MalVal*, i); assert_type(k, MAL_STRING, "assoc! called with non-string key"); v = g_array_index(args->val.array, MalVal*, i+1); g_hash_table_insert(htable, k->val.string, v); } return hm; } MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) { GHashTable *htable = hm->val.hash_table; int i; MalVal *k, *v; for (i=0; i<_count(args); i++) { k = g_array_index(args->val.array, MalVal*, i); assert_type(k, MAL_STRING, "dissoc! called with non-string key"); g_hash_table_remove(htable, k->val.string); } return hm; } // Atoms int _atom_Q(MalVal *exp) { return exp->type & MAL_ATOM; } // Sequence functions MalVal *_slice(MalVal *seq, int start, int end) { int i, new_len = max(0, min(end-start, _count(seq)-start)); GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), new_len); for (i=start; ival.array, MalVal*, i)); } return malval_new_list(MAL_LIST, new_arr); } int _sequential_Q(MalVal *seq) { return seq->type & (MAL_LIST|MAL_VECTOR); } MalVal *_nth(MalVal *seq, int idx) { assert_type(seq, MAL_LIST|MAL_VECTOR, "_nth called with non-sequential"); if (idx >= _count(seq)) { abort("nth: index out of range"); } return g_array_index(seq->val.array, MalVal*, idx); } MalVal *_first(MalVal *seq) { assert_type(seq, MAL_NIL|MAL_LIST|MAL_VECTOR, "_first called with non-sequential"); if (_count(seq) == 0) { return &mal_nil; } return g_array_index(seq->val.array, MalVal*, 0); } MalVal *_last(MalVal *seq) { assert_type(seq, MAL_LIST|MAL_VECTOR, "_last called with non-sequential"); if (_count(seq) == 0) { return &mal_nil; } return g_array_index(seq->val.array, MalVal*, _count(seq)-1); } MalVal *_rest(MalVal *seq) { return _slice(seq, 1, _count(seq)); } MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) { MalVal *e, *el; assert_type(lst, MAL_LIST|MAL_VECTOR, "_map called with non-sequential"); int i, len = _count(lst); el = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); for (i=0; ival.array, MalVal*, i), arg2); if (!e || mal_error) return NULL; g_array_append_val(el->val.array, e); } return el; } ================================================ FILE: impls/c/types.h ================================================ #ifndef __MAL_TYPES__ #define __MAL_TYPES__ #include #ifdef USE_GC #include void nop_free(void* ptr); void GC_setup(); char* GC_strdup(const char *src); #define MAL_GC_SETUP() GC_setup() #define MAL_GC_MALLOC GC_MALLOC #define MAL_GC_FREE nop_free #define MAL_GC_STRDUP GC_strdup #else #include #define MAL_GC_SETUP() #define MAL_GC_MALLOC malloc #define MAL_GC_FREE free #define MAL_GC_STRDUP strdup #endif struct MalVal; // pre-declare // Env (implentation in env.c) typedef struct Env { struct Env *outer; GHashTable *table; } Env; Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs); struct MalVal *env_get(Env *env, const char *key); // Returns NULL if the key is missing. void env_set(Env *env, char *key, struct MalVal *val); // Utility functiosn void g_hash_table_print(GHashTable *hash_table); GHashTable *g_hash_table_copy(GHashTable *src_table); // Errors/exceptions extern struct MalVal *mal_error; void _error(const char *fmt, ...); #define abort(format, ...) \ { _error(format, ##__VA_ARGS__); return NULL; } #define assert(test, format, ...) \ if (!(test)) { \ _error(format, ##__VA_ARGS__); \ return NULL; \ } #define assert_type(mv, typ, format, ...) \ if (!(mv->type & (typ))) { \ _error(format, ##__VA_ARGS__); \ return NULL; \ } typedef enum { MAL_NIL = 1, MAL_TRUE = 2, MAL_FALSE = 4, MAL_INTEGER = 8, MAL_FLOAT = 16, MAL_SYMBOL = 32, MAL_STRING = 64, MAL_LIST = 128, MAL_VECTOR = 256, MAL_HASH_MAP = 512, MAL_ATOM = 1024, MAL_FUNCTION_C = 2048, MAL_FUNCTION_MAL = 4096, } MalType; typedef struct MalVal { MalType type; struct MalVal *metadata; union { gint64 intnum; gdouble floatnum; char *string; GArray *array; GHashTable *hash_table; struct MalVal *atom_val; void *(*f0) (); void *(*f1) (void*); void *(*f2) (void*,void*); void *(*f3) (void*,void*,void*); void *(*f4) (void*,void*,void*,void*); void *(*f5) (void*,void*,void*,void*,void*); void *(*f6) (void*,void*,void*,void*,void*,void*); void *(*f7) (void*,void*,void*,void*,void*,void*,void*); void *(*f8) (void*,void*,void*,void*,void*,void*,void*,void*); void *(*f9) (void*,void*,void*,void*,void*,void*,void*,void*,void*); void *(*f10)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); void *(*f11)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*); void *(*f12)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*); void *(*f13)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*); void *(*f14)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*); void *(*f15)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*); void *(*f16)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*,void*); void *(*f17)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*,void*,void*); void *(*f18)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*,void*,void*,void*); void *(*f19)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*,void*,void*,void*,void*); void *(*f20)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*, void*,void*,void*,void*,void*,void*,void*,void*,void*,void*); struct { struct MalVal *(*evaluator)(struct MalVal *, Env *); struct MalVal *args; struct MalVal *body; struct Env *env; } func; } val; int func_arg_cnt; int ismacro; } MalVal; // Constants extern MalVal mal_nil; extern MalVal mal_true; extern MalVal mal_false; // Declare functions used internally (by other C code). // Mal visible functions are "exported" in types_ns MalVal *malval_new(MalType type, MalVal *metadata); void malval_free(MalVal *mv); MalVal *malval_new_integer(gint64 val); MalVal *malval_new_float(gdouble val); MalVal *malval_new_string(char *val); MalVal *malval_new_symbol(char *val); MalVal *malval_new_keyword(char *val); MalVal *malval_new_list(MalType type, GArray *val); MalVal *malval_new_hash_map(GHashTable *val); MalVal *malval_new_atom(MalVal *val); MalVal *malval_new_function(void *(*func)(void *), int arg_cnt); // Numbers #define WRAP_INTEGER_OP(name, op) \ static MalVal *int_ ## name(MalVal *a, MalVal *b) { \ return malval_new_integer(a->val.intnum op b->val.intnum); \ } #define WRAP_INTEGER_CMP_OP(name, op) \ static MalVal *int_ ## name(MalVal *a, MalVal *b) { \ return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \ } // Collections MalVal *_listX(int count, ...); MalVal *_list(MalVal *args); MalVal *_vector(MalVal *args); MalVal *_hash_map(MalVal *args); MalVal *_assoc_BANG(MalVal* hm, MalVal *args); MalVal *_dissoc_BANG(MalVal* hm, MalVal *args); MalVal *_apply(MalVal *f, MalVal *el); char *_pr_str(MalVal *args, int print_readably); MalVal *_slice(MalVal *seq, int start, int end); MalVal *_nth(MalVal *seq, int idx); MalVal *_first(MalVal *seq); MalVal *_rest(MalVal *seq); MalVal *_last(MalVal *seq); int _count(MalVal *obj); int _atom_Q(MalVal *exp); int _sequential_Q(MalVal *seq); int _list_Q(MalVal *seq); int _vector_Q(MalVal *seq); int _hash_map_Q(MalVal *seq); int _equal_Q(MalVal *a, MalVal *b); MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2); #endif ================================================ FILE: impls/c.2/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Duncan Watts ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Install gcc RUN apt-get -y install gcc # Libraries needed for the C impl RUN apt-get -y install libffi-dev libgc-dev libedit-dev pkgconf ================================================ FILE: impls/c.2/Makefile ================================================ CC = gcc CFLAGS = -std=c99 -g -Wall -Wextra -fanalyzer # The code defines new format specifiers. CPPFLAGS = -Wno-format ifdef debug_reader CPPFLAGS += -DDEBUG_READER endif ifdef debug_hash CPPFLAGS += -DDEBUG_HASH endif ifdef debug_hashmap CPPFLAGS += -DDEBUG_HASHMAP endif ifdef debug_hash_collisions CPPFLAGS += -DDEBUG_HASH_COLLISIONS endif ifndef no_fast CFLAGS += -flto -O3 -DNDEBUG LDFLAGS += -flto endif ifdef profile CFLAGS += -pg LDFLAGS += -pg endif ifdef readline pkgconfig_modules += readline CFLAGS += -DUSE_READLINE else pkgconfig_modules += libedit endif ifndef no_ffi pkgconfig_modules += libffi CFLAGS += -DWITH_FFI endif pkgconfig_modules += bdw-gc CFLAGS += $(shell pkg-config --cflags $(pkgconfig_modules)) LDLIBS += $(shell pkg-config --libs $(pkgconfig_modules)) S0 = step0_repl S1 = step1_read_print S2 = step2_eval S3 = step3_env S4 = step4_if_fn_do S5 = step5_tco S6 = step6_file S7 = step7_quote S8 = step8_macros S9 = step9_try SA = stepA_mal S4+ := $(S4) $(S5) $(S6) $(S7) $(S8) $(S9) $(SA) S3+ := $(S3) $(S4+) S1+ := $(S1) $(S2) $(S3+) S0+ := $(S0) $(S1+) all: $(S0+) # GCC could create temporary objects files, but separate recipes for # .o objects give faster build cycles when debugging. $(S0+): readline.o $(S1+): error.o hashmap.o linked_list.o printer.o reader.o types.o vector.o $(S3+): env.o $(S4+): core.o include deps deps: $(CC) -MM -MF- *.c > $@ clean: rm -f $(S0+) *.o deps gmon.out .PHONY: all clean ================================================ FILE: impls/c.2/README ================================================ make -Cimpls/c.2/ clean make -Cimpls/c.2/ no_fast=1 make test^c.2 HARD=1 REGRESS=1 make test^mal HARD=1 MAL_IMPL=c.2 make -Cimpls/c.2/ clean make -Cimpls/c.2/ make perf^c.2 make -Cimpls/c.2/ clean make -Cimpls/c.2/ stepA_mal profile=1 make perf^c.2 (cd impls/c.2/ && gprof stepA_mal | less) ================================================ FILE: impls/c.2/core.c ================================================ #include #include #include #include #include #include /* only needed for ffi */ #ifdef WITH_FFI #include #include #endif #include "hashmap.h" #include "core.h" #include "printer.h" #include "reader.h" #include "error.h" #include "linked_list.h" #include "readline.h" #include "vector.h" /* forward references to main file */ MalType apply(MalType fn, list args); // Helper functions MalType make_boolean(bool); /* core ns functions */ MalType mal_add(list); MalType mal_sub(list); MalType mal_mul(list); MalType mal_div(list); MalType mal_prn(list); MalType mal_println(list); MalType mal_pr_str(list); MalType mal_str(list); MalType mal_read_string(list); MalType mal_slurp(list); MalType mal_list_questionmark(list); MalType mal_empty_questionmark(list); MalType mal_count(list); MalType mal_cons(list); MalType mal_concat(list); MalType mal_nth(list); MalType mal_first(list); MalType mal_rest(list); MalType mal_equals(list); MalType mal_lessthan(list); MalType mal_lessthanorequalto(list); MalType mal_greaterthan(list); MalType mal_greaterthanorequalto(list); MalType mal_atom(list); MalType mal_atom_questionmark(list); MalType mal_deref(list); MalType mal_reset_bang(list); MalType mal_swap_bang(list); MalType mal_throw(list); MalType mal_apply(list); MalType mal_map(list); MalType mal_nil_questionmark(list); MalType mal_true_questionmark(list); MalType mal_false_questionmark(list); MalType mal_symbol_questionmark(list); MalType mal_keyword_questionmark(list); MalType mal_symbol(list); MalType mal_keyword(list); MalType mal_vec(list); MalType mal_vector(list); MalType mal_vector_questionmark(list); MalType mal_sequential_questionmark(list); MalType mal_hash_map(list); MalType mal_map_questionmark(list); MalType mal_assoc(list); MalType mal_dissoc(list); MalType mal_get(list); MalType mal_contains_questionmark(list); MalType mal_keys(list); MalType mal_vals(list); MalType mal_string_questionmark(list); MalType mal_number_questionmark(list); MalType mal_fn_questionmark(list); MalType mal_macro_questionmark(list); MalType mal_time_ms(list); MalType mal_conj(list); MalType mal_seq(list); MalType mal_meta(list); MalType mal_with_meta(list); MalType mal_readline(list); /* only needed for ffi */ #ifdef WITH_FFI MalType mal_dot(list); #endif struct ns_s THE_CORE_NS[] = { /* arithmetic */ { "+", mal_add }, { "-", mal_sub }, { "*", mal_mul }, { "/", mal_div }, /* strings */ { "prn", mal_prn }, { "pr-str", mal_pr_str }, { "str", mal_str }, { "println", mal_println }, { "read-string", mal_read_string }, /* files */ { "slurp", mal_slurp }, /* lists */ { "list", make_list }, { "empty?", mal_empty_questionmark }, { "count", mal_count }, { "cons", mal_cons }, { "concat", mal_concat }, { "nth", mal_nth }, { "first", mal_first }, { "rest", mal_rest }, /* predicates */ { "=", mal_equals }, { "<", mal_lessthan }, { "<=", mal_lessthanorequalto }, { ">", mal_greaterthan }, { ">=", mal_greaterthanorequalto }, { "list?", mal_list_questionmark }, { "nil?", mal_nil_questionmark }, { "true?", mal_true_questionmark }, { "false?", mal_false_questionmark }, { "symbol?", mal_symbol_questionmark }, { "keyword?", mal_keyword_questionmark }, { "vector?", mal_vector_questionmark }, { "sequential?", mal_sequential_questionmark }, { "map?", mal_map_questionmark }, { "string?", mal_string_questionmark }, { "number?", mal_number_questionmark }, { "fn?", mal_fn_questionmark }, { "macro?", mal_macro_questionmark }, /* atoms */ { "atom", mal_atom }, { "atom?", mal_atom_questionmark }, { "deref", mal_deref }, { "reset!", mal_reset_bang }, { "swap!", mal_swap_bang }, /* other */ { "throw", mal_throw }, { "apply", mal_apply }, { "map", mal_map }, { "symbol", mal_symbol }, { "keyword", mal_keyword }, { "vec", mal_vec }, { "vector", mal_vector }, { "hash-map", mal_hash_map }, /* hash-maps */ { "contains?", mal_contains_questionmark }, { "assoc", mal_assoc }, { "dissoc", mal_dissoc }, { "get", mal_get }, { "keys", mal_keys }, { "vals", mal_vals }, /* misc */ { "time-ms", mal_time_ms }, { "conj", mal_conj }, { "seq", mal_seq }, { "meta", mal_meta }, { "with-meta", mal_with_meta }, { "readline", mal_readline }, /* only needed for ffi */ #ifdef WITH_FFI { ".", mal_dot }, #endif }; void ns_make_core(ns* core, size_t* size) { *core = THE_CORE_NS; *size = sizeof(THE_CORE_NS) / sizeof(struct ns_s); } /* core function definitons */ #define generic_arithmetic(name, op, iconst, fconst) \ MalType name(list args) { \ explode2(#op, args, a1, a2); \ long i1, i2; \ double f1, f2; \ if (is_integer(a1, &i1)) { \ if (is_integer(a2, &i2)) return iconst(i1 op i2); \ if (is_float (a2, &f2)) return fconst(i1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ if (is_float(a1, &f1)) { \ if (is_integer(a2, &i2)) return iconst(f1 op i2); \ if (is_float (a2, &f2)) return fconst(f1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ } generic_arithmetic(mal_add, +, make_integer, make_float) generic_arithmetic(mal_sub, -, make_integer, make_float) generic_arithmetic(mal_mul, *, make_integer, make_float) generic_arithmetic(mal_div, /, make_integer, make_float) generic_arithmetic(mal_lessthan, <, make_boolean, make_boolean) generic_arithmetic(mal_lessthanorequalto, <=, make_boolean, make_boolean) generic_arithmetic(mal_greaterthan, >, make_boolean, make_boolean) generic_arithmetic(mal_greaterthanorequalto, >=, make_boolean, make_boolean) #define generic_type_predicate(name, mask) \ MalType mal_##name##_questionmark(list args) { \ explode1(#name "?", args, val); \ return make_boolean(type(val) & (mask)); \ } generic_type_predicate(list, MALTYPE_LIST) generic_type_predicate(atom, MALTYPE_ATOM) generic_type_predicate(nil, MALTYPE_NIL) generic_type_predicate(true, MALTYPE_TRUE) generic_type_predicate(false, MALTYPE_FALSE) generic_type_predicate(symbol, MALTYPE_SYMBOL) generic_type_predicate(keyword, MALTYPE_KEYWORD) generic_type_predicate(vector, MALTYPE_VECTOR) generic_type_predicate(sequential, MALTYPE_LIST | MALTYPE_VECTOR) generic_type_predicate(map, MALTYPE_HASHMAP) generic_type_predicate(string, MALTYPE_STRING) generic_type_predicate(number, MALTYPE_FLOAT | MALTYPE_INTEGER) generic_type_predicate(fn, MALTYPE_CLOSURE | MALTYPE_FUNCTION) generic_type_predicate(macro, MALTYPE_MACRO) MalType mal_equals(list args) { /* Accepts any type of arguments */ explode2("=", args, first_val, second_val); return make_boolean(equal_forms(first_val, second_val)); } MalType mal_nth(list args) { explode2("nth", args, lst, n); vector_t v; list l; long idx; if (!is_integer(n, &idx)) { bad_type("nth", MALTYPE_INTEGER, n); } if(idx < 0) { make_error("'nth': negative index: %d", idx); } if (is_list(lst, &l)) { while(l) { if(!idx) return l->data; l = l->next; idx--; } } else if ((v = is_vector(lst))) { if ((size_t)idx < v->count) { return v->nth[idx]; } } else { bad_type("nth", MALTYPE_LIST | MALTYPE_VECTOR, lst); } make_error("'nth': index %M out of bounds for: %M", n, lst); } MalType mal_first(list args) { explode1("first", args, lst); list result; vector_t v; if(is_nil(lst)) { return make_nil(); } else if ((v = is_vector(lst))) { return v->count ? v->nth[0] : make_nil(); } else if (!is_list(lst, &result)) { bad_type("first", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); } if (result) { return result->data; } else { return make_nil(); } } MalType mal_rest(list args) { explode1("rest", args, lst); list result = NULL; vector_t v; if(is_nil(lst)) { return make_list(NULL); } else if ((v = is_vector(lst))) { for (size_t i = v->count; 1 < i--; ) { result = list_push(result, v->nth[i]); } return make_list(result); } else if (!is_list(lst, &result)) { bad_type("rest", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); } if (result) { result = result->next; } return make_list(result); } MalType mal_cons(list args) { explode2("cons", args, a1, lst); list result = NULL; vector_t v; if ((v = is_vector(lst))) { for (size_t i = v->count; i--; ) { result = list_push(result, v->nth[i]); } } else if (is_list(lst, &result)) { } else if (is_nil(lst)) { } else { bad_type("cons", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL, lst); } return make_list(list_push(result, a1)); } MalType mal_concat(list args) { // Could reuse the last if it is not nil... list new_list = NULL; list* new_list_last = &new_list; while (args) { MalType val = args->data; /* skip nils */ if (is_nil(val)) { } /* concatenate lists and vectors */ else if (type(val) & (MALTYPE_LIST | MALTYPE_VECTOR)) { for (seq_cursor lst = seq_iter(val); seq_cont(val, lst); lst = seq_next(val, lst)) { *new_list_last = list_push(NULL, seq_item(val, lst)); new_list_last = &(*new_list_last)->next; } } /* raise an error for any non-sequence types */ else { bad_type("concat", MALTYPE_NIL | MALTYPE_LIST | MALTYPE_VECTOR, val); } args = args->next; } return make_list(new_list); } MalType mal_count(list args) { explode1("count", args, val); vector_t v; list mal_list; if(is_nil(val)) { return make_integer(0); } else if ((v = is_vector(val))) { return make_integer(v->count); } else if (!is_list(val, &mal_list)) { bad_type("count", MALTYPE_LIST | MALTYPE_NIL | MALTYPE_VECTOR, val); } return make_integer((long)list_count(mal_list)); } MalType mal_empty_questionmark(list args) { explode1("empty?", args, val); vector_t v; list l; if ((v = is_vector(val))) { return make_boolean(!v->count); } else if (is_list(val, &l)) { return make_boolean(!l); } else { bad_type("empty?", MALTYPE_LIST | MALTYPE_VECTOR, val); } } MalType mal_pr_str(list args) { /* Accepts any number and type of arguments */ return make_string(mal_printf("%N", args)); } MalType mal_str(list args) { /* Accepts any number and type of arguments */ return make_string(mal_printf("%# N", args)); } MalType mal_prn(list args) { /* Accepts any number and type of arguments */ printf("%N\n", args); return make_nil(); } MalType mal_println(list args) { /* Accepts any number and type of arguments */ printf("%#N\n", args); return make_nil(); } MalType mal_read_string(list args) { explode1("read-string", args, val); const char* s = is_string(val); if (!s) { bad_type("read-string", MALTYPE_STRING, val); } return read_str(s); // Implicit error propagation } MalType mal_slurp(list args) { explode1("slurp", args, a1); const char* filename = is_string(a1); if (!filename) { bad_type("slurp", MALTYPE_STRING, a1); } FILE* file = fopen(filename, "rb"); if (!file){ make_error("'slurp': file not found '%s'", filename); } fseek(file, 0, SEEK_END); size_t file_length = ftell(file); fseek(file, 0, SEEK_SET); char* buffer = (char*)GC_MALLOC(sizeof(*buffer) * file_length + 1); size_t read = fread(buffer, sizeof(*buffer), file_length, file); // close before raising an exception fclose(file); if (file_length != read) { make_error("'slurp': failed to read file '%s'", filename); } buffer[file_length] = '\0'; return make_string(buffer); } MalType mal_atom(list args) { explode1("atom", args, val); return make_atom(val); } MalType mal_deref(list args) { explode1("deref", args, val); MalType* atm = is_atom(val); if (!atm) { bad_type("deref", MALTYPE_ATOM, val); } return *atm; } MalType mal_reset_bang(list args) { explode2("reset!", args, a1, a2); MalType* atm = is_atom(a1); if (!atm) { bad_type("reset!", MALTYPE_ATOM, a1); } *atm = a2; return a2; } MalType mal_swap_bang(list args) { if (!args || !args->next) { bad_arg_count("swap!", "at least two arguments", args); } MalType* atm = is_atom(args->data); if (!atm) { bad_type("swap!", MALTYPE_ATOM, args->data); } MalType fn = args->next->data; check_type("swap!", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, fn); list fn_args = list_push(args->next->next, *atm); MalType result = apply(fn, fn_args); if (mal_error) { return NULL; } else { *atm = result; return result; } } MalType mal_throw(list args) { explode1("throw", args, a1); /* re-throw an existing exception */ assert(!mal_error); /* create a new exception */ mal_error = a1; return NULL; } MalType mal_apply(list args) { if (!args || !args->next) { bad_arg_count("apply", "at least two arguments", args); } MalType func = args->data; check_type("apply", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); args = args->next; /* assemble loose arguments */ list lst = NULL; list* lst_last = &lst; while(args->next) { *lst_last = list_push(NULL, args->data); lst_last = &(*lst_last)->next; args = args->next; } MalType final = args->data; vector_t v = is_vector(final); // Append the elements of the final sequence, // efficiently if it is a list. if (v) { for (size_t i = v->count; i--; ) { *lst_last = list_push(*lst_last, v->nth[i]); } } else if (!is_list(final, lst_last)) { bad_type("swap!", MALTYPE_LIST | MALTYPE_VECTOR, final); } return apply(func, lst); // Implicit error propagation } MalType mal_map(list args) { explode2("map", args, func, arg); check_type("map", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); // This check is not redundant when arg is empty. check_type("map", MALTYPE_LIST | MALTYPE_VECTOR, arg); seq_cursor arg_list = seq_iter(arg); list result_list = NULL; list* result_list_last = &result_list; while(seq_cont(arg, arg_list)) { MalType result = apply(func, list_push(NULL, seq_item(arg, arg_list))); /* early return if error */ if (mal_error) { return NULL; } else { *result_list_last = list_push(NULL, result); result_list_last = &(*result_list_last)->next; } arg_list = seq_next(arg, arg_list); } return make_list(result_list); } MalType mal_symbol(list args) { explode1("symbol", args, val); const char* s = is_string(val); if (!s) { bad_type("symbol", MALTYPE_STRING, val); } return make_symbol(s); } MalType mal_keyword(list args) { explode1("keyword", args, val); const char* s; if ((s = is_string (val))) { return make_keyword(s); } else if ((s = is_keyword(val))) { return val; } else { bad_type("keyword", MALTYPE_KEYWORD | MALTYPE_STRING, val); } } MalType mal_vector(list args) { /* Accepts any number and type of arguments */ size_t capacity = list_count(args); struct vector* v = vector_new(capacity); while (args) { vector_append(&capacity, &v, args->data); args = args->next; } assert(v->count == capacity); return make_vector(v); } MalType mal_vec(list args) { /* Accepts a single argument */ explode1("vec", args, val); list l; vector_t v; if ((v = is_vector(val))) { return val; } else if (is_list ( val, &l)) { return mal_vector(l); } else { bad_type("vec", MALTYPE_LIST | MALTYPE_VECTOR, val); } } MalType map_assoc_mutate(const char* context, struct map* new_lst, list args) { for (list a = args; a ; a = a->next->next) { check_type(context, MALTYPE_KEYWORD | MALTYPE_STRING, a->data); if (!a->next) { bad_arg_count("assoc", "an even count of key/value pairs", args); } new_lst = hashmap_put(new_lst, a->data, a->next->data); } return make_hashmap(new_lst); } MalType mal_hash_map(list args) { return map_assoc_mutate("hash-map", map_empty(), args); } MalType mal_get(list args) { explode2("get", args, map, key); check_type("get", MALTYPE_KEYWORD | MALTYPE_STRING, key); hashmap mal_list; if(is_nil(map)) { return make_nil(); } else if(!(mal_list = is_hashmap(map))) { bad_type("get", MALTYPE_HASHMAP | MALTYPE_NIL, map); } MalType result = hashmap_get(mal_list, key); if (!result) { return make_nil(); } return result; } MalType mal_contains_questionmark(list args) { explode2("contains?", args, map, key); check_type("contains?", MALTYPE_KEYWORD | MALTYPE_STRING, key); hashmap mal_list; if(is_nil(map)) { return make_nil(); } if (!(mal_list = is_hashmap(map))) { bad_type("contains?", MALTYPE_HASHMAP | MALTYPE_NIL, map); } MalType result = hashmap_get(mal_list, key); return make_boolean(result); } MalType mal_assoc(list args) { if (!args) { bad_arg_count("assoc", "at least one argument", args); } MalType map = args->data; hashmap m = is_hashmap(map); if (!m) { bad_type("assoc", MALTYPE_HASHMAP, map); } return map_assoc_mutate("assoc", map_copy(m), args->next); } MalType mal_dissoc(list args) { if (!args) { bad_arg_count("dissoc", "at least one argument", args); } MalType map = args->data; hashmap m = is_hashmap(map); if (!m) { bad_type("dissoc", MALTYPE_HASHMAP, map); } struct map* new_list = map_copy(m); args = args->next; list dis_args = args; while(dis_args) { check_type("dissoc", MALTYPE_KEYWORD | MALTYPE_STRING, dis_args->data); map_dissoc_mutate(new_list, dis_args->data); dis_args = dis_args->next; } return make_hashmap(new_list); } MalType mal_keys(list args) { explode1("keys", args, map); hashmap m = is_hashmap(map); if (!m) { bad_type("keys", MALTYPE_HASHMAP, map); } map_cursor lst = map_iter(m); list result = NULL; while(map_cont(m, lst)) { result = list_push(result, map_key(m, lst)); lst = map_next(m, lst); } return make_list(result); } MalType mal_vals(list args) { explode1("vals", args, map); hashmap m = is_hashmap(map); if (!m) { bad_type("vals", MALTYPE_HASHMAP, map); } map_cursor lst = map_iter(m); list result = NULL; while(map_cont(m, lst)) { result = list_push(result, map_val(m, lst)); lst = map_next(m, lst); } return make_list(result); } MalType mal_time_ms(list args) { explode0("time-ms", args); struct timeval tv; gettimeofday(&tv, NULL); long ms = tv.tv_sec * 1000 + tv.tv_usec/1000.0 + 0.5; return make_float(ms); } MalType mal_conj(list args) { if (!args) { bad_arg_count("conj", "at least one argument", args); } MalType lst = args->data; list rest = args->next; vector_t src; list new_lst; if (is_list(lst, &new_lst)) { while(rest) { new_lst = list_push(new_lst, rest->data); rest = rest->next; } return make_list(new_lst); } else if ((src = is_vector(lst))) { size_t capacity = src->count + list_count(rest); struct vector* new_vec = vector_new(capacity); for (size_t i = 0; i < src->count; i++) { vector_append(&capacity, &new_vec, src->nth[i]); } while(rest) { vector_append(&capacity, &new_vec, rest->data); rest = rest->next; } assert(new_vec->count == capacity); return make_vector(new_vec); } else { bad_type("conj", MALTYPE_LIST | MALTYPE_VECTOR, lst); } } MalType mal_seq(list args) { explode1("seq", args, val); vector_t v; list lst = NULL; const char* ch; if (is_list(val, &lst)) { return lst ? val : make_nil(); } else if ((ch = is_string(val))) { /* empty string */ if (*ch == '\0') { return make_nil(); } else { for (size_t i = strlen(ch); i--; ) { char* new_ch = GC_MALLOC(2); *new_ch = ch[i]; assert(!new_ch[1]); lst = list_push(lst, make_string(new_ch)); } return make_list(lst); } } else if ((v = is_vector(val))) { for (size_t i = v->count; i--; ) { lst = list_push(lst, v->nth[i]); } return lst ? make_list(lst) : make_nil(); } else if (is_nil(val)) { return make_nil(); } else { bad_type("seq", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_NIL | MALTYPE_STRING, val); } } MalType mal_meta(list args) { explode1("meta", args, val); return meta(val); } MalType mal_with_meta(list args) { explode2("with-meta", args, val, metadata); list l; if (is_list(val, &l)) return make_list_m(l, metadata); vector_t v = is_vector(val); if (v) return make_vector_m(v, metadata); hashmap m = is_hashmap(val); if (m) return make_hashmap_m(m, metadata); function_t f = is_function(val); if (f) return make_function_m(f, metadata); MalClosure c = is_closure(val); if (c) return make_closure_m(c->env, c->fnstar_args, metadata); bad_type("with-meta", MALTYPE_LIST | MALTYPE_VECTOR | MALTYPE_HASHMAP | MALTYPE_FUNCTION | MALTYPE_CLOSURE, val); } MalType mal_readline(list args) { explode1("readline", args, prompt); const char* prompt_str = is_string(prompt); if (!prompt_str) { bad_type("readline", MALTYPE_STRING, prompt); } const char* str = readline_gc(prompt_str); if(!str) return make_nil(); return make_string(str); } /* helper functions */ inline MalType make_boolean(bool x) { return x ? make_true() : make_false(); } #ifdef WITH_FFI struct { const char* c_type; enum mal_type_t mal_type; ffi_type* ffit; } core_ffi_translations[] = { { "void", MALTYPE_NIL, &ffi_type_void }, { "string", MALTYPE_STRING, &ffi_type_pointer }, { "char*", MALTYPE_STRING, &ffi_type_pointer }, { "char *", MALTYPE_STRING, &ffi_type_pointer }, { "integer", MALTYPE_INTEGER, &ffi_type_sint64 }, { "int64", MALTYPE_INTEGER, &ffi_type_sint64 }, { "int32", MALTYPE_INTEGER, &ffi_type_sint32 }, { "double", MALTYPE_FLOAT, &ffi_type_double }, { "float", MALTYPE_FLOAT, &ffi_type_float }, }; size_t core_ffi_find(const char *type) { for (size_t i = 0; i < sizeof(core_ffi_translations) / sizeof(*core_ffi_translations); i++) { if (!strcmp(core_ffi_translations[i].c_type, type)) { return i; } } make_error("'ffi': unknown type '%s'", type); } MalType mal_dot(list args) { /* (. "lib" "return type" "function" "arg1 type" "arg 1" ...) */ list a; if (!args || !(a = args->next) || !a->next) { bad_arg_count(".", "at least three arguments", args); } const char* lib_name = is_string(args->data); if (!lib_name && !is_nil(args->data)) { bad_type(".", MALTYPE_STRING | MALTYPE_NIL, args->data); } const char* return_type_str = is_string(a->data); if (!return_type_str) { bad_type(".", MALTYPE_STRING, a->data); } size_t return_type = core_ffi_find(return_type_str); if (mal_error) return NULL; a = a->next; const char* fn_name = is_string(a->data); if (!fn_name) { bad_type(".", MALTYPE_STRING, a->data); } a = a->next; int arg_count = 0; ffi_type* arg_types[20]; void* arg_vals [20]; while (a) { if (20 <= arg_count) { bad_arg_count(".", "less than 20 C arguments", args); } const char* val_type = is_string(a->data); if (!val_type) { bad_type(".", MALTYPE_STRING, a->data); } size_t val_type_index = core_ffi_find(val_type); if (mal_error) return NULL; arg_types[arg_count] = core_ffi_translations[val_type_index].ffit; a = a->next; if (!a) { bad_arg_count(".", "an even number of argument types and values", args); } arg_vals[arg_count] = mal_type_value_address(a->data); a = a->next; arg_count++; } /* open a shared library dynamically and get hold of a function */ void* lib_handle = dlopen(lib_name, RTLD_LAZY); if (!lib_handle) { make_error("'ffi': reports: %s", dlerror()); } void* fn = dlsym(lib_handle, fn_name); const char* error = dlerror(); if (error) { make_error("'ffi': dlsym could not get handle to function '%s': %s", fn_name, error); } /* use libffi to call function */ /* perform the call */ ffi_cif cif; ffi_status status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, arg_count, core_ffi_translations[return_type].ffit, arg_types); if (status != FFI_OK) { make_error("'ffi': call to ffi_prep_cif failed with code: %d", status); } /* set return type */ MalType result; switch (core_ffi_translations[return_type].mal_type) { case MALTYPE_NIL: { char retval; ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); result = make_nil(); break; } case MALTYPE_STRING: { char* retval; ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); result = make_string(retval); break; } case MALTYPE_INTEGER: { long retval; ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); result = make_integer(retval); break; } case MALTYPE_FLOAT: { double retval; ffi_call(&cif, FFI_FN(fn), &retval, arg_vals); result = make_float(retval); break; } default: assert(false); } /* close the library */ dlclose(lib_handle); return result; } #endif ================================================ FILE: impls/c.2/core.h ================================================ #ifndef _MAL_CORE_H #define _MAL_CORE_H #include "types.h" typedef const struct ns_s* ns; struct ns_s { const char* key; function_t value; }; void ns_make_core(ns* core, size_t* size); #endif ================================================ FILE: impls/c.2/env.c ================================================ #include #include "env.h" #include "hashmap.h" struct Env_s { const Env* outer; struct map* data; }; Env* env_make(const Env* outer) { struct Env_s* env = GC_MALLOC(sizeof(*env)); env->outer = outer; env->data = map_empty(); return env; } inline void env_set(Env* current, MalType symbol, MalType value) { current->data = hashmap_put(current->data, symbol, value); } MalType env_get(const Env* current, MalType symbol) { do { MalType value = hashmap_get(current->data, symbol); if (value) { return value; } } while((current = current->outer)); return NULL; } hashmap env_as_map(const Env* current) { return current->data; } ================================================ FILE: impls/c.2/env.h ================================================ #ifndef _MAL_ENV_H #define _MAL_ENV_H #include "types.h" // types.h defines Env as struct Env_s. Env* env_make(const Env* outer); void env_set(Env* current, MalType symbol, MalType value); MalType env_get(const Env* current, MalType symbol); /* Returns NULL if the symbol is not found. */ hashmap env_as_map(const Env* current); // For debugging. #endif ================================================ FILE: impls/c.2/error.c ================================================ #include #include "error.h" MalType mal_error = NULL; ================================================ FILE: impls/c.2/error.h ================================================ #ifndef MAL_ERROR_H #define MAL_ERROR_H #include "types.h" extern MalType mal_error; #define make_error(...) { \ mal_error = make_string(mal_printf(__VA_ARGS__)); \ return 0; \ } #define bad_type(context, mask, form) \ make_error("'%s': bad argument type: expected %T, got %M", context, mask, form) #define check_type(context, mask, form) \ if (type(form) & ~(mask)) \ bad_type(context, mask, form) #define bad_arg_count(context, expected, args) \ make_error("'" context "': bad argument count: expected %s, got [%N]", expected, args) #define explode0(context, args) \ if (args) \ bad_arg_count(context, "no argument", args) #define explode1(context, args, var1) \ if (!args || args->next) \ bad_arg_count(context, "one argument", args); \ MalType var1 = args->data #define explode2(context, args, var1, var2) \ list _a; \ if (!args || !(_a = args->next) || _a->next) \ bad_arg_count(context, "two arguments", args); \ MalType var1 = args->data; \ MalType var2 = _a->data #define explode3(context, args, var1, var2, var3) \ list _a, _b; \ if (!args || !(_a = args->next) || !(_b = _a->next) || _b->next) \ bad_arg_count(context, "three arguments", args); \ MalType var1 = args->data; \ MalType var2 = _a->data; \ MalType var3 = _b->data #endif ================================================ FILE: impls/c.2/hashmap.c ================================================ #include #include #include #include "hashmap.h" #ifdef DEBUG_HASHMAP # include # include "printer.h" #endif #ifdef DEBUG_HASH_COLLISIONS # include # include "printer.h" #endif // Removals or redefinitions are rare. // Most structures are quite small, except two ones. // the REPL environment and // the map representing the hosted REPL environment. // Most maps are built once, then constant. // MAL spends a lot of its time searching DEBUG-EVAL in environments. // Either a map has less than 3 keys, or be generous. // After changing this, try "make debug_hash_collisions=1", // because a collison for DEBUG-EVAL in REPL is costly. #define MIN_BUCKETS 7 #define GROW_FACTOR 25 struct map { // Invariants: // table contains size buckets. // 0 <= 2*used < size // A bucket may have three states: // unused (both key and value == NULL) // used normally (both key and value != NULL) // used deleted (key != NULL but value == NULL) // In case of collision, search after the intended one. size_t used; size_t size; struct bucket { MalType key; void* value; } buckets[]; }; struct map* map_empty() { struct map* m = GC_MALLOC(sizeof(*m) + MIN_BUCKETS*sizeof(struct bucket)); // GC_MALLOC sets all the allocated space to zero. m->size = MIN_BUCKETS; return m; } struct map* map_copy(hashmap map) { size_t bytes = sizeof(*map) + map->size * sizeof(struct bucket); struct map* m = GC_MALLOC(bytes); memcpy(m, map, bytes); return m; } size_t search(hashmap map, MalType key) { // The key of the returned index is either NULL or equal to key. size_t index = get_hash(key) % map->size; while (true) { MalType current = map->buckets[index].key; if (!current || equal_forms(key, current)) break; #ifdef DEBUG_HASH_COLLISIONS printf("collision %M(h:%u i:%u) %M(h:%u i:%u)\n", key, get_hash(key), get_hash(key) % map->size, current, get_hash(current), get_hash(current) % map->size); #endif index++; if (index == map->size) index = 0; } #ifdef DEBUG_HASH_COLLISIONS if (index != get_hash(key) % map->size) { printf("collision (%.1f%% of %u) key %M stored in bucket %d instead of %d\n", (float)(100*map->used) / (float)(map->size), map->size, key, index, get_hash(key) % map->size); } #endif #ifdef DEBUG_HASHMAP printf("HASHMAP: search:%M hash:%u index:%u\n", key, get_hash(key), index); for (size_t i = 0; i < map->size; i++) { if (map->buckets[i].key) { if (map->buckets[i].value) { printf(" bucket:%u/%u key:%M val:%M\n", i, map->size, map->buckets[i].key, map->buckets[i].value); } else { printf(" bucket:%u/%u key:%M (removed)\n", i, map->size, map->buckets[i].key); } } else { assert(!map->buckets[i].value); } printf(""); } #endif return index; } void put(struct map* map, MalType key, void* value) { size_t i = search(map, key); if (!map->buckets[i].key) { map->used++; map->buckets[i].key = key; } // else replace the existing/deleted value map->buckets[i].value = value; } struct map* hashmap_put(struct map* map, MalType key, void* value) { assert(value); if (map->size <= 2 * (map->used + 1)) { // Reallocate. size_t size = map->size * GROW_FACTOR; struct map* m = GC_MALLOC(sizeof(*m) + size*sizeof(struct bucket)); // GC_MALLOC sets all the allocated space to zero. m->size = size; for (size_t i = 0; i < map->size; i++) { if (map->buckets[i].key && map->buckets[i].value) { put(m, map->buckets[i].key, map->buckets[i].value); } } map = m; } put(map, key, value); return map; } inline void* hashmap_get(hashmap map, MalType key) { return map->buckets[search(map, key)].value; // may be null } void map_dissoc_mutate(struct map* map, MalType key) { size_t i = search(map, key); if (map->buckets[i].key) { map->buckets[i].value = NULL; } } inline size_t map_count(hashmap map) { return map->used; } map_cursor next_valid(hashmap map, size_t i) { while ((i < map->size) && !(map->buckets[i].key && map->buckets[i].value)) { i++; } return i; } inline map_cursor map_iter(hashmap map) { return next_valid(map, 0); } inline bool map_cont(hashmap map, map_cursor position) { return position < map->size; } inline MalType map_key(hashmap map, map_cursor position) { assert(position < map->size); assert(map->buckets[position].key); assert(map->buckets[position].value); return map->buckets[position].key; } inline void* map_val(hashmap map, map_cursor position) { assert(position < map->size); assert(map->buckets[position].key); assert(map->buckets[position].value); return map->buckets[position].value; } inline map_cursor map_next(hashmap map, map_cursor position) { assert(position < map->size); assert(map->buckets[position].key); assert(map->buckets[position].value); return next_valid(map, position + 1); } ================================================ FILE: impls/c.2/hashmap.h ================================================ #ifndef MAL_HASHMAP_H #define MAL_HASHMAP_H #include #include "types.h" // Keys must be keywords, strings or symbols. struct map* map_empty(); // not NULL struct map* map_copy(hashmap); struct map* hashmap_put(struct map* map, MalType key, void* value); // Value must not be NULL. // May reallocate. void* hashmap_get(hashmap map, MalType key); // Returns NULL if the map does not contain the key. void map_dissoc_mutate(struct map* map, MalType key); size_t map_count(hashmap); typedef size_t map_cursor; // The same (unmodified) container must be be provided to each // function during iteration. map_cursor map_iter(hashmap); bool map_cont(hashmap, map_cursor); map_cursor map_next(hashmap, map_cursor); MalType map_key(hashmap, map_cursor); void* map_val(hashmap, map_cursor); #endif ================================================ FILE: impls/c.2/linked_list.c ================================================ #include #include "linked_list.h" list list_push(list lst, MalType data_ptr) { struct pair_s* new_head = GC_malloc(sizeof(*new_head)); new_head->data = data_ptr; new_head->next = lst; return new_head; } size_t list_count(list lst) { size_t counter = 0; while(lst) { counter++; lst = lst->next; } return counter; } ================================================ FILE: impls/c.2/linked_list.h ================================================ #ifndef _MAL_LINKED_LIST_H #define _MAL_LINKED_LIST_H #include "types.h" /* linked list is constructed of pairs */ /* a list is just a pointer to the pair at the head of the list */ struct pair_s { MalType data; list next; }; /* interface */ list list_push(list lst, MalType data_ptr); size_t list_count(list lst); #endif ================================================ FILE: impls/c.2/printer.c ================================================ #include #include #include #include #include "linked_list.h" #include "printer.h" #include "hashmap.h" #include "vector.h" #define PRINT_NIL "nil" #define PRINT_TRUE "true" #define PRINT_FALSE "false" int escape_string(FILE *stream, const char* str); int pr_str_vector(FILE* stream, const struct printf_info *i, vector_t v); // Execute count once. #define ADD(count) { \ int more = count; \ if(more < 0) \ return more; \ written += more; \ } int print_M(FILE *stream, const struct printf_info *i, const void *const *a) { MalType val = *((const MalType*)(*a)); int written = 0; switch(type(val)) { case MALTYPE_SYMBOL: ADD(fprintf(stream, "%s", is_symbol(val))); break; case MALTYPE_KEYWORD: ADD(fprintf(stream, ":%s", is_keyword(val))); break; case MALTYPE_INTEGER: { long mal_integer; is_integer(val, &mal_integer); ADD(fprintf(stream, "%ld", mal_integer)); break; } case MALTYPE_FLOAT: { double mal_float; is_float(val, &mal_float); ADD(fprintf(stream, "%lf", mal_float)); break; } case MALTYPE_STRING: if (!i->alt) { ADD(escape_string(stream, is_string(val))); } else { ADD(fprintf(stream, "%s", is_string(val))); } break; case MALTYPE_TRUE: ADD(fprintf(stream, PRINT_TRUE)); break; case MALTYPE_FALSE: ADD(fprintf(stream, PRINT_FALSE)); break; case MALTYPE_NIL: ADD(fprintf(stream, PRINT_NIL)); break; case MALTYPE_LIST: { list mal_list; is_list(val, &mal_list); ADD(fprintf(stream, i->alt ? "(%#N)" : "(%N)", mal_list)); break; } case MALTYPE_VECTOR: ADD(pr_str_vector(stream, i, is_vector(val))); break; case MALTYPE_HASHMAP: ADD(fprintf(stream, i->alt ? "{%#H}" : "{%H}", is_hashmap(val))); break; case MALTYPE_FUNCTION: ADD(fprintf(stream, "#")); break; case MALTYPE_CLOSURE: ADD(fprintf(stream, i->alt ? "#" : "#", is_closure(val)->fnstar_args)); break; case MALTYPE_MACRO: ADD(fprintf(stream, i->alt ? "#" : "#", is_macro(val)->fnstar_args)); break; case MALTYPE_ATOM: ADD(fprintf(stream, i->alt ? "(atom %#M)" : "(atom %M)", *is_atom(val))); } if (written < i->width) { ADD(fprintf(stream, "%*s", i->width - written, "")); } return written; } int print_L(FILE* stream, const struct printf_info *i, const void *const *a) { int written = 0; for (list lst = *((const list*)(*a)); lst; lst = lst->next) { ADD(fprintf(stream, i->alt ? "%s%#M" : "%s%M", !i->space && written ? " " : "", lst->data)); } return written; } int pr_str_vector(FILE* stream, const struct printf_info *i, vector_t v) { int written = 0; ADD(fprintf(stream, "[")); for (size_t j = 0; j < v->count; j++) { ADD(fprintf(stream, i->alt ? "%s%#M" : "%s%M", j ? " " : "", v->nth[j])); } ADD(fprintf(stream, "]")); return written; } int pr_str_map(FILE* stream, const struct printf_info *i, const void *const *a) { hashmap map = *((const hashmap*)(*a)); int written = 0; for (map_cursor c = map_iter(map); map_cont(map, c); c = map_next(map, c)) { ADD(fprintf(stream, i->alt ? "%s%#M %#M" : "%s%M %M", written ? " " : "", map_key(map, c), map_val(map, c))); } return written; } int escape_string(FILE *stream, const char* str) { int written = 0; ADD(fprintf(stream, "\"")); const char* curr = str; while(*curr != '\0') { switch (*curr) { case 0x0A: ADD(fprintf(stream, "\\n")); break; case '"': case '\\': ADD(fprintf(stream, "\\")); // fall through default: ADD(fprintf(stream, "%c", *curr)); } curr++; } ADD(fprintf(stream, "\"")); return written; } // The order must match the one in types.c. const char* print_T_table[] = { "a symbol", "a keyword", "an integer", "a float", "a string", "true", "false", "nil", "a list", "a vector", "a map", "a function", "a closure", "an atom", "a macro", }; int print_T(FILE *stream, const struct printf_info *, const void *const *a) { enum mal_type_t mask = *((const enum mal_type_t*)(*a)); assert(0 < mask); int written = 0; const char** p = print_T_table; while (mask) { assert(p < print_T_table + sizeof(print_T_table) / sizeof(*print_T_table)); if (mask & 1) { ADD(fprintf(stream, "%s%s", written ? " or " : "", *p)); } p++; mask >>= 1; } return written; } #define generic_arg(specifier, type) \ int arg_##specifier(const struct printf_info*, \ size_t n,int *argtypes, int *size) { \ if(n < 1) return -1; \ argtypes[0] = PA_POINTER; \ *size = sizeof(type); \ return 1; \ } generic_arg(M, MalType); generic_arg(N, list); generic_arg(T, enum mal_type_t); generic_arg(H, hashmap); void printer_init() { int ret1 = register_printf_specifier('N', print_L, arg_N); int ret2 = register_printf_specifier('M', print_M, arg_M); int ret3 = register_printf_specifier('T', print_T, arg_T); int ret4 = register_printf_specifier('H', pr_str_map, arg_H); assert(!ret1); assert(!ret2); assert(!ret3); assert(!ret4); #ifdef NDEBUG (void)ret1; (void)ret2; (void)ret3; (void)ret4; #endif } const char* mal_printf(const char* fmt, ...) { va_list argptr; va_start(argptr, fmt); int n = vsnprintf(NULL, 0, fmt, argptr); assert(0 <= n); va_end(argptr); char* buffer = GC_MALLOC(n + 1); va_start(argptr, fmt); int again = vsnprintf(buffer, n+1, fmt, argptr); assert(n == again); #ifdef NDEBUG (void)again; #endif va_end(argptr); return buffer; } ================================================ FILE: impls/c.2/printer.h ================================================ #ifndef _PRINTER_H #define _PRINTER_H // This function must be called during startup. void printer_init(); // It adds the following conversion specifiers (requires GNU libc). // specifier type modifiers meaning // // %M MalType # no string escape // positive width right padding // %N list # no string escape // ' ' no space separator // %T enum mal_type_t // %H hashmap # no string escape // Similar to asprintf, except that // the memory is allocated with GC_MALLOC instead of malloc, // errors crash the program instead of being reported. const char* mal_printf(const char* fmt, ...); #endif ================================================ FILE: impls/c.2/reader.c ================================================ #include #include #include #include #include #include #include #include "hashmap.h" #include "printer.h" #include "reader.h" #include "linked_list.h" #include "vector.h" #include "error.h" #define SYMBOL_NIL "nil" #define SYMBOL_TRUE "true" #define SYMBOL_FALSE "false" #ifdef DEBUG_READER # define DEBUG(fmt, ...) printf("READER: %s \"%s\": " fmt "\n", __func__, *reader, ## __VA_ARGS__) #else # define DEBUG(...) #endif typedef const char** Reader; MalType read_form(Reader reader); MalType read_with_meta(Reader reader); MalType read_string(Reader reader); MalType read_number(Reader reader); const char* read_symbol (Reader reader); MalType read_list(Reader reader); MalType read_vector(Reader reader); MalType read_map(Reader reader); void skip_spaces(Reader reader); MalType make_symbol_list(Reader reader, MalType symbol_name); void skip_spaces(Reader reader) { while(true) { if(**reader == ';') { do { (*reader)++; if(**reader == 0x00) return; } while(**reader != 0x0A); } else if((**reader != ',') && !isspace(**reader)) { return; } (*reader)++; } } MalType read_str(const char* source) { MalType result = read_form(&source); if(mal_error) return NULL; skip_spaces(&source); if(*source) make_error("reader: trailing characters (after %M): %s", result, source); return result; } const char* read_symbol (Reader reader) { DEBUG(); const char* start = *reader; while(!isspace(**reader)) { switch(**reader) { case 0: return start; case '[': case '{': case '(': case ']': case '}': case ')': case '\'': case '@': case '`': case '^': case '~': case '"': case ',': case ';': goto finished; default: (*reader)++; } } finished: size_t len = *reader - start; char* result = GC_MALLOC(len + 1); strncpy(result, start, len); assert(!result[len]); return result; } MalType read_form(Reader reader) { DEBUG(); skip_spaces(reader); switch (**reader) { case 0: make_error("reader: input string is empty"); case '[': return read_vector(reader); // Implicit error propagation case '{': return read_map(reader); // Implicit error propagation case '(': return read_list(reader); // Implicit error propagation case ']': case '}': case ')': make_error("reader: unmatched '%c'", **reader); case '\'': return make_symbol_list(reader, SYMBOL_QUOTE); case '@': return make_symbol_list(reader, SYMBOL_DEREF); case '`': return make_symbol_list(reader, SYMBOL_QUASIQUOTE); case '^': return read_with_meta(reader); // Implicit error propagation case '~': if(*(*reader + 1) == '@') { (*reader)++; return make_symbol_list(reader, SYMBOL_SPLICE_UNQUOTE); } return make_symbol_list(reader, SYMBOL_UNQUOTE); case '"': return read_string(reader); // Implicit error propagation case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': return read_number(reader); case '+': case '-': if(isdigit(*(*reader + 1))) return read_number(reader); else return make_symbol(read_symbol(reader)); case ':': (*reader)++; return make_keyword(read_symbol(reader)); default: { const char* sym = read_symbol(reader); if(!strcmp(sym, SYMBOL_NIL)) return make_nil(); if(!strcmp(sym, SYMBOL_FALSE)) return make_false(); if(!strcmp(sym, SYMBOL_TRUE)) return make_true(); return make_symbol(sym); } } } MalType read_number(Reader reader) { DEBUG(); const char* start = *reader; // Skip the initial character, which is a digit or a +- sign // (followed by a digit). (*reader)++; bool has_decimal_point = false; while(true) { if(**reader == '.') { if(has_decimal_point) break; has_decimal_point = true; (*reader)++; } else if(isdigit(**reader)) (*reader)++; else break; } size_t len = *reader - start; char buffer[len + 1]; strncpy(buffer, start, len); buffer[len] = 0; if(has_decimal_point) return make_float(atof(buffer)); else return make_integer(atol(buffer)); } MalType read_with_meta(Reader reader) { DEBUG(); /* create and return a MalType list (with-meta where first form should ne a metadata map and second form is somethingh that can have metadata attached */ (*reader)++; /* grab the components of the list */ MalType symbol = SYMBOL_WITH_META; MalType first_form = read_form(reader); if(mal_error) return NULL; MalType second_form = read_form(reader); if(mal_error) return NULL; /* push the symbol and the following forms onto a list */ list lst = NULL; lst = list_push(lst, first_form); lst = list_push(lst, second_form); lst = list_push(lst, symbol); return make_list(lst); } MalType read_list(Reader reader) { (*reader)++; list lst = NULL; list* lst_last = &lst; while(true) { DEBUG("searching ')', already read: %N", lst); skip_spaces(reader); if(!**reader) { /* unbalanced parentheses */ make_error("reader: unbalanced '('"); } if(**reader == ')') break; MalType val = read_form(reader); if(mal_error) return NULL; *lst_last = list_push(NULL, val); lst_last = &(*lst_last)->next; } (*reader)++; return make_list(lst); } MalType read_vector(Reader reader) { (*reader)++; size_t capacity = 10; struct vector* v = vector_new(capacity); while(true) { DEBUG("searching ']'"); skip_spaces(reader); if (!**reader) { make_error("reader: unbalanced '['"); } if (**reader == ']') break; MalType val = read_form(reader); if (mal_error) return NULL; vector_append(&capacity, &v, val); } (*reader)++; return make_vector(v); } MalType read_map(Reader reader) { (*reader)++; struct map* map = map_empty(); while(true) { DEBUG("searching '}' or key"); skip_spaces(reader); if (!**reader) { make_error("reader: unbalanced '{'"); } if (**reader == '}') break; MalType key = read_form(reader); if (mal_error) return NULL; check_type("reading map literal", MALTYPE_KEYWORD | MALTYPE_STRING, key); DEBUG("searching map value for %M", key); skip_spaces(reader); if (!**reader) { make_error("reader: unbalanced '{'"); } if (**reader == '}') { make_error("reader: odd count of bindings in map litteral"); } MalType value = read_form(reader); if (mal_error) return NULL; map = hashmap_put(map, key, value); } (*reader)++; return make_hashmap(map); } MalType make_symbol_list(Reader reader, MalType symbol) { DEBUG(); (*reader)++; list lst = NULL; /* push the symbol and the following form onto the list */ MalType form = read_form(reader); if(mal_error) return NULL; lst = list_push(lst, form); lst = list_push(lst, symbol); return make_list(lst); } MalType read_string(Reader reader) { DEBUG(); (*reader)++; // initial '"' size_t count = 0; // Compute the length. for(const char* p=*reader; *p!='"'; p++) { if(!*p) make_error("reader: unbalanced '\"'"); if(*p == '\\') { p++; switch(*p) { case 0: make_error("reader: incomplete \\ escape sequence"); case '\\': case 'n': case '"': break; default: make_error("reader: incomplete escape sequence '\\%c'", *p); } } count++; } // Copy/unescape the characters, add final 0. char* result = GC_MALLOC(count + 1); const char* src; char* dst = result; for(src=*reader; *src!='"'; src++) { if(*src == '\\') { src++; if(*src == 'n') { *dst++ = 0x0A; continue; } } *dst++ = *src; } *dst = 0; *reader = src + 1; return make_string(result); } ================================================ FILE: impls/c.2/reader.h ================================================ #ifndef _MAL_READER_H #define _MAL_READER_H #include "types.h" MalType read_str(const char*); #endif ================================================ FILE: impls/c.2/readline.c ================================================ #include #include #include #if USE_READLINE # include # include #else # include # include #endif const char* readline_gc(const char* prompt) { char* str = readline(prompt); if (!str) { return NULL; } add_history(str); /* Copy the input into an area managed by libgc. */ size_t n = strlen(str) + 1; char* result = GC_MALLOC(n); memcpy(result, str, n); free(str); return result; } ================================================ FILE: impls/c.2/readline.h ================================================ #ifndef MAL_READLINE_H #define MAL_READLINE_H const char* readline_gc(const char* prompt); // NULL if EOF #endif ================================================ FILE: impls/c.2/run ================================================ #!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/c.2/step0_repl.c ================================================ #include #include #include "readline.h" #define PROMPT_STRING "user> " const char* READ(const char* str) { return str; } const char* EVAL(const char* ast) { return ast; } void PRINT(const char* str) { printf("%s\n", str); } void rep(const char* str) { PRINT(EVAL(READ(str))); } int main() { const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input); } printf("\n"); return EXIT_SUCCESS; } ================================================ FILE: impls/c.2/step1_read_print.c ================================================ #include #include #include "types.h" #include "reader.h" #include "printer.h" #include "error.h" #include "readline.h" #define PROMPT_STRING "user> " MalType READ(const char* str) { return read_str(str); // Implicit error propagation } MalType EVAL(MalType ast) { return ast; } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str) { MalType a = READ(str); if (!mal_error) { PRINT(EVAL(a)); return; } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } int main() { types_init(); printer_init(); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input); } printf("\n"); return EXIT_SUCCESS; } ================================================ FILE: impls/c.2/step2_eval.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, hashmap); MalType evaluate_vector(vector_t, hashmap); MalType evaluate_hashmap(hashmap, hashmap); #define generic_arithmetic(name, op, iconst, fconst) \ MalType name(list args) { \ explode2(#op, args, a1, a2); \ long i1, i2; \ double f1, f2; \ if (is_integer(a1, &i1)) { \ if (is_integer(a2, &i2)) return iconst(i1 op i2); \ if (is_float (a2, &f2)) return fconst(i1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ if (is_float(a1, &f1)) { \ if (is_integer(a2, &i2)) return iconst(f1 op i2); \ if (is_float (a2, &f2)) return fconst(f1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ } generic_arithmetic(mal_add, +, make_integer, make_float) generic_arithmetic(mal_sub, -, make_integer, make_float) generic_arithmetic(mal_mul, *, make_integer, make_float) generic_arithmetic(mal_div, /, make_integer, make_float) MalType READ(const char* str) { return read_str(str); // Implicit error propagation } MalType EVAL(MalType ast, hashmap env) { /* printf("EVAL: %M\n", ast); */ if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = hashmap_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, hashmap env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } int main() { types_init(); printer_init(); struct map* repl_env = map_empty(); repl_env = hashmap_put(repl_env, make_symbol("+"), make_function(mal_add)); repl_env = hashmap_put(repl_env, make_symbol("-"), make_function(mal_sub)); repl_env = hashmap_put(repl_env, make_symbol("*"), make_function(mal_mul)); repl_env = hashmap_put(repl_env, make_symbol("/"), make_function(mal_div)); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); return EXIT_SUCCESS; } list evaluate_list(list lst, hashmap env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, hashmap env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, hashmap env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType apply(MalType fn, list args) { function_t fun_ptr = is_function(fn); assert(fun_ptr); return (*fun_ptr)(args); // Implicit error propagation } ================================================ FILE: impls/c.2/step3_env.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env*); MalType eval_letstar(list, Env*); typedef MalType (*special_t)(list, Env*); struct map* specials; #define generic_arithmetic(name, op, iconst, fconst) \ MalType name(list args) { \ explode2(#op, args, a1, a2); \ long i1, i2; \ double f1, f2; \ if (is_integer(a1, &i1)) { \ if (is_integer(a2, &i2)) return iconst(i1 op i2); \ if (is_float (a2, &f2)) return fconst(i1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ if (is_float(a1, &f1)) { \ if (is_integer(a2, &i2)) return iconst(f1 op i2); \ if (is_float (a2, &f2)) return fconst(f1 op f2); \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a2); \ } \ bad_type(#op, MALTYPE_INTEGER | MALTYPE_FLOAT, a1); \ } generic_arithmetic(mal_add, +, make_integer, make_float) generic_arithmetic(mal_sub, -, make_integer, make_float) generic_arithmetic(mal_mul, *, make_integer, make_float) generic_arithmetic(mal_div, /, make_integer, make_float) MalType READ(const char* str) { return read_str(str); // Implicit error propagation } MalType EVAL(MalType ast, Env* env) { MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { return special(lst, env); } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } int main() { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); Env* repl_env = env_make(NULL); env_set(repl_env, make_symbol("+"), make_function(mal_add)); env_set(repl_env, make_symbol("-"), make_function(mal_sub)); env_set(repl_env, make_symbol("*"), make_function(mal_mul)); env_set(repl_env, make_symbol("/"), make_function(mal_div)); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env* env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(env, defbang_symbol, result); return result; } MalType eval_letstar(list lst, Env* env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } return EVAL(forms, letstar_env); } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType apply(MalType fn, list args) { function_t fun_ptr = is_function(fn); assert(fun_ptr); return (*fun_ptr)(args); // Implicit error propagation } ================================================ FILE: impls/c.2/step4_if_fn_do.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env*); MalType eval_letstar(list, Env*); MalType eval_if(list, Env*); MalType eval_fnstar(list, const Env*); MalType eval_do(list, Env*); typedef MalType (*special_t)(list, Env*); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { return special(lst, env); } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { return EVAL(closure->fnstar_args->next->data, env_apply(closure, evlst)); // Implicit error propagation } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } int main() { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); Env* repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env* env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(env, defbang_symbol, result); return result; } MalType eval_letstar(list lst, Env* env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } return EVAL(forms, letstar_env); } MalType eval_if(list lst, Env* env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return EVAL(else_form, env); } else { return make_nil(); } } else { return EVAL(then_form, env); } } MalType eval_do(list lst, Env* env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return EVAL(lst->data, env); } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, const Env* env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } return make_closure(env, lst); } MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/step5_tco.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } int main() { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); Env* repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/step6_file.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } /* declare as global so it can be accessed by mal_eval */ Env* repl_env; MalType mal_eval(list args) { explode1("eval", args, ast); return EVAL(ast, repl_env); // Implicit error propagation } int main(int argc, char** argv) { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); /* make command line arguments available in the environment */ list lst = NULL; while(1 < --argc) { lst = list_push(lst, make_string(argv[argc])); } env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); /* run in script mode if a filename is given */ if (argc) { /* first argument on command line is filename */ const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); re(load_command, repl_env); } /* run in repl mode when no cmd line args */ else { const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); } return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/step7_quote.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); MalType eval_quote(list, Env**); MalType eval_quasiquote(list, Env**); MalType quasiquote(MalType); MalType quasiquote_vector(vector_t); MalType quasiquote_list(list); MalType quasiquote_folder(MalType first, MalType qq_rest); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION, func); // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } /* declare as global so it can be accessed by mal_eval */ Env* repl_env; MalType mal_eval(list args) { explode1("eval", args, ast); return EVAL(ast, repl_env); // Implicit error propagation } int main(int argc, char** argv) { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); /* make command line arguments available in the environment */ list lst = NULL; while(1 < --argc) { lst = list_push(lst, make_string(argv[argc])); } env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); /* run in script mode if a filename is given */ if (argc) { /* first argument on command line is filename */ const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); re(load_command, repl_env); } /* run in repl mode when no cmd line args */ else { const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); } return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } MalType eval_quote(list lst, Env** env) { explode1("quote", lst, form); *env = NULL; // no TCO return form; } MalType eval_quasiquote(list lst, Env**) { explode1("quasiquote", lst, form); return quasiquote(form); // Implicit error propagation. } MalType quasiquote(MalType ast) { /* argument to quasiquote is a vector: (quasiquote [first rest]) */ list lst; vector_t vec; if ((vec = is_vector(ast))) { return quasiquote_vector(vec); // Implicit error propagation } /* argument to quasiquote is a list: (quasiquote (first rest)) */ else if (is_list(ast, &lst)){ if(lst) { MalType first = lst->data; if(equal_forms(first, SYMBOL_UNQUOTE)) { lst = lst->next; explode1("unquote", lst, unquoted); return unquoted; } } return quasiquote_list(lst); // Implicit error propagation } /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) => (quote val) */ else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { list lst = NULL; lst = list_push(lst, ast); lst = list_push(lst, SYMBOL_QUOTE); return make_list(lst); } /* argument to quasiquote is self-evaluating: (quasiquote val) => val */ else { return ast; } } MalType quasiquote_vector(vector_t vec) { MalType result = make_list(NULL); for (size_t i = vec->count; i--; ) { result = quasiquote_folder(vec->nth[i], result); if (mal_error) return NULL; } list lst = NULL; lst = list_push(lst, result); lst = list_push(lst, SYMBOL_VEC); return make_list(lst); } MalType quasiquote_list(list args) { /* handle empty list: (quasiquote ()) => () */ if (!args) { return make_list(NULL); } MalType first = args->data; MalType qq_rest = quasiquote_list(args->next); if(mal_error) return NULL; return quasiquote_folder(first, qq_rest); // Implicit error propagation. } MalType quasiquote_folder(MalType first, MalType qq_rest) { /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) => (concat first-second (quasiquote rest)) */ list lst; if(is_list(first, &lst)) { if(lst) { MalType lst_first = lst->data; if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { lst = lst->next; explode1("splice-unquote", lst, unquoted); return make_list(list_push(list_push(list_push(NULL, qq_rest), unquoted), SYMBOL_CONCAT)); } } } MalType qqted = quasiquote(first); if(mal_error) return NULL; return make_list(list_push(list_push(list_push(NULL, qq_rest), qqted), SYMBOL_CONS)); } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/step8_macros.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); MalType eval_quote(list, Env**); MalType eval_quasiquote(list, Env**); MalType quasiquote(MalType); MalType quasiquote_vector(vector_t); MalType quasiquote_list(list); MalType quasiquote_folder(MalType first, MalType qq_rest); MalType eval_defmacrobang(list, Env**); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); if (type(func) == MALTYPE_MACRO) { ast = apply(func, lst); if (mal_error) { return NULL; } goto TCE_entry_point; } // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } /* declare as global so it can be accessed by mal_eval */ Env* repl_env; MalType mal_eval(list args) { explode1("eval", args, ast); return EVAL(ast, repl_env); // Implicit error propagation } int main(int argc, char** argv) { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); /* make command line arguments available in the environment */ list lst = NULL; while(1 < --argc) { lst = list_push(lst, make_string(argv[argc])); } env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); /* run in script mode if a filename is given */ if (argc) { /* first argument on command line is filename */ const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); re(load_command, repl_env); } /* run in repl mode when no cmd line args */ else { const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); } return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } MalType eval_quote(list lst, Env** env) { explode1("quote", lst, form); *env = NULL; // no TCO return form; } MalType eval_quasiquote(list lst, Env**) { explode1("quasiquote", lst, form); return quasiquote(form); // Implicit error propagation. } MalType quasiquote(MalType ast) { /* argument to quasiquote is a vector: (quasiquote [first rest]) */ list lst; vector_t vec; if ((vec = is_vector(ast))) { return quasiquote_vector(vec); // Implicit error propagation } /* argument to quasiquote is a list: (quasiquote (first rest)) */ else if (is_list(ast, &lst)){ if(lst) { MalType first = lst->data; if(equal_forms(first, SYMBOL_UNQUOTE)) { lst = lst->next; explode1("unquote", lst, unquoted); return unquoted; } } return quasiquote_list(lst); // Implicit error propagation } /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) => (quote val) */ else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { list lst = NULL; lst = list_push(lst, ast); lst = list_push(lst, SYMBOL_QUOTE); return make_list(lst); } /* argument to quasiquote is self-evaluating: (quasiquote val) => val */ else { return ast; } } MalType quasiquote_vector(vector_t vec) { MalType result = make_list(NULL); for (size_t i = vec->count; i--; ) { result = quasiquote_folder(vec->nth[i], result); if (mal_error) return NULL; } list lst = NULL; lst = list_push(lst, result); lst = list_push(lst, SYMBOL_VEC); return make_list(lst); } MalType quasiquote_list(list args) { /* handle empty list: (quasiquote ()) => () */ if (!args) { return make_list(NULL); } MalType first = args->data; MalType qq_rest = quasiquote_list(args->next); if(mal_error) return NULL; return quasiquote_folder(first, qq_rest); // Implicit error propagation. } MalType quasiquote_folder(MalType first, MalType qq_rest) { /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) => (concat first-second (quasiquote rest)) */ list lst; if(is_list(first, &lst)) { if(lst) { MalType lst_first = lst->data; if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { lst = lst->next; explode1("splice-unquote", lst, unquoted); return make_list(list_push(list_push(list_push(NULL, qq_rest), unquoted), SYMBOL_CONCAT)); } } } MalType qqted = quasiquote(first); if(mal_error) return NULL; return make_list(list_push(list_push(list_push(NULL, qq_rest), qqted), SYMBOL_CONS)); } MalType eval_defmacrobang(list lst, Env** env) { explode2("defmacro!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) return NULL; MalClosure closure = is_closure(result); if (!closure) { bad_type("defmacro!", MALTYPE_CLOSURE, result); } result = make_macro(closure->env, closure->fnstar_args); check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); if (!closure) closure = is_macro(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/step9_try.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); MalType eval_quote(list, Env**); MalType eval_quasiquote(list, Env**); MalType quasiquote(MalType); MalType quasiquote_vector(vector_t); MalType quasiquote_list(list); MalType quasiquote_folder(MalType first, MalType qq_rest); MalType eval_defmacrobang(list, Env**); MalType eval_try(list, Env**); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); if (type(func) == MALTYPE_MACRO) { ast = apply(func, lst); if (mal_error) { return NULL; } goto TCE_entry_point; } // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } /* declare as global so it can be accessed by mal_eval */ Env* repl_env; MalType mal_eval(list args) { explode1("eval", args, ast); return EVAL(ast, repl_env); // Implicit error propagation } int main(int argc, char** argv) { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); specials = hashmap_put(specials, SYMBOL_TRY, eval_try); repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); /* make command line arguments available in the environment */ list lst = NULL; while(1 < --argc) { lst = list_push(lst, make_string(argv[argc])); } env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); /* run in script mode if a filename is given */ if (argc) { /* first argument on command line is filename */ const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); re(load_command, repl_env); } /* run in repl mode when no cmd line args */ else { const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); } return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } MalType eval_quote(list lst, Env** env) { explode1("quote", lst, form); *env = NULL; // no TCO return form; } MalType eval_quasiquote(list lst, Env**) { explode1("quasiquote", lst, form); return quasiquote(form); // Implicit error propagation. } MalType quasiquote(MalType ast) { /* argument to quasiquote is a vector: (quasiquote [first rest]) */ list lst; vector_t vec; if ((vec = is_vector(ast))) { return quasiquote_vector(vec); // Implicit error propagation } /* argument to quasiquote is a list: (quasiquote (first rest)) */ else if (is_list(ast, &lst)){ if(lst) { MalType first = lst->data; if(equal_forms(first, SYMBOL_UNQUOTE)) { lst = lst->next; explode1("unquote", lst, unquoted); return unquoted; } } return quasiquote_list(lst); // Implicit error propagation } /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) => (quote val) */ else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { list lst = NULL; lst = list_push(lst, ast); lst = list_push(lst, SYMBOL_QUOTE); return make_list(lst); } /* argument to quasiquote is self-evaluating: (quasiquote val) => val */ else { return ast; } } MalType quasiquote_vector(vector_t vec) { MalType result = make_list(NULL); for (size_t i = vec->count; i--; ) { result = quasiquote_folder(vec->nth[i], result); if (mal_error) return NULL; } list lst = NULL; lst = list_push(lst, result); lst = list_push(lst, SYMBOL_VEC); return make_list(lst); } MalType quasiquote_list(list args) { /* handle empty list: (quasiquote ()) => () */ if (!args) { return make_list(NULL); } MalType first = args->data; MalType qq_rest = quasiquote_list(args->next); if(mal_error) return NULL; return quasiquote_folder(first, qq_rest); // Implicit error propagation. } MalType quasiquote_folder(MalType first, MalType qq_rest) { /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) => (concat first-second (quasiquote rest)) */ list lst; if(is_list(first, &lst)) { if(lst) { MalType lst_first = lst->data; if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { lst = lst->next; explode1("splice-unquote", lst, unquoted); return make_list(list_push(list_push(list_push(NULL, qq_rest), unquoted), SYMBOL_CONCAT)); } } } MalType qqted = quasiquote(first); if(mal_error) return NULL; return make_list(list_push(list_push(list_push(NULL, qq_rest), qqted), SYMBOL_CONS)); } MalType eval_defmacrobang(list lst, Env** env) { explode2("defmacro!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) return NULL; MalClosure closure = is_closure(result); if (!closure) { bad_type("defmacro!", MALTYPE_CLOSURE, result); } result = make_macro(closure->env, closure->fnstar_args); check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_try(list lst, Env** env) { if (!lst) { bad_arg_count("try*", "one or two arguments", lst); } MalType try_clause = lst->data; list l = lst->next; if (!l) { /* no catch* clause */ return try_clause; } MalType catch_clause = l->data; if (l->next) { bad_arg_count("try*", "one or two arguments", lst); } /* process catch* clause */ check_type("try*", MALTYPE_LIST, catch_clause); list catch_list; if (!is_list(catch_clause, &catch_list)) { bad_type("try*", MALTYPE_LIST, catch_clause); } explode3("try*(catch clause)", catch_list, catch_symbol, a2, handler); if (!equal_forms(catch_symbol, SYMBOL_CATCH)) { make_error("'try*': catch* clause is missing catch* symbol: %M", catch_clause); } check_type("try*", MALTYPE_SYMBOL, a2); MalType try_result = EVAL(try_clause, *env); if(!mal_error) { *env = NULL; // prevent TCO return try_result; } /* bind the symbol to the exception */ Env* catch_env = env_make(*env); env_set(catch_env, a2, mal_error); mal_error = NULL; *env = catch_env; return handler; } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); if (!closure) closure = is_macro(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/stepA_mal.c ================================================ #include #include #include #include "linked_list.h" #include "types.h" #include "reader.h" #include "printer.h" #include "env.h" #include "core.h" #include "error.h" #include "hashmap.h" #include "readline.h" #include "vector.h" #define PROMPT_STRING "user> " MalType apply(MalType, list); // For the apply phase and core apply/map/swap. list evaluate_list(list, Env*); MalType evaluate_vector(vector_t, Env*); MalType evaluate_hashmap(hashmap lst, Env* env); MalType eval_defbang(list, Env**); MalType eval_letstar(list, Env**); MalType eval_if(list, Env**); MalType eval_fnstar(list, Env**); MalType eval_do(list, Env**); MalType eval_quote(list, Env**); MalType eval_quasiquote(list, Env**); MalType quasiquote(MalType); MalType quasiquote_vector(vector_t); MalType quasiquote_list(list); MalType quasiquote_folder(MalType first, MalType qq_rest); MalType eval_defmacrobang(list, Env**); MalType eval_try(list, Env**); typedef MalType (*special_t)(list, Env**); struct map* specials; MalType READ(const char* str) { return read_str(str); // Implicit error propagation } Env* env_apply(MalClosure closure, list args) { // Return the closure definition and update env if all went OK, // else return an error. Env* fn_env = env_make(closure->env); MalType params = closure->fnstar_args->data; assert(type(params) & (MALTYPE_LIST | MALTYPE_VECTOR)); seq_cursor c = seq_iter(params); list a = args; while (true) { if (!seq_cont(params, c)) { if (a) { make_error("'apply': expected %M, got [%N]", params, args); } break; } MalType parameter = seq_item(params, c); if (equal_forms(parameter, SYMBOL_AMPERSAND)) { c = seq_next(params, c); assert(seq_cont(params, c)); env_set(fn_env, seq_item(params, c), make_list(a)); break; } if (!a) { make_error("'apply': expected %M, got [%N]", params, args); } env_set(fn_env, parameter, a->data); c = seq_next(params, c); a = a->next; } return fn_env; } MalType EVAL(MalType ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: MalType dbgeval = env_get(env, SYMBOL_DEBUG_EVAL); if (dbgeval && (type(dbgeval) & ~(MALTYPE_FALSE | MALTYPE_NIL))) printf("EVAL: %50M env: %H\n", ast, env_as_map(env)); if (type(ast) == MALTYPE_SYMBOL) { MalType symbol_value = env_get(env, ast); if (symbol_value) return symbol_value; else make_error("'%M' not found", ast); } vector_t vec; if ((vec = is_vector(ast))) { return evaluate_vector(vec, env); // Implicit error propagation } hashmap map; if ((map = is_hashmap(ast))) { return evaluate_hashmap(map, env); // Implicit error propagation } /* not a list */ list lst; if (!is_list(ast, &lst)) { return ast; } /* empty list */ if(lst == NULL) { return ast; } /* list */ MalType first = lst->data; lst = lst->next; /* handle special symbols first */ if (type(first) & MALTYPE_SYMBOL) { special_t special = hashmap_get(specials, first); if (special) { ast = special(lst, &env); if (mal_error) return NULL; if(!env) { return ast; } goto TCE_entry_point; } } /* first element is not a special symbol */ MalType func = EVAL(first, env); if (mal_error) { return NULL; } check_type("apply phase", MALTYPE_CLOSURE | MALTYPE_FUNCTION | MALTYPE_MACRO, func); if (type(func) == MALTYPE_MACRO) { ast = apply(func, lst); if (mal_error) { return NULL; } goto TCE_entry_point; } // Evaluate the arguments list evlst = evaluate_list(lst, env); if (mal_error) return NULL; /* apply the first element of the list to the arguments */ MalClosure closure; if ((closure = is_closure(func))) { /* TCE - modify ast and env directly and jump back to eval */ ast = closure->fnstar_args->next->data; env = env_apply(closure, evlst); if (mal_error) return NULL; goto TCE_entry_point; } return apply(func, evlst); // Implicit error propagation } void PRINT(MalType val) { printf("%M\n", val); } void rep(const char* str, Env* env) { MalType a = READ(str); if (!mal_error) { MalType b = EVAL(a, env); if (!mal_error) { PRINT(b); return; } } MalType e = mal_error; mal_error = NULL; // before printing printf("Uncaught error: %M\n", e); } // Variant reporting errors during startup. void re(const char *str, Env* env) { MalType a = READ(str); if (!mal_error) { EVAL(a, env); if (!mal_error) { return; } } MalType result = mal_error; mal_error = NULL; // before printing printf("Error during startup: %M\n", result); exit(EXIT_FAILURE); } /* declare as global so it can be accessed by mal_eval */ Env* repl_env; MalType mal_eval(list args) { explode1("eval", args, ast); return EVAL(ast, repl_env); // Implicit error propagation } int main(int argc, char** argv) { types_init(); printer_init(); specials = map_empty(); specials = hashmap_put(specials, SYMBOL_DEF, eval_defbang); specials = hashmap_put(specials, SYMBOL_LET, eval_letstar); specials = hashmap_put(specials, SYMBOL_IF, eval_if); specials = hashmap_put(specials, SYMBOL_FN, eval_fnstar); specials = hashmap_put(specials, SYMBOL_DO, eval_do); specials = hashmap_put(specials, SYMBOL_QUOTE, eval_quote); specials = hashmap_put(specials, SYMBOL_QUASIQUOTE, eval_quasiquote); specials = hashmap_put(specials, SYMBOL_DEFMACRO, eval_defmacrobang); specials = hashmap_put(specials, SYMBOL_TRY, eval_try); repl_env = env_make(NULL); ns core; size_t core_size; ns_make_core(&core, &core_size); while(core_size--) { const char* symbol = core[core_size].key; function_t function = core[core_size].value; env_set(repl_env, make_symbol(symbol), make_function(function)); } env_set(repl_env, make_symbol("eval"), make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); /* make command line arguments available in the environment */ list lst = NULL; while(1 < --argc) { lst = list_push(lst, make_string(argv[argc])); } env_set(repl_env, make_symbol("*ARGV*"), make_list(lst)); env_set(repl_env, make_symbol("*host-language*"), make_string("c.2")); /* run in script mode if a filename is given */ if (argc) { /* first argument on command line is filename */ const char* load_command = mal_printf("(load-file \"%s\")", argv[1]); re(load_command, repl_env); } /* run in repl mode when no cmd line args */ else { /* Greeting message */ re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); const char* input; while((input = readline_gc(PROMPT_STRING))) { /* print prompt and get input*/ /* Check for EOF (Ctrl-D) */ /* call Read-Eval-Print */ rep(input, repl_env); } printf("\n"); } return EXIT_SUCCESS; } MalType eval_defbang(list lst, Env** env) { explode2("def!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) { return NULL; } check_type("def!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_letstar(list lst, Env** env) { explode2("let*", lst, bindings, forms); check_type("let*", MALTYPE_LIST | MALTYPE_VECTOR, bindings); seq_cursor bindings_list = seq_iter(bindings); Env* letstar_env = env_make(*env); /* evaluate the bindings */ while(seq_cont(bindings, bindings_list)) { MalType symbol = seq_item(bindings, bindings_list); bindings_list = seq_next(bindings, bindings_list); if(!seq_cont(bindings, bindings_list)) { bad_arg_count("let*", "an even number of binding pairs", bindings); } MalType value = EVAL(seq_item(bindings, bindings_list), letstar_env); /* early return from error */ if (mal_error) { return NULL; } check_type("let*", MALTYPE_SYMBOL, symbol); env_set(letstar_env, symbol, value); bindings_list = seq_next(bindings, bindings_list); } *env = letstar_env; return forms; } MalType eval_if(list lst, Env** env) { if (!lst) { bad_arg_count("if", "two or three arguments", lst); } MalType raw_condition = lst->data; list l1 = lst->next; if (!l1) { bad_arg_count("if", "two or three arguments", lst); } MalType then_form = l1->data; list l2 = l1->next; MalType else_form; if (l2) { else_form = l2->data; if (l2->next) { bad_arg_count("if", "two or three arguments", lst); } } else { else_form = NULL; } MalType condition = EVAL(raw_condition, *env); if (mal_error) { return NULL; } if (type(condition) & (MALTYPE_FALSE | MALTYPE_NIL)) { /* check whether false branch is present */ if(else_form) { return else_form; } else { *env = NULL; // no TCO return make_nil(); } } else { return then_form; } } MalType eval_do(list lst, Env** env) { /* handle empty 'do' */ if (!lst) { return make_nil(); } /* evaluate all but the last form */ while (lst->next) { EVAL(lst->data, *env); /* return error early */ if (mal_error) { return NULL; } lst = lst->next; } /* return the last form for TCE evaluation */ return lst->data; } MalType eval_quote(list lst, Env** env) { explode1("quote", lst, form); *env = NULL; // no TCO return form; } MalType eval_quasiquote(list lst, Env**) { explode1("quasiquote", lst, form); return quasiquote(form); // Implicit error propagation. } MalType quasiquote(MalType ast) { /* argument to quasiquote is a vector: (quasiquote [first rest]) */ list lst; vector_t vec; if ((vec = is_vector(ast))) { return quasiquote_vector(vec); // Implicit error propagation } /* argument to quasiquote is a list: (quasiquote (first rest)) */ else if (is_list(ast, &lst)){ if(lst) { MalType first = lst->data; if(equal_forms(first, SYMBOL_UNQUOTE)) { lst = lst->next; explode1("unquote", lst, unquoted); return unquoted; } } return quasiquote_list(lst); // Implicit error propagation } /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val) => (quote val) */ else if(type(ast) & (MALTYPE_HASHMAP | MALTYPE_SYMBOL)) { list lst = NULL; lst = list_push(lst, ast); lst = list_push(lst, SYMBOL_QUOTE); return make_list(lst); } /* argument to quasiquote is self-evaluating: (quasiquote val) => val */ else { return ast; } } MalType quasiquote_vector(vector_t vec) { MalType result = make_list(NULL); for (size_t i = vec->count; i--; ) { result = quasiquote_folder(vec->nth[i], result); if (mal_error) return NULL; } list lst = NULL; lst = list_push(lst, result); lst = list_push(lst, SYMBOL_VEC); return make_list(lst); } MalType quasiquote_list(list args) { /* handle empty list: (quasiquote ()) => () */ if (!args) { return make_list(NULL); } MalType first = args->data; MalType qq_rest = quasiquote_list(args->next); if(mal_error) return NULL; return quasiquote_folder(first, qq_rest); // Implicit error propagation. } MalType quasiquote_folder(MalType first, MalType qq_rest) { /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest)) => (concat first-second (quasiquote rest)) */ list lst; if(is_list(first, &lst)) { if(lst) { MalType lst_first = lst->data; if (equal_forms(lst_first, SYMBOL_SPLICE_UNQUOTE)) { lst = lst->next; explode1("splice-unquote", lst, unquoted); return make_list(list_push(list_push(list_push(NULL, qq_rest), unquoted), SYMBOL_CONCAT)); } } } MalType qqted = quasiquote(first); if(mal_error) return NULL; return make_list(list_push(list_push(list_push(NULL, qq_rest), qqted), SYMBOL_CONS)); } MalType eval_defmacrobang(list lst, Env** env) { explode2("defmacro!", lst, defbang_symbol, defbang_value); MalType result = EVAL(defbang_value, *env); if (mal_error) return NULL; MalClosure closure = is_closure(result); if (!closure) { bad_type("defmacro!", MALTYPE_CLOSURE, result); } result = make_macro(closure->env, closure->fnstar_args); check_type("defmacro!", MALTYPE_SYMBOL, defbang_symbol); env_set(*env, defbang_symbol, result); *env = NULL; // no TCO return result; } MalType eval_try(list lst, Env** env) { if (!lst) { bad_arg_count("try*", "one or two arguments", lst); } MalType try_clause = lst->data; list l = lst->next; if (!l) { /* no catch* clause */ return try_clause; } MalType catch_clause = l->data; if (l->next) { bad_arg_count("try*", "one or two arguments", lst); } /* process catch* clause */ check_type("try*", MALTYPE_LIST, catch_clause); list catch_list; if (!is_list(catch_clause, &catch_list)) { bad_type("try*", MALTYPE_LIST, catch_clause); } explode3("try*(catch clause)", catch_list, catch_symbol, a2, handler); if (!equal_forms(catch_symbol, SYMBOL_CATCH)) { make_error("'try*': catch* clause is missing catch* symbol: %M", catch_clause); } check_type("try*", MALTYPE_SYMBOL, a2); MalType try_result = EVAL(try_clause, *env); if(!mal_error) { *env = NULL; // prevent TCO return try_result; } /* bind the symbol to the exception */ Env* catch_env = env_make(*env); env_set(catch_env, a2, mal_error); mal_error = NULL; *env = catch_env; return handler; } list evaluate_list(list lst, Env* env) { list evlst = NULL; list* evlst_last = &evlst; while (lst) { MalType val = EVAL(lst->data, env); if (mal_error) { return NULL; } *evlst_last = list_push(NULL, val); evlst_last = &(*evlst_last)->next; lst = lst->next; } return evlst; } MalType evaluate_vector(vector_t lst, Env* env) { size_t capacity = lst->count; struct vector* evlst = vector_new(capacity); for (size_t i = 0; i < capacity; i++) { MalType new = EVAL(lst->nth[i], env); if (mal_error) return NULL; vector_append(&capacity, &evlst, new); } assert(evlst->count == capacity); return make_vector(evlst); } MalType evaluate_hashmap(hashmap lst, Env* env) { // map_empty() would be OK, but we know the size in advance and can // spare inefficient reallocations. struct map* evlst = map_copy(lst); for (map_cursor c = map_iter(lst); map_cont(lst, c); c = map_next(lst, c)) { MalType new = EVAL(map_val(lst, c), env); if (mal_error) return false; evlst = hashmap_put(evlst, map_key(lst, c), new); } return make_hashmap(evlst); } MalType eval_fnstar(list lst, Env** env) { if (!lst || !lst->next || lst->next->next) { bad_arg_count("fn*", "two parameters", lst); } MalType parameters = lst->data; check_type("fn*", MALTYPE_LIST | MALTYPE_VECTOR, parameters); for (seq_cursor c = seq_iter(parameters); seq_cont(parameters, c); c = seq_next(parameters, c)) { MalType val = seq_item(parameters, c); if (!is_symbol(val)) { bad_type("fn*", MALTYPE_SYMBOL, val); } if (equal_forms(val, SYMBOL_AMPERSAND)) { c = seq_next(parameters, c); if (!val) { make_error("'fn*': no symbol after &: '%N'", lst); } val = seq_item(parameters, c); /* & is found and there is a single symbol after */ check_type("fn*", MALTYPE_SYMBOL, val); /* & is found and there extra symbols after */ c = seq_next(parameters, c); if (seq_cont(parameters, c)) { make_error("'fn*': extra symbols after &: '%N'", lst); } break; } } Env* fn_env = *env; *env = NULL; // no TCO return make_closure(fn_env, lst); } /* used by core functions but not EVAL as doesn't do TCE */ MalType apply(MalType fn, list args) { function_t fun_ptr; if ((fun_ptr = is_function(fn))) { return (*fun_ptr)(args); // Implicit error propagation } else { MalClosure closure = is_closure(fn); if (!closure) closure = is_macro(fn); assert(closure); MalType ast = closure->fnstar_args->next->data; Env* env = env_apply(closure, args); if (mal_error) return NULL; return EVAL(ast, env); // Implicit error propagation } } ================================================ FILE: impls/c.2/tests/stepA_mal.mal ================================================ ;; Testing FFI of "strlen" (. nil "int32" "strlen" "string" "abcde") ;=>5 (. nil "int32" "strlen" "string" "") ;=>0 ;; Testing FFI of "strcmp" (. nil "int32" "strcmp" "string" "abc" "string" "abcA") ;=>-65 (. nil "int32" "strcmp" "string" "abcA" "string" "abc") ;=>65 (. nil "int32" "strcmp" "string" "abc" "string" "abc") ;=>0 ;; Testing FFI of "pow" (libm.so) (. "libm.so.6" "double" "pow" "double" 2.0 "double" 3.0) ;=>8.000000 (. "libm.so.6" "double" "pow" "double" 3.0 "double" 2.0) ;=>9.000000 ================================================ FILE: impls/c.2/types.c ================================================ #include #ifdef DEBUG_HASH # include "stdio.h" #endif #include #include #include "types.h" #include "vector.h" #include "hashmap.h" #include "linked_list.h" #ifdef DEBUG_HASH # include "printer.h" #endif struct MalType_s { enum mal_type_t type; union MalType_u { long mal_integer; double mal_float; struct { const char* s; size_t hash; } mal_string; struct { list l; MalType meta; } mal_list; struct { vector_t v; MalType meta; } mal_vector; struct { hashmap m; MalType meta; } mal_hashmap; struct { function_t f; MalType meta; } mal_function; struct { struct MalClosure_s c; MalType meta; } mal_closure; MalType mal_atom; } value; }; struct MalType_s THE_NIL = { MALTYPE_NIL, {0}}; struct MalType_s THE_TRUE = { MALTYPE_TRUE, {0}}; struct MalType_s THE_FALSE = { MALTYPE_FALSE, {0}}; bool is_nil(MalType val) { return val == &THE_NIL; } bool is_false(MalType val) { return val == &THE_FALSE; } bool is_true(MalType val) { return val == &THE_TRUE; } inline bool is_integer(MalType val, long* result) { bool ok = val->type & MALTYPE_INTEGER; if (ok) *result = val->value.mal_integer; return ok; } MalType make_integer(long value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_INTEGER, {.mal_integer=value}}; return mal_val; } inline bool is_float(MalType val, double* result) { bool ok = val->type & MALTYPE_FLOAT; if (ok) *result = val->value.mal_float; return ok; } MalType make_float(double value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_FLOAT, {.mal_float=value}}; return mal_val; } #define NO_HASH_YET (size_t)(-1) size_t hash(const char* s) { # ifdef DEBUG_HASH printf("HASH %s\n", s); # endif size_t h = 0; // 8 characters are sufficient to ensure distinct hashes for // "keyword" and "keyword?". for (size_t i = 0; i < 8; i++) { unsigned char c = s[i]; if (!c) break; h = h << 1 ^ c; # ifdef DEBUG_HASH printf("HASH %c %08b %064lb\n", c, c, h); # endif } return h; } inline const char* is_string(MalType val) { return val->type & MALTYPE_STRING ? val->value.mal_string.s : NULL; } MalType make_string(const char* value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_STRING, {.mal_string={value, NO_HASH_YET}}}; return mal_val; } inline const char* is_keyword(MalType val) { return val->type & MALTYPE_KEYWORD ? val->value.mal_string.s : NULL; } MalType make_keyword(const char* value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_KEYWORD, {.mal_string={value, NO_HASH_YET}}}; return mal_val; } inline const char* is_symbol(MalType val) { return val->type & MALTYPE_SYMBOL ? val->value.mal_string.s : NULL; } MalType make_symbol(const char* value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_SYMBOL, {.mal_string={value, NO_HASH_YET}}}; return mal_val; } inline bool is_list(MalType val, list* result) { bool ok = val->type & MALTYPE_LIST; if (ok) *result = val->value.mal_list.l; return ok; } MalType make_list_m(list value, MalType metadata) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_LIST, {.mal_list={value, metadata}}}; return mal_val; } inline MalType make_list(list value) { return make_list_m(value, &THE_NIL); } inline vector_t is_vector(MalType val) { return val->type & MALTYPE_VECTOR ? val->value.mal_vector.v : NULL; } MalType make_vector_m(vector_t value, MalType metadata) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_VECTOR, {.mal_vector={value, metadata}}}; return mal_val; } inline MalType make_vector(vector_t value) { return make_vector_m(value, &THE_NIL); } inline hashmap is_hashmap(MalType val) { return val->type & MALTYPE_HASHMAP ? val->value.mal_hashmap.m : NULL; } MalType make_hashmap_m(hashmap value, MalType metadata) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_HASHMAP, {.mal_hashmap={value, metadata}}}; return mal_val; } inline MalType make_hashmap(hashmap value) { return make_hashmap_m(value, &THE_NIL); } inline function_t is_function(MalType val) { return val->type & MALTYPE_FUNCTION ? val->value.mal_function.f : NULL; } MalType make_function_m(function_t value, MalType metadata) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_FUNCTION, {.mal_function={value, metadata}}}; return mal_val; } inline MalType make_function(function_t value) { return make_function_m(value, &THE_NIL); } inline MalClosure is_closure(MalType val) { return val->type & MALTYPE_CLOSURE ? &val->value.mal_closure.c : NULL; } MalType make_closure_m(const Env* env, list fnstar_args, MalType metadata) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_CLOSURE, {.mal_closure={{env, fnstar_args}, metadata}}}; return mal_val; } inline MalType make_closure(const Env* env, list fnstar_args) { return make_closure_m(env, fnstar_args, &THE_NIL); } inline MalClosure is_macro(MalType val) { return val->type & MALTYPE_MACRO ? &val->value.mal_closure.c : NULL; } MalType make_macro(const Env* env, list fnstar_args) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_MACRO, {.mal_closure={{env, fnstar_args}, &THE_NIL}}}; return mal_val; } inline MalType* is_atom(MalType val) { return val->type & MALTYPE_ATOM ? &val->value.mal_atom : NULL; } MalType make_atom(MalType value) { struct MalType_s* mal_val = GC_MALLOC(sizeof(*mal_val)); *mal_val = (struct MalType_s){MALTYPE_ATOM, {.mal_atom=value}}; return mal_val; } MalType meta(MalType form) { switch (form->type) { case MALTYPE_LIST : return form->value.mal_list .meta; case MALTYPE_VECTOR : return form->value.mal_vector .meta; case MALTYPE_HASHMAP : return form->value.mal_hashmap .meta; case MALTYPE_FUNCTION: return form->value.mal_function.meta; case MALTYPE_CLOSURE : return form->value.mal_closure .meta; default: return &THE_NIL; } } inline enum mal_type_t type(MalType val) { return val->type; } inline size_t get_hash(MalType form) { assert(form->type & (MALTYPE_KEYWORD | MALTYPE_STRING | MALTYPE_SYMBOL)); if(form->value.mal_string.hash == NO_HASH_YET) { form->value.mal_string.hash = hash(form->value.mal_string.s); } return form->value.mal_string.hash; } void* mal_type_value_address(MalType form) { switch (form->type) { case MALTYPE_NIL: case MALTYPE_INTEGER: return (void*)&form->value.mal_integer; case MALTYPE_STRING: return (void*)&form->value.mal_string.s; case MALTYPE_FLOAT: return (void*)&form->value.mal_integer; default: assert(false); return NULL; // silent a warning when NDEBUG. } } bool equal_forms(MalType first, MalType second) { // Compare strings as soon as possible because EVAL, map_get and // env_get call this function often. Conclude early if the hashes // do not match. if (first->type & (MALTYPE_LIST | MALTYPE_VECTOR)) { if (second->type & ~ (MALTYPE_LIST | MALTYPE_VECTOR)) return false; seq_cursor c2 = seq_iter(second); for (seq_cursor c1 = seq_iter(first); seq_cont(first, c1); c1 = seq_next(first, c1)) { if (!seq_cont(second, c2) || !equal_forms(seq_item(first, c1), seq_item(second, c2))) return false; c2 = seq_next(second, c2); } return !seq_cont(second, c2); } if (first->type != second->type) return false; if (first->type & (MALTYPE_KEYWORD | MALTYPE_STRING | MALTYPE_SYMBOL)) { // via get_hash because the hash may not be computed yet. return get_hash(first) == get_hash(second) && !strcmp(first->value.mal_string.s, second->value.mal_string.s); } if (first->type & (MALTYPE_NIL | MALTYPE_FALSE | MALTYPE_TRUE)) return true; if (first->type == MALTYPE_INTEGER) { return first->value.mal_integer == second->value.mal_integer; } if (first->type == MALTYPE_FLOAT) { return first->value.mal_float == second->value.mal_float; } if (first->type == MALTYPE_HASHMAP) { hashmap m1 = first->value.mal_hashmap.m; hashmap m2 = second->value.mal_hashmap.m; if (map_count(m1) != map_count(m2)) return false; for (map_cursor c = map_iter(m1); map_cont(m1, c); c = map_next(m1, c)) { MalType val2 = hashmap_get(m2, map_key(m1, c)); if (!val2 || !equal_forms(map_val(m1, c), val2)) return false; } return true; } return false; } MalType SYMBOL_AMPERSAND; MalType SYMBOL_CATCH; MalType SYMBOL_CONCAT; MalType SYMBOL_CONS; MalType SYMBOL_DEBUG_EVAL; MalType SYMBOL_DEF; MalType SYMBOL_DEFMACRO; MalType SYMBOL_DEREF; MalType SYMBOL_DO; MalType SYMBOL_FN; MalType SYMBOL_IF; MalType SYMBOL_LET; MalType SYMBOL_QUASIQUOTE; MalType SYMBOL_QUOTE; MalType SYMBOL_SPLICE_UNQUOTE; MalType SYMBOL_TRY; MalType SYMBOL_UNQUOTE; MalType SYMBOL_VEC; MalType SYMBOL_WITH_META; void types_init() { SYMBOL_AMPERSAND = make_symbol("&"); SYMBOL_CATCH = make_symbol("catch*"); SYMBOL_CONCAT = make_symbol("concat"); SYMBOL_CONCAT = make_symbol("concat"); SYMBOL_CONS = make_symbol("cons"); SYMBOL_DEBUG_EVAL = make_symbol("DEBUG-EVAL"); SYMBOL_DEF = make_symbol("def!"); SYMBOL_DEFMACRO = make_symbol("defmacro!"); SYMBOL_DEREF = make_symbol("deref"); SYMBOL_DO = make_symbol("do"); SYMBOL_FN = make_symbol("fn*"); SYMBOL_IF = make_symbol("if"); SYMBOL_LET = make_symbol("let*"); SYMBOL_QUASIQUOTE = make_symbol("quasiquote"); SYMBOL_QUOTE = make_symbol("quote"); SYMBOL_SPLICE_UNQUOTE = make_symbol("splice-unquote"); SYMBOL_TRY = make_symbol("try*"); SYMBOL_UNQUOTE = make_symbol("unquote"); SYMBOL_VEC = make_symbol("vec"); SYMBOL_WITH_META = make_symbol("with-meta"); } inline MalType make_true() { return &THE_TRUE; } inline MalType make_false() { return &THE_FALSE; } inline MalType make_nil() { return &THE_NIL; } ================================================ FILE: impls/c.2/types.h ================================================ #ifndef _MAL_TYPES_H #define _MAL_TYPES_H #include // The order must match the one in printer.c. enum mal_type_t { MALTYPE_SYMBOL = 1 << 0, MALTYPE_KEYWORD = 1 << 1, MALTYPE_INTEGER = 1 << 2, MALTYPE_FLOAT = 1 << 3, MALTYPE_STRING = 1 << 4, MALTYPE_TRUE = 1 << 5, MALTYPE_FALSE = 1 << 6, MALTYPE_NIL = 1 << 7, MALTYPE_LIST = 1 << 8, MALTYPE_VECTOR = 1 << 9, MALTYPE_HASHMAP = 1 << 10, MALTYPE_FUNCTION = 1 << 11, MALTYPE_CLOSURE = 1 << 12, MALTYPE_ATOM = 1 << 13, MALTYPE_MACRO = 1 << 14, }; typedef struct MalType_s* MalType; typedef const struct MalClosure_s* MalClosure; typedef struct pair_s* list; // mutable for appends typedef MalType(*function_t)(list); typedef struct Env_s Env; typedef const struct map* hashmap; typedef const struct vector* vector_t; struct MalClosure_s { const Env* env; list fnstar_args; // (parameters body) // parameters is a list or vector of symbols // If "&" is present, it stands right before the last symbol. }; MalType make_symbol(const char* value); MalType make_integer(long value); MalType make_float(double value); MalType make_keyword(const char* value); MalType make_string(const char* value); MalType make_list(list value); MalType make_list_m(list value, MalType meta); MalType make_vector(vector_t value); MalType make_vector_m(vector_t value, MalType meta); MalType make_hashmap(hashmap value); MalType make_hashmap_m(hashmap value, MalType meta); MalType make_true(); MalType make_false(); MalType make_nil(); MalType make_atom(MalType value); MalType make_function_m(function_t value, MalType meta); MalType make_function(function_t value); MalType make_closure_m(const Env* env, list fnstar_args, MalType meta); MalType make_closure(const Env* env, list fnstar_args); MalType make_macro(const Env* env, list fnstar_args); // A NULL result means that the type differs, except for lists. bool is_list(MalType val, list*); vector_t is_vector(MalType val); hashmap is_hashmap(MalType val); bool is_nil(MalType val); const char* is_string(MalType val); bool is_false(MalType val); const char* is_symbol(MalType val); const char* is_keyword(MalType val); function_t is_function(MalType val); MalClosure is_closure(MalType val); MalClosure is_macro(MalType val); bool is_integer(MalType val, long*); bool is_float(MalType val, double*); MalType* is_atom(MalType val); bool is_true(MalType val); enum mal_type_t type(MalType); MalType meta(MalType); // Returns nil for types without metadata. size_t get_hash(MalType); // Crashes for types without hash. // These parts could be implemented outside types, but improve // readability in core, hashmap and steps. // This also improves efficiency because // a lost of allocations of the same symbol are avoided // amost symbol comparisons in EVAL will only need the precomputed hash. bool equal_forms(MalType, MalType); extern MalType SYMBOL_AMPERSAND; extern MalType SYMBOL_CATCH; extern MalType SYMBOL_CONCAT; extern MalType SYMBOL_CONS; extern MalType SYMBOL_DEBUG_EVAL; extern MalType SYMBOL_DEF; extern MalType SYMBOL_DEFMACRO; extern MalType SYMBOL_DEREF; extern MalType SYMBOL_DO; extern MalType SYMBOL_FN; extern MalType SYMBOL_IF; extern MalType SYMBOL_LET; extern MalType SYMBOL_QUASIQUOTE; extern MalType SYMBOL_QUOTE; extern MalType SYMBOL_SPLICE_UNQUOTE; extern MalType SYMBOL_TRY; extern MalType SYMBOL_UNQUOTE; extern MalType SYMBOL_VEC; extern MalType SYMBOL_WITH_META; void types_init(); // Evil trick for FFI. // Should at least be const void*. void* mal_type_value_address(MalType); #endif ================================================ FILE: impls/c.2/vector.c ================================================ #include #include #include "linked_list.h" #include "vector.h" struct vector* vector_new(size_t capacity) { struct vector* v = GC_MALLOC(sizeof(*v) + capacity*sizeof(MalType)); v->count = 0; return v; } void vector_append(size_t* capacity, struct vector** v, MalType new_item) { if ((*v)->count == *capacity) { // + 1 in case capacity is 0. *capacity = (*capacity + 1) << 1; *v = GC_REALLOC(*v, sizeof(**v) + *capacity * sizeof(MalType)); } (*v)->nth[(*v)->count++] = new_item; } seq_cursor seq_iter(MalType container) { list l; if (is_list(container, &l)) { return (seq_cursor){.l=l}; } else { assert(type(container) == MALTYPE_VECTOR); return (seq_cursor){.i=0}; } } bool seq_cont(MalType container, seq_cursor position) { assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); vector_t v; if ((v = is_vector(container))) { return position.i < v->count; } else { return position.l != NULL; } } seq_cursor seq_next(MalType container, seq_cursor position) { assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); vector_t v; if ((v = is_vector(container))) { assert(position.i < v->count); return (seq_cursor){.i=position.i + 1}; } else { return (seq_cursor){.l=position.l->next}; } } MalType seq_item(MalType container, seq_cursor position) { assert(type(container) & (MALTYPE_LIST | MALTYPE_VECTOR)); vector_t v; if ((v = is_vector(container))) { assert(position.i < v->count); return v->nth[position.i]; } else { return position.l->data; } } ================================================ FILE: impls/c.2/vector.h ================================================ #ifndef MAL_VECTOR_H #define MAL_VECTOR_H #include #include "types.h" // typedef const struct vector* vector_t; struct vector { size_t count; MalType nth[]; }; struct vector* vector_new(size_t capacity); // The capacity first additions cause no reallocation. void vector_append(size_t* capacity, struct vector** v, MalType new_item); // Convenient way to iterate either on a list or a vector. // The same (unmodified) container must be be provided to each // function during iteration. // It must be a list or a vector. typedef union seq_cursor { list l; size_t i; } seq_cursor; seq_cursor seq_iter(MalType); bool seq_cont(MalType, seq_cursor); seq_cursor seq_next(MalType, seq_cursor); MalType seq_item(MalType, seq_cursor); #endif ================================================ FILE: impls/chuck/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python # Some typical implementation and test requirements RUN apt-get -y install curl RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Chuck RUN apt-get -y install bison gcc g++ flex RUN apt-get -y install libasound2-dev libsndfile1-dev RUN cd /tmp && curl -O https://chuck.cs.princeton.edu/release/files/chuck-1.5.2.5.tgz \ && tar xvzf /tmp/chuck-1.5.2.5.tgz && cd chuck-1.5.2.5/src \ && make linux-alsa && make install \ && rm -r /tmp/chuck-1.5.2.5* RUN cd /tmp && curl -Lo chugins-chuck-1.5.2.5.tgz https://github.com/ccrma/chugins/archive/refs/tags/chuck-1.5.2.5.tar.gz \ && tar xvzf /tmp/chugins-chuck-1.5.2.5.tgz && cd chugins-chuck-1.5.2.5/RegEx \ && make linux && mkdir -p /usr/local/lib/chuck/1.5.2.5 \ && cp RegEx.chug /usr/local/lib/chuck/1.5.2.5/RegEx.chug \ && rm -r /tmp/chugins-chuck-1.5.2.5* ENV HOME /mal ================================================ FILE: impls/chuck/Makefile ================================================ all: clean: .PHONY: all clean ================================================ FILE: impls/chuck/chuck.md ================================================ - I've found a potential bug in their substring function: https://github.com/ccrma/chuck/issues/55 - later I've found one in their regex replace function, too: https://github.com/ccrma/chuck/issues/60 - this suggests there hasn't been much testing done on things unrelated to audio which is not that unexpected in an audio programming language, but still... - the manual isn't up to date, so you need to look at `VERSIONS` and the examples instead, sometimes the sources, too - the manual only speaks of the debug syntax for printing (`<<>>;` which goes to stderr), I've found a `chout` object you can send strings to for outputting to stdout - quitting is done via `C-c` only - you'll want to use `--silent` to disable audio errors/processing, but then the process will use 100% CPU and ignore any waiting - stdin handling is terrible: - the manual shows a keyboard example with HID devices, but it doesn't work on linux - there's a "hacked" `ConsoleInput` class with only an example file for it, it works for most of the part, but doesn't accept `C-d` - the obvious alternative is printing a prompt manually, then waiting for `KBHit` events and printing them, but that's rather tedious as you'd have to convert the ascii numbers into chars yourself and make a buffer-like thing - I've also considered writing a thing sending OSC events per keyboard hit and processing these in ChucK as they come in, but that would most likely not work with the test harness ._. - the OOP system is seriously weird - influenced by C++ *and* java - one public class per file - to export functionality, you must use a public class (and static functions/variables) - if you use static variables, you can't assign values to them directly, you'll have to do that after the class has been defined - worse, you can't even declare anything that's not a primitive, so if you want to declare a reference type, use the reference operator instead... - no interfaces - no generics (copy/paste code for all types you need!) - no unions (use Object, then cast to the correct type) - there is no obvious way of casting to arrays of types - no private (things are public by default, public keyword is used to export code) - no self-references in classes (so no trees, static "constructors" work though) - no meaningful way of working with null for primitive types (mutate a reference and look at the return code instead) - no boxed versions of primitive types - no automatic boxing/unboxing - no upcasting/downcasting - No module system - `Machine.add(file)` is the only mechanism available from code (no read all file contents and eval), but if you use it, it defers loading the files until the file it's used in, rendering it useless - Therefore the only way to make use of it is writing a file that only consists of these instructions - The only practical alternative is specifying all files you need loaded in the right order when starting chuck - That's why I wrote a runner script extracting `// @import file.ck` lines (hello JS!) and running chuck with them - No real exception system - The VM is able to throw exceptions (out of bounds, nullpointer), but you can't do anything about them and only get a hint what kind of operation caused it (no stacktrace or anything) - No user-definable exceptions, no mechanism to catch or throw them (other than intentionally doing something illegal) - This means that you should use C-style error checking by converting the potentially erroneous functions into returning a status code and mutating a reference passed to them as argument which is highly weird in a otherwise Java-like language - An alternative is defining an error object (which belongs to the same supertype as the other legal return values) and checking its type by inspecting the user-tracked type field - No function pointers/functors/closures - This is a bit unexpected as if you leave away the parentheses holding the argument list and debug print a function, you'll see it being recognized as a function, yet you can't store it anywhere for passing it around - This is not quite right as you can store it in an `Object`, just not call it in any way or cast it to a function type - So you get to implement functors and closures yourself... - A functor is a class with a call method taking an argument list and executing the code of the function you intend to pass around - To use it, store an instance of its class somewhere, then use its call method with an argument list - Closures can be implemented with a data structure holding a snapshot of the current environment, the parameter list and AST, the last two being a way of representing an anonymous function. - Other oddities - strict distinction between assigning values and references with two separate operators for them (`<<` for array append doesn't seem to care though) - strings are supposedly reference types, yet you can assign them with the regular operator... - `<<` on an `type[]` gives you a weird error as you need to use an `type[0]` (and a `type[]` is merely a reference...) - The compiler will find lots of mistakes for you, but cannot figure out code branches not returning anything which means that return type violations will blow up in your face unless there's a reasonable default value (null for `Object` isn't, 0 for `int` and "" for `string` is) - If you abuse the type system too much, chances are you get a segfault or assert instead of an exception... - Debug print shows the object and its type if you pass one argument, if you pass more than one, it prints the concatenation of their representations instead, so it's a bit hard to make out what is a debug print and what isn't - there are no hash maps, just the possibility to use a string key on an array for storing and fetching contents (like in PHP, eww) and no way of retrieving keys/values or even iterating over these - I think I've spotted a weird scoping bug that prefers a member variable over a local variable after nesting scopes, therefore I consider the language to not implement proper lexical scoping - another proof of it is declaring variables in consequent if-blocks as that gives you an error instead of being permitted as they should be in different local scopes... ================================================ FILE: impls/chuck/core.ck ================================================ public class Core { static string names[]; static MalSubr ns[]; } ["+", "-", "*", "/", "list", "list?", "empty?", "count", "=", "<", "<=", ">", ">=", "pr-str", "str", "prn", "println", "read-string", "slurp", "atom", "atom?", "deref", "reset!", "swap!", "vec", "cons", "concat", "nth", "first", "rest", "throw", "apply", "map", "nil?", "true?", "false?", "number?", "symbol?", "keyword?", "vector?", "map?", "symbol", "keyword", "vector", "hash-map", "assoc", "dissoc", "get", "contains?", "keys", "vals", "sequential?", "fn?", "macro?", "readline", "meta", "with-meta", "time-ms", "conj", "string?", "seq"] @=> Core.names; MalSubr ns[0] @=> Core.ns; new MalAdd @=> Core.ns["+"]; new MalSub @=> Core.ns["-"]; new MalMul @=> Core.ns["*"]; new MalDiv @=> Core.ns["/"]; new MalListify @=> Core.ns["list"]; new MalIsList @=> Core.ns["list?"]; new MalIsEmpty @=> Core.ns["empty?"]; new MalCount @=> Core.ns["count"]; new MalEqual @=> Core.ns["="]; new MalLess @=> Core.ns["<"]; new MalLessEqual @=> Core.ns["<="]; new MalGreater @=> Core.ns[">"]; new MalGreaterEqual @=> Core.ns[">="]; new MalPrStr @=> Core.ns["pr-str"]; new MalStr @=> Core.ns["str"]; new MalPrn @=> Core.ns["prn"]; new MalPrintln @=> Core.ns["println"]; new MalReadStr @=> Core.ns["read-string"]; new MalSlurp @=> Core.ns["slurp"]; new MalAtomify @=> Core.ns["atom"]; new MalIsAtom @=> Core.ns["atom?"]; 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"]; new MalNth @=> Core.ns["nth"]; new MalFirst @=> Core.ns["first"]; new MalRest @=> Core.ns["rest"]; new MalThrow @=> Core.ns["throw"]; new MalApply @=> Core.ns["apply"]; new MalMap @=> Core.ns["map"]; new MalIsNil @=> Core.ns["nil?"]; new MalIsTrue @=> Core.ns["true?"]; new MalIsFalse @=> Core.ns["false?"]; new MalIsNumber @=> Core.ns["number?"]; new MalIsSymbol @=> Core.ns["symbol?"]; new MalIsKeyword @=> Core.ns["keyword?"]; new MalIsVector @=> Core.ns["vector?"]; new MalIsHashMap @=> Core.ns["map?"]; new MalSymbolify @=> Core.ns["symbol"]; new MalKeywordify @=> Core.ns["keyword"]; new MalVectorify @=> Core.ns["vector"]; new MalHashMapify @=> Core.ns["hash-map"]; new MalAssoc @=> Core.ns["assoc"]; new MalDissoc @=> Core.ns["dissoc"]; new MalGet @=> Core.ns["get"]; new MalIsContains @=> Core.ns["contains?"]; new MalKeys @=> Core.ns["keys"]; new MalVals @=> Core.ns["vals"]; new MalSequential @=> Core.ns["sequential?"]; new MalIsFn @=> Core.ns["fn?"]; new MalIsMacro @=> Core.ns["macro?"]; new MalReadline @=> Core.ns["readline"]; new MalMeta @=> Core.ns["meta"]; new MalWithMeta @=> Core.ns["with-meta"]; new MalTimeMs @=> Core.ns["time-ms"]; new MalConj @=> Core.ns["conj"]; new MalIsString @=> Core.ns["string?"]; new MalSeq @=> Core.ns["seq"]; ================================================ FILE: impls/chuck/env.ck ================================================ public class Env extends MalObject { MalObject outer; // this would ideally be Env, but isn't supported MalObject data[0]; fun void init(MalObject env) { env @=> outer; } fun void init(MalObject env, string binds[], MalObject exprs[]) { env @=> outer; for( 0 => int i; i < binds.size(); i++ ) { binds[i] => string bind; if( bind == "&" ) { MalObject.slice(exprs, i) @=> MalObject rest_binds[]; MalList.create(rest_binds) @=> data[binds[i+1]]; break; } else { exprs[i] @=> data[bind]; } } } fun static Env create(MalObject env) { Env e; e.init(env); return e; } fun static Env create(MalObject env, string binds[], MalObject exprs[]) { Env e; e.init(env, binds, exprs); return e; } fun MalObject clone() { Env value; this.outer @=> value.outer; this.data @=> value.data; return value; } fun void set(string key, MalObject value) { value @=> data[key]; } fun MalObject find(string key) { data[key] @=> MalObject value; if( value != null ) { return value; } else if( outer != null ) { return (outer$Env).find(key); } else { return null; } } fun MalObject get(string key) { find(key) @=> MalObject value; if( value != null ) { return value; } else { return MalError.create("'" + key + "' not found"); } } } ================================================ FILE: impls/chuck/func.ck ================================================ public class Func extends MalObject { "func" => type; Env env; string args[]; MalObject ast; int isMacro; fun void init(Env env, string args[], MalObject ast) { env @=> this.env; args @=> this.args; ast @=> this.ast; } fun static Func create(Env env, string args[], MalObject ast) { Func func; func.init(env, args, ast); return func; } fun MalObject clone() { Func value; this.type => value.type; this.env @=> value.env; this.args @=> value.args; this.ast @=> value.ast; this.isMacro @=> value.isMacro; return value; } } ================================================ FILE: impls/chuck/notes.md ================================================ # Step 1 - What if I don't have an OOP language? - types.qx could be more prominently mentioned... - A table with all types and suggested object names would be hugely useful - Same for a list of all errors and their messages - Mention return types and argument types consistently - More on int/float and their grammar (int is mentioned implicitly in the ASCII art, nothing on signs or bases or their lack of) - Note that a string must be parsed for the `print_readably` thing to work and mention how one could do that (like, by using a `read` or `eval`-like thing or alternatively, chopping off the surrounding quotes and doing the inverse transformation of the printing) - How is an atom printed? # Step 2 - What if my language doesn't support lambdas, let alone passing around named functions? Ideally write something about implementing/using functors/delegates or replacing that namespace with a big switch as with VHDL. Another problem is that if you choose a different solution in step 4, step 2 could end up no longer functional... - What kind of error (read: what message?) is raised when no value can be looked up for the symbol? Is it arbitrary? Do I need to extend my error handling to allow for format strings? - It would be worth a mention that you should extend the printer to handle "native" functions (or in oldtimey terms, subrs) # Step 3 - You should modify both eval_ast *and* EVAL - Suggest the trick with destructuring the AST into `a0`, `a1`, etc. variables for easier access. Perhaps this can be used to clear up the general language used with AST manipulation (like, first parameter and second list element)? - What does def! return? Emacs Lisp for instance returns the symbol whereas the tests suggest the value should be returned instead... # Step 4 - "Implement the strings functions" - The "no closures" paragraph isn't quite clear. Asides from that, do native functions don't really need to be wrapped the same way as the `fn*` objects, just introduce another type (like, a Subr and a Func type) and do a check before applying the arguments to it - Why does the guide say that the first argument of `count` can be treated as list, yet there's a test performing `(count nil)` and expecting zero as result? - Does it make sense to compare, say, atoms in `=`? # Step 5 - "This is especially important in Lisp languages because they tend to prefer using recursion instead of iteration for control structures." <- I'd argue it's less of a lisp thing (see everything else related to CL) and more a thing functional programming proponents have considered more elegant than introducing iteration constructs (see haskell, ocaml, erlang) - It's not really clear that the TCO change for `let*` involves the form you'd normally pass to `EVAL` to become the new `ast`. I had to reread this a few more times to understand that the "second `ast`" is actually its third argument... - Where did the check for `do` not being broken by TCO go? - What's the deal with the `quux/tests/step5_tco.qx` file? # Step 6 - "The closure calls the your EVAL function […]." - I still don't have any closures. How the heck do I implement `eval`? What about `swap!`? - It would be useful to mention that `swap!` sort of requires implementing `apply` first... # Step 7 - Why the scare quotes for splicing? - "Before implementing the quoting forms, you will need to implement some supporting functions in the core namespace:" should be one list item - "this function takes a list as its second parameter and returns a new list that has the first argument prepended to it." reads backwards - The quasiquote paragraph is hard to read - It's rather confusing to refer to the argument of `ast` and to an `ast` parameter, perhaps name the latter a form? - What could also help would be a visualization of the four conditionals: - \`42, \`() - \`~foo - \`(~@foo) and more - \`(42 ~@foo) and everything else - Mal/mal is inconsistently capitalized - "Expand the conditional with reader `read_form` function to add the following four cases" is again weird, better refer to the `read_form` function in reader.qx - "concat should support concatenation of lists, vectors, or a mix or both." <- "or a mix or both" is redundant # Step 8 - "In the previous step, quoting enabled some simple manipulation [of] data structures" - The macroexpand function step refers to call/apply, it's unclear how to proceed if you don't have such a thing - How should the exception for invalid `nth` access look like? Also, why is it an exception and not an error like with the reader? - How can `first` take a list (or vector), but work on `nil`? - The description of `rest` is inconsistent with the tests - "In the main program, use the rep function to define two new control structures macros." - Why does the definition of `cond` use `throw` although it's only introduced in the next chapter? # Step 9 - It's not really clear that you really just have a `try*` special form, with `catch*` merely existing inside it... - Another thing to clarify is that the exception value is a string containing the message you'd see (unless you're using `throw`) - Generally, it would be better to explain the general exception handling mechanism (with some examples), then showing how one implements it for both languages with and without exceptions - Another way than using a global variable is introducing an error type next to the other MAL types and checking whether something a function returned is one, although the hint about returning one at each use of `EVAL` still stands... - Shouldn't either trick be mentioned at the beginning, simply because you'll need it in a language without exceptions to do error handling? - Why this bizarre treatment for `keyword`? Why is there no test for it? - Is there a test for whether hash maps deduplicate identical keys when using `hash-map` or `assoc`? - What exactly are keys the specification for `dissoc`, `get` and `contains?` are speaking of? Can I assume these are either strings or keywords? - Why is it not documented that `get` may take `nil` instead of a map? - Perhaps it's worth adding more tests involving symbols to ensure that functions using apply internally don't evaluate their args? # Step A - "Add meta-data support to mal functions." <- Shouldn't you mention that this involves implementing `with-meta` and `meta`? - "TODO. Should be separate from the function macro flag." <- Why is this even related? - It would be worth to mention that `with-meta` shall clone its argument to avoid one of the more sneaky test failure reasons - "The value of this entry should be a mal string containing the name of the current implementation." - "When the REPL starts up (as opposed to when it is called with a script and/or arguments), call the rep function with this string to print a startup header: `"(println (str \"Mal [\" *host-language* \"]\"))".`" <- proof that you better quote these because the asterisks just disappear... ================================================ FILE: impls/chuck/printer.ck ================================================ public class Printer { fun static string pr_str(MalObject m, int print_readably) { m.type => string type; if( type == "true" || type == "false" || type == "nil" ) { return type; } else if( type == "int" ) { return Std.itoa(m.intValue); } else if( type == "string" ) { if( print_readably ) { return String.repr(m.stringValue); } else { return m.stringValue; } } else if( type == "symbol" ) { return m.stringValue; } else if( type == "keyword" ) { return ":" + m.stringValue; } else if( type == "atom" ) { return "(atom " + pr_str(m.malObjectValue(), print_readably) + ")"; } else if( type == "subr" ) { return "#"; } else if( type == "func" ) { return "#"; } else if( type == "list" ) { return pr_list(m.malObjectValues(), print_readably, "(", ")"); } else if( type == "vector" ) { return pr_list(m.malObjectValues(), print_readably, "[", "]"); } else if( type == "hashmap" ) { return pr_list(m.malObjectValues(), print_readably, "{", "}"); } else { return "Unknown type"; } } fun static string pr_list(MalObject m[], int print_readably, string start, string end) { string parts[m.size()]; for( 0 => int i; i < m.size(); i++ ) { pr_str(m[i], print_readably) => parts[i]; } return start + String.join(parts, " ") + end; } } ================================================ FILE: impls/chuck/reader.ck ================================================ public class Reader { 0 => int position; string tokens[]; fun string peek() { return tokens[position]; } fun string next() { return tokens[position++]; } fun static string[] tokenizer(string input) { "^[ \n,]*(~@|[][{}()'`~^@]|\"(\\\\.|[^\\\"])*\"|;[^\n]*|[^][ \n{}()^~@'`,;\"]*)" => string tokenRe; "^([ \n,]*|;[^\n]*)$" => string blankRe; string tokens[0]; while( true ) { string matches[1]; RegEx.match(tokenRe, input, matches); matches[1] => string token; if( token.length() == 0 && !RegEx.match(blankRe, input) ) { tokens << input; break; } if( !RegEx.match(blankRe, token) ) { tokens << token; } matches[0].length() => int tokenStart; String.slice(input, tokenStart) => input; if( input.length() == 0 ) { break; } } return tokens; } fun static MalObject read_str(string input) { Reader reader; tokenizer(input) @=> reader.tokens; if( reader.tokens.size() == 0 ) { return MalError.create("empty input"); } else { return read_form(reader); } } fun static MalObject read_form(Reader reader) { reader.peek() => string token; if( token == "(" ) { return read_list(reader, "(", ")"); } else if( token == "[" ) { return read_list(reader, "[", "]"); } else if( token == "{" ) { return read_list(reader, "{", "}"); } else if( token == ")" || token == "]" || token == "}" ) { return MalError.create("unexpected '" + token + "'"); } else if( token == "'" ) { return read_simple_reader_macro(reader, "quote"); } else if( token == "`" ) { return read_simple_reader_macro(reader, "quasiquote"); } else if( token == "~" ) { return read_simple_reader_macro(reader, "unquote"); } else if( token == "~@" ) { return read_simple_reader_macro(reader, "splice-unquote"); } else if( token == "@" ) { return read_simple_reader_macro(reader, "deref"); } else if( token == "^" ) { return read_meta_reader_macro(reader); } else { return read_atom(reader); } } fun static MalObject read_list(Reader reader, string start, string end) { MalObject items[0]; reader.next(); // discard list start token while( true ) { // HACK: avoid checking for reader.peek() returning null // (as doing that directly isn't possible and too // bothersome to do indirectly) if( reader.position == reader.tokens.size() ) { return MalError.create("expected '" + end + "', got EOF"); } if( reader.peek() == end ) { break; } read_form(reader) @=> MalObject item; if( item.type == "error" ) { return item; } else { items << item; } } reader.next(); // discard list end token if( start == "(" ) { return MalList.create(items); } else if( start == "[" ) { return MalVector.create(items); } else if( start == "{" ) { return MalHashMap.create(items); } else { Util.panic("Programmer error (failed to specify correct start token)"); return null; } } fun static MalObject read_atom(Reader reader) { "^[+-]?[0-9]+$" => string intRe; "^\"(\\\\.|[^\\\"])*\"$" => string stringRe; reader.next() => string token; if( token == "true" ) { return Constants.TRUE; } else if( token == "false" ) { return Constants.FALSE; } else if( token == "nil" ) { return Constants.NIL; } else if( RegEx.match(intRe, token) ) { return MalInt.create(Std.atoi(token)); } else if( token.substring(0, 1) == "\"" ) { if( RegEx.match(stringRe, token) ) { return MalString.create(String.parse(token)); } else { return MalError.create("expected '\"', got EOF"); } } else if( token.substring(0, 1) == ":" ) { return MalKeyword.create(String.slice(token, 1)); } else { return MalSymbol.create(token); } } fun static MalObject read_simple_reader_macro(Reader reader, string symbol) { reader.next(); // discard reader macro token read_form(reader) @=> MalObject form; if( form.type == "error" ) { return form; } return MalList.create([MalSymbol.create(symbol), form]); } fun static MalObject read_meta_reader_macro(Reader reader) { reader.next(); // discard reader macro token read_form(reader) @=> MalObject meta; if( meta.type == "error" ) { return meta; } read_form(reader) @=> MalObject form; if( form.type == "error" ) { return meta; } return MalList.create([MalSymbol.create("with-meta"), form, meta]); } } ================================================ FILE: impls/chuck/readline.ck ================================================ public class Readline { fun static string readline(string prompt) { int done; string input; KBHit kb; int char; string repr; ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", " ", "!", "\"", "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ":", ";", "<", "=", ">", "?", "@", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "[", "\\", "]", "^", "_", "`", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "{", "|", "}", "~", "DEL"] @=> string asciiTable[]; chout <= prompt; chout.flush(); while( !done ) { kb => now; while( kb.more() && !done ) { kb.getchar() => char; asciiTable[char] => repr; if( repr == "EOT" || repr == "LF" || repr == "CR" ) { true => done; } else if( repr == "DEL" && Std.getenv("TERM") != "dumb") { if( input.length() > 0) { chout <= "\033[1D\033[0K"; chout.flush(); input.substring(0, input.length()-1) => input; } } else { chout <= repr; chout.flush(); repr +=> input; } } } chout <= "\n"; if( repr == "EOT" ) { return null; } return input; } } ================================================ FILE: impls/chuck/run ================================================ #!/usr/bin/env bash regex_chugin=${REGEX_CHUGIN:-/usr/local/lib/chuck/1.5.2.5/RegEx.chug} if [[ ! -f "$regex_chugin" ]]; then echo "Set \$REGEX_CHUGIN to the absolute path of RegEx.chug"; exit 1 fi imports=$(grep "^ *// *@import" "$(dirname $0)/${STEP:-stepA_mal}.ck" | awk '{print $3}') imports=$(for i in ${imports}; do ls $(dirname $0)/${i}; done) old_IFS="${IFS}"; IFS=$'\a'; export CHUCK_ARGS="${*}"; IFS="${old_IFS}" exec chuck --caution-to-the-wind --silent --chugin:"$regex_chugin" ${imports} $(dirname $-1)/${STEP:-stepA_mal}.ck ================================================ FILE: impls/chuck/step0_repl.ck ================================================ // @import readline.ck fun string READ(string input) { return input; } fun string EVAL(string input) { return input; } fun string PRINT(string input) { return input; } fun string rep(string input) { return input => READ => EVAL => PRINT; } fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { chout <= rep(input) + "\n"; } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step1_read_print.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m) { return m; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } else { return PRINT(EVAL(m)); } } fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step2_eval.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m, MalSubr env[]) { // Util.println("EVAL: " + Printer.pr_str(m, true)); if( m.type == "symbol" ) { m.stringValue => string symbol; env[symbol] @=> MalSubr subr; if( subr == null ) { return MalError.create("'" + symbol + "' not found"); } else { return subr; } } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else { Util.panic("Programmer error: cannot apply"); return null; } } else { return m; } } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } MalSubr repl_env[0]; new MalAdd @=> repl_env["+"]; new MalSub @=> repl_env["-"]; new MalMul @=> repl_env["*"]; new MalDiv @=> repl_env["/"]; fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step3_env.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m, Env env) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } return EVAL(ast[2], let_env); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else { Util.panic("Programmer error: cannot apply"); return null; } } else { return m; } } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; repl_env.set("+", new MalAdd); repl_env.set("-", new MalSub); repl_env.set("*", new MalMul); repl_env.set("/", new MalDiv); fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step4_if_fn_do.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m, Env env) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } return EVAL(ast[2], let_env); } else if( a0 == "do" ) { MalObject value; for( 1 => int i; i < ast.size(); i++ ) { EVAL(ast[i], env) @=> value; if( value.type == "error" ) { return value; } } return value; } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { return EVAL(ast[2], env); } else { if( ast.size() < 4 ) { return Constants.NIL; } else { return EVAL(ast[3], env); } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } else { Util.panic("Programmer error: cannot apply"); return null; } } else { return m; } } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step5_tco.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } main(); ================================================ FILE: impls/chuck/step6_file.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } // HACK, HACK, HACK class MalEval extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return EVAL(args[0], repl_env); } fun MalObject apply(MalObject f, MalObject args[]) { if( f.type == "subr" ) { return (f$MalSubr).call(args); } else // f.type == "func" { f$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } } } new MalEval @=> MalEval eval; repl_env.set("eval", new MalEval); eval @=> (repl_env.get("swap!")$MalSubr).eval; fun MalObject[] MalArgv(string args[]) { MalObject values[0]; for( 1 => int i; i < args.size(); i++ ) { values << MalString.create(args[i]); } return values; } // NOTE: normally I'd use \0, but strings are null-terminated... String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; repl_env.set("*ARGV*", MalList.create(MalArgv(args))); fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } if( args.size() > 0 ) { args[0] => string filename; rep("(load-file \"" + filename + "\")"); } else { main(); } ================================================ FILE: impls/chuck/step7_quote.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun int startsWith(MalObject a[], string sym) { if (a.size() != 2) { return false; } a[0] @=> MalObject a0; return a0.type == "symbol" && a0.stringValue == sym; } fun MalList qqLoop(MalObject elt, MalList acc) { if( elt.type == "list" ) { elt.malObjectValues() @=> MalObject ast[]; if( startsWith(ast, "splice-unquote") ) { return MalList.create([MalSymbol.create("concat"), ast[1], acc]); } } return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); } fun MalList qqFoldr(MalObject a[]) { MalObject empty[0]; // empty, but typed MalList.create(empty) @=> MalList acc; for( a.size() - 1 => int i; 0 <= i; i-- ) { qqLoop(a[i], acc) @=> acc; } return acc; } fun MalObject quasiquote(MalObject ast) { ast.type => string type; if (type == "list") { ast.malObjectValues() @=> MalObject a[]; if (startsWith(a, "unquote")) { return a[1]; } return qqFoldr(a); } if (type == "vector") { return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); } if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } return ast; } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "quote" ) { return ast[1]; } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; continue; // TCO } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } if( first.type == "subr" ) { first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } // HACK, HACK, HACK class MalEval extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return EVAL(args[0], repl_env); } fun MalObject apply(MalObject f, MalObject args[]) { if( f.type == "subr" ) { return (f$MalSubr).call(args); } else // f.type == "func" { f$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } } } new MalEval @=> MalEval eval; repl_env.set("eval", new MalEval); eval @=> (repl_env.get("swap!")$MalSubr).eval; fun MalObject[] MalArgv(string args[]) { MalObject values[0]; for( 1 => int i; i < args.size(); i++ ) { values << MalString.create(args[i]); } return values; } // NOTE: normally I'd use \0, but strings are null-terminated... String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; repl_env.set("*ARGV*", MalList.create(MalArgv(args))); fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } if( args.size() > 0 ) { args[0] => string filename; rep("(load-file \"" + filename + "\")"); } else { main(); } ================================================ FILE: impls/chuck/step8_macros.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun int startsWith(MalObject a[], string sym) { if (a.size() != 2) { return false; } a[0] @=> MalObject a0; return a0.type == "symbol" && a0.stringValue == sym; } fun MalList qqLoop(MalObject elt, MalList acc) { if( elt.type == "list" ) { elt.malObjectValues() @=> MalObject ast[]; if( startsWith(ast, "splice-unquote") ) { return MalList.create([MalSymbol.create("concat"), ast[1], acc]); } } return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); } fun MalList qqFoldr(MalObject a[]) { MalObject empty[0]; // empty, but typed MalList.create(empty) @=> MalList acc; for( a.size() - 1 => int i; 0 <= i; i-- ) { qqLoop(a[i], acc) @=> acc; } return acc; } fun MalObject quasiquote(MalObject ast) { ast.type => string type; if (type == "list") { ast.malObjectValues() @=> MalObject a[]; if (startsWith(a, "unquote")) { return a[1]; } return qqFoldr(a); } if (type == "vector") { return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); } if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } return ast; } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "quote" ) { return ast[1]; } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; continue; // TCO } else if( a0 == "defmacro!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } value.clone() @=> value; true => (value$Func).isMacro; env.set(a1, value); return value; } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } else if( first.type == "subr" ) { MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; if( func.isMacro ) { MalObject.slice(ast, 1) @=> MalObject args[]; Env.create(func.env, func.args, args) @=> Env eval_env; EVAL(func.ast, eval_env) @=> m; continue; // TCO } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } // HACK, HACK, HACK class MalEval extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return EVAL(args[0], repl_env); } fun MalObject apply(MalObject f, MalObject args[]) { if( f.type == "subr" ) { return (f$MalSubr).call(args); } else // f.type == "func" { f$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } } } new MalEval @=> MalEval eval; repl_env.set("eval", new MalEval); eval @=> (repl_env.get("swap!")$MalSubr).eval; fun MalObject[] MalArgv(string args[]) { MalObject values[0]; for( 1 => int i; i < args.size(); i++ ) { values << MalString.create(args[i]); } return values; } // NOTE: normally I'd use \0, but strings are null-terminated... String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; repl_env.set("*ARGV*", MalList.create(MalArgv(args))); fun string errorMessage(MalObject m) { return "exception: " + String.repr(m.malObjectValue().stringValue); } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } if( args.size() > 0 ) { args[0] => string filename; rep("(load-file \"" + filename + "\")"); } else { main(); } ================================================ FILE: impls/chuck/step9_try.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun int startsWith(MalObject a[], string sym) { if (a.size() != 2) { return false; } a[0] @=> MalObject a0; return a0.type == "symbol" && a0.stringValue == sym; } fun MalList qqLoop(MalObject elt, MalList acc) { if( elt.type == "list" ) { elt.malObjectValues() @=> MalObject ast[]; if( startsWith(ast, "splice-unquote") ) { return MalList.create([MalSymbol.create("concat"), ast[1], acc]); } } return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); } fun MalList qqFoldr(MalObject a[]) { MalObject empty[0]; // empty, but typed MalList.create(empty) @=> MalList acc; for( a.size() - 1 => int i; 0 <= i; i-- ) { qqLoop(a[i], acc) @=> acc; } return acc; } fun MalObject quasiquote(MalObject ast) { ast.type => string type; if (type == "list") { ast.malObjectValues() @=> MalObject a[]; if (startsWith(a, "unquote")) { return a[1]; } return qqFoldr(a); } if (type == "vector") { return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); } if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } return ast; } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "quote" ) { return ast[1]; } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; continue; // TCO } else if( a0 == "defmacro!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } value.clone() @=> value; true => (value$Func).isMacro; env.set(a1, value); return value; } else if( a0 == "try*" ) { EVAL(ast[1], env) @=> MalObject value; if( (value.type != "error") || (ast.size() < 3) ) { return value; } ast[2].malObjectValues() @=> MalObject form[]; form[1].stringValue => string name; value.malObjectValue() @=> MalObject error; Env.create(env, [name], [error]) @=> Env error_env; return EVAL(form[2], error_env); } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } else if( first.type == "subr" ) { MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; if( func.isMacro ) { MalObject.slice(ast, 1) @=> MalObject args[]; Env.create(func.env, func.args, args) @=> Env eval_env; EVAL(func.ast, eval_env) @=> m; continue; // TCO } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } // HACK, HACK, HACK class MalEval extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return EVAL(args[0], repl_env); } fun MalObject apply(MalObject f, MalObject args[]) { if( f.type == "subr" ) { return (f$MalSubr).call(args); } else // f.type == "func" { f$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } } } new MalEval @=> MalEval eval; repl_env.set("eval", new MalEval); eval @=> (repl_env.get("swap!")$MalSubr).eval; eval @=> (repl_env.get("apply")$MalSubr).eval; eval @=> (repl_env.get("map")$MalSubr).eval; fun MalObject[] MalArgv(string args[]) { MalObject values[0]; for( 1 => int i; i < args.size(); i++ ) { values << MalString.create(args[i]); } return values; } // NOTE: normally I'd use \0, but strings are null-terminated... String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; repl_env.set("*ARGV*", MalList.create(MalArgv(args))); fun string errorMessage(MalObject m) { m.malObjectValue() @=> MalObject e; string message; if( e.type == "string" ) { String.repr(e.stringValue) => message; } else { Printer.pr_str(e, true) => message; } return "exception: " + message; } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } if( args.size() > 0 ) { args[0] => string filename; rep("(load-file \"" + filename + "\")"); } else { main(); } ================================================ FILE: impls/chuck/stepA_mal.ck ================================================ // @import readline.ck // @import types/MalObject.ck // @import types/mal/MalAtom.ck // @import types/mal/MalString.ck // @import types/mal/MalError.ck // @import types/mal/MalNil.ck // @import types/mal/MalFalse.ck // @import types/mal/MalTrue.ck // @import types/mal/MalInt.ck // @import types/mal/MalSymbol.ck // @import types/mal/MalKeyword.ck // @import types/mal/MalList.ck // @import types/mal/MalVector.ck // @import types/mal/MalHashMap.ck // @import util/*.ck // @import reader.ck // @import printer.ck // @import env.ck // @import func.ck // @import types/MalSubr.ck // @import types/subr/*.ck // @import core.ck fun MalObject READ(string input) { return Reader.read_str(input); } fun int startsWith(MalObject a[], string sym) { if (a.size() != 2) { return false; } a[0] @=> MalObject a0; return a0.type == "symbol" && a0.stringValue == sym; } fun MalList qqLoop(MalObject elt, MalList acc) { if( elt.type == "list" ) { elt.malObjectValues() @=> MalObject ast[]; if( startsWith(ast, "splice-unquote") ) { return MalList.create([MalSymbol.create("concat"), ast[1], acc]); } } return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); } fun MalList qqFoldr(MalObject a[]) { MalObject empty[0]; // empty, but typed MalList.create(empty) @=> MalList acc; for( a.size() - 1 => int i; 0 <= i; i-- ) { qqLoop(a[i], acc) @=> acc; } return acc; } fun MalObject quasiquote(MalObject ast) { ast.type => string type; if (type == "list") { ast.malObjectValues() @=> MalObject a[]; if (startsWith(a, "unquote")) { return a[1]; } return qqFoldr(a); } if (type == "vector") { return MalList.create([MalSymbol.create("vec"), qqFoldr(ast.malObjectValues())]); } if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } return ast; } fun MalObject EVAL(MalObject m, Env env) { while( true ) { env.find("DEBUG-EVAL") @=> MalObject debugEval; if( debugEval != null && (debugEval.type != "false" && debugEval.type != "nil" ) ) { Util.println("EVAL: " + Printer.pr_str(m, true)); } if( m.type == "symbol" ) { return env.get(m.stringValue); } else if( m.type == "vector" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { EVAL(values[i], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> results[i]; } return MalVector.create(results); } else if( m.type == "hashmap" ) { m.malObjectValues() @=> MalObject values[]; MalObject results[values.size()]; for( 0 => int i; i < values.size(); i++ ) { if( i % 2 == 0 ) { values[i] @=> results[i]; } else { EVAL(values[i], env) @=> results[i]; } } return MalHashMap.create(results); } else if( m.type == "list" ) { m.malObjectValues() @=> MalObject ast[]; if( ast.size() == 0 ) { return m; } else if( ast[0].type == "symbol" ) { ast[0].stringValue => string a0; if( a0 == "def!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } env.set(a1, value); return value; } else if( a0 == "let*" ) { Env.create(env) @=> Env let_env; ast[1].malObjectValues() @=> MalObject bindings[]; for( 0 => int i; i < bindings.size(); 2 +=> i) { bindings[i].stringValue => string symbol; EVAL(bindings[i+1], let_env) @=> MalObject value; if( value.type == "error" ) { return value; } let_env.set(symbol, value); } let_env @=> env; ast[2] @=> m; continue; // TCO } else if( a0 == "quote" ) { return ast[1]; } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; continue; // TCO } else if( a0 == "defmacro!" ) { ast[1].stringValue => string a1; EVAL(ast[2], env) @=> MalObject value; if( value.type == "error" ) { return value; } value.clone() @=> value; true => (value$Func).isMacro; env.set(a1, value); return value; } else if( a0 == "try*" ) { EVAL(ast[1], env) @=> MalObject value; if( (value.type != "error") || (ast.size() < 3) ) { return value; } ast[2].malObjectValues() @=> MalObject form[]; form[1].stringValue => string name; value.malObjectValue() @=> MalObject error; Env.create(env, [name], [error]) @=> Env error_env; return EVAL(form[2], error_env); } else if( a0 == "do" ) { for( 1 => int i; i < ast.size() - 1; i++ ) { EVAL(ast[i], env) @=> MalObject value; if( value.type == "error" ) { return value; } } // HACK: this assumes do gets at least one argument... ast[ast.size()-1] @=> m; continue; // TCO } else if( a0 == "if" ) { EVAL(ast[1], env) @=> MalObject condition; if( condition.type == "error" ) { return condition; } if( !(condition.type == "nil") && !(condition.type == "false") ) { ast[2] @=> m; continue; // TCO } else { if( ast.size() < 4 ) { return Constants.NIL; } else { ast[3] @=> m; continue; // TCO } } } else if( a0 == "fn*" ) { ast[1].malObjectValues() @=> MalObject arg_values[]; string args[arg_values.size()]; for( 0 => int i; i < arg_values.size(); i++ ) { arg_values[i].stringValue => args[i]; } ast[2] @=> MalObject _ast; return Func.create(env, args, _ast); } } EVAL(ast[0], env) @=> MalObject first; if( first.type == "error" ) { return first; } else if( first.type == "subr" ) { MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } first$MalSubr @=> MalSubr subr; return subr.call(args); } else if( first.type == "func" ) { first$Func @=> Func func; if( func.isMacro ) { MalObject.slice(ast, 1) @=> MalObject args[]; Env.create(func.env, func.args, args) @=> Env eval_env; EVAL(func.ast, eval_env) @=> m; continue; // TCO } MalObject args[ast.size() - 1]; for( 0 => int i; i < args.size(); i++ ) { EVAL(ast[i + 1], env) @=> MalObject result; if( result.type == "error" ) { return result; } result @=> args[i]; } Env.create(func.env, func.args, args) @=> Env eval_env; eval_env @=> env; func.ast @=> m; continue; // TCO } } else { return m; } } Util.panic("Programmer error: TCO loop left incorrectly"); return null; } fun string PRINT(MalObject m) { return Printer.pr_str(m, true); } Env.create(null) @=> Env repl_env; for( 0 => int i; i < Core.names.size(); i++ ) { Core.names[i] => string name; repl_env.set(name, Core.ns[name]); } // HACK, HACK, HACK class MalEval extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return EVAL(args[0], repl_env); } fun MalObject apply(MalObject f, MalObject args[]) { if( f.type == "subr" ) { return (f$MalSubr).call(args); } else // f.type == "func" { f$Func @=> Func func; Env.create(func.env, func.args, args) @=> Env eval_env; return EVAL(func.ast, eval_env); } } } new MalEval @=> MalEval eval; repl_env.set("eval", new MalEval); eval @=> (repl_env.get("swap!")$MalSubr).eval; eval @=> (repl_env.get("apply")$MalSubr).eval; eval @=> (repl_env.get("map")$MalSubr).eval; fun MalObject[] MalArgv(string args[]) { MalObject values[0]; for( 1 => int i; i < args.size(); i++ ) { values << MalString.create(args[i]); } return values; } // NOTE: normally I'd use \0, but strings are null-terminated... String.split(Std.getenv("CHUCK_ARGS"), "\a") @=> string args[]; repl_env.set("*ARGV*", MalList.create(MalArgv(args))); repl_env.set("*host-language*", MalString.create("chuck")); fun string errorMessage(MalObject m) { m.malObjectValue() @=> MalObject e; string message; if( e.type == "string" ) { String.repr(e.stringValue) => message; } else { Printer.pr_str(e, true) => message; } return "exception: " + message; } fun string rep(string input) { READ(input) @=> MalObject m; if( m.type == "error" ) { return errorMessage(m); } EVAL(m, repl_env) @=> MalObject result; if( result.type == "error" ) { return errorMessage(result); } return PRINT(result); } rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); fun void main() { int done; while( !done ) { Readline.readline("user> ") => string input; if( input != null ) { rep(input) => string output; if( output == "exception: \"empty input\"" ) { // proceed immediately with prompt } else { Util.println(output); } } else { true => done; } } } if( args.size() > 0 ) { args[0] => string filename; rep("(load-file \"" + filename + "\")"); } else { rep("(println (str \"Mal [\" *host-language* \"]\"))"); main(); } ================================================ FILE: impls/chuck/tests/step5_tco.mal ================================================ ;; ChucK: skipping non-TCO recursion ;; Reason: stackoverflow (non-recoverable) ================================================ FILE: impls/chuck/types/MalObject.ck ================================================ public class MalObject { string type; int intValue; string stringValue; // HACK: data types can't be self-referential, so Object it is Object object; Object objects[]; // NOTE: an object member does *not* default to null... null => Object meta; fun MalObject malObjectValue() { return object$MalObject; } fun MalObject[] malObjectValues() { MalObject values[objects.size()]; for( 0 => int i; i < objects.size(); i++ ) { objects[i]$MalObject @=> values[i]; } return values; } fun MalObject clone() { MalObject value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } // helpers for sequence types fun static Object[] toObjectArray(MalObject objects[]) { Object values[objects.size()]; for( 0 => int i; i < objects.size(); i++ ) { objects[i]$Object @=> values[i]; } return values; } fun static MalObject[] slice(MalObject objects[], int index) { MalObject values[objects.size() - index]; for( index => int i; i < objects.size(); i++ ) { objects[i] @=> values[i - index]; } return values; } fun static MalObject[] slice(MalObject objects[], int from, int to) { MalObject values[0]; for( from => int i; i < to; i++ ) { values << objects[i]; } return values; } fun static MalObject[] append(MalObject as[], MalObject bs[]) { MalObject output[as.size()+bs.size()]; for( 0 => int i; i < as.size(); i++ ) { as[i] @=> output[i]; } for( 0 => int i; i < bs.size(); i++ ) { bs[i] @=> output[as.size()+i]; } return output; } fun static MalObject[] reverse(MalObject objects[]) { MalObject output[objects.size()]; for( 0 => int i; i < output.size(); i++ ) { objects[i] @=> output[output.size()-i-1]; } return output; } } ================================================ FILE: impls/chuck/types/MalSubr.ck ================================================ public class MalSubr extends MalObject { "subr" => type; string name; // HACK MalObject eval; fun MalObject call(MalObject args[]) { return new MalObject; } fun MalObject apply(MalObject f, MalObject args[]) { return new MalObject; } } ================================================ FILE: impls/chuck/types/mal/MalAtom.ck ================================================ public class MalAtom extends MalObject { "atom" => type; fun void init(MalObject value) { value @=> object; } fun static MalObject create(MalObject value) { MalAtom m; m.init(value); return m; } fun MalObject clone() { MalAtom value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalError.ck ================================================ public class MalError extends MalObject { "error" => type; fun void init(MalObject value) { value @=> object; } fun static MalError create(string value) { MalError m; m.init(MalString.create(value)); return m; } fun static MalError create(MalObject value) { MalError m; m.init(value); return m; } } ================================================ FILE: impls/chuck/types/mal/MalFalse.ck ================================================ public class MalFalse extends MalObject { "false" => type; fun void init() { 0 => intValue; } fun static MalFalse create() { MalFalse m; m.init(); return m; } fun MalObject clone() { MalFalse value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalHashMap.ck ================================================ // HACK: it's hard to pull in util before data types public class MalHashMap extends MalObject { "hashmap" => type; fun string keyName(MalObject m) { if( m.type == "string" || m.type == "keyword" ) { return m.stringValue; } else { cherr <= "User error (non-string/keyword key)\n"; return ""; } } fun void init(MalObject values[]) { MalObject result[0]; MalObject cachedKeys[0]; MalObject cachedValues[0]; string keys[0]; for( 0 => int i; i < values.size(); 2 +=> i ) { keyName(values[i]) => string key; if( cachedValues[key] == null ) { keys << key; } values[i] @=> cachedKeys[key]; values[i+1] @=> cachedValues[key]; } for( 0 => int i; i < keys.size(); i++ ) { keys[i] => string key; result << cachedKeys[key]; result << cachedValues[key]; } MalObject.toObjectArray(result) @=> objects; } fun static MalHashMap create(MalObject values[]) { MalHashMap m; m.init(values); return m; } fun MalObject clone() { MalHashMap value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalInt.ck ================================================ public class MalInt extends MalObject { "int" => type; fun void init(int value) { value => intValue; } fun static MalInt create(int value) { MalInt m; m.init(value); return m; } fun MalObject clone() { MalInt value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalKeyword.ck ================================================ public class MalKeyword extends MalObject { "keyword" => type; fun void init(string value) { value => stringValue; } fun static MalKeyword create(string value) { MalKeyword m; m.init(value); return m; } fun MalObject clone() { MalKeyword value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalList.ck ================================================ public class MalList extends MalObject { "list" => type; fun void init(MalObject values[]) { MalObject.toObjectArray(values) @=> objects; } fun static MalList create(MalObject values[]) { MalList m; m.init(values); return m; } fun MalObject clone() { MalList value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalNil.ck ================================================ public class MalNil extends MalObject { "nil" => type; fun void init() { -1 => intValue; } fun static MalNil create() { MalNil m; m.init(); return m; } fun MalObject clone() { MalNil value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalString.ck ================================================ public class MalString extends MalObject { "string" => type; fun void init(string value) { value => stringValue; } fun static MalString create(string value) { MalString m; m.init(value); return m; } fun MalObject clone() { MalString value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalSymbol.ck ================================================ public class MalSymbol extends MalObject { "symbol" => type; fun void init(string value) { value => stringValue; } fun static MalSymbol create(string value) { MalSymbol m; m.init(value); return m; } fun MalObject clone() { MalSymbol value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalTrue.ck ================================================ public class MalTrue extends MalObject { "true" => type; fun void init() { 1 => intValue; } fun static MalTrue create() { MalTrue m; m.init(); return m; } fun MalObject clone() { MalTrue value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/mal/MalVector.ck ================================================ public class MalVector extends MalObject { "vector" => type; fun void init(MalObject values[]) { MalObject.toObjectArray(values) @=> objects; } fun static MalVector create(MalObject values[]) { MalVector m; m.init(values); return m; } fun MalObject clone() { MalVector value; this.type => value.type; this.object @=> value.object; this.objects @=> value.objects; this.meta @=> value.meta; return value; } } ================================================ FILE: impls/chuck/types/subr/MalAdd.ck ================================================ public class MalAdd extends MalSubr { fun MalObject call(MalObject args[]) { return MalInt.create(args[0].intValue + args[1].intValue); } } ================================================ FILE: impls/chuck/types/subr/MalApply.ck ================================================ public class MalApply extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject f; MalObject.slice(args, 1, args.size()-1) @=> MalObject _args[]; args[args.size()-1].malObjectValues() @=> MalObject rest[]; MalObject.append(_args, rest) @=> _args; return (eval$MalSubr).apply(f, _args); } } ================================================ FILE: impls/chuck/types/subr/MalAssoc.ck ================================================ public class MalAssoc extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject map[]; MalObject.slice(args, 1) @=> MalObject kvs[]; MalObject result[0]; MalObject cachedKeys[0]; MalObject cachedValues[0]; string keys[0]; for( 0 => int i; i < map.size(); 2 +=> i ) { map[i].stringValue => string key; keys << key; map[i] @=> cachedKeys[key]; map[i+1] @=> cachedValues[key]; } for( 0 => int i; i < kvs.size(); 2 +=> i ) { kvs[i].stringValue => string key; if( cachedValues[key] == null ) { keys << key; } kvs[i] @=> cachedKeys[key]; kvs[i+1] @=> cachedValues[key]; } for( 0 => int i; i < keys.size(); i++ ) { keys[i] => string key; result << cachedKeys[key]; result << cachedValues[key]; } return MalHashMap.create(result); } } ================================================ FILE: impls/chuck/types/subr/MalAtomify.ck ================================================ public class MalAtomify extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject m; return MalAtom.create(m); } } ================================================ FILE: impls/chuck/types/subr/MalConcat.ck ================================================ public class MalConcat extends MalSubr { fun MalObject call(MalObject args[]) { MalObject value[0]; for( 0 => int i; i < args.size(); i++ ) { args[i].malObjectValues() @=> MalObject list[]; MalObject.append(value, list) @=> value; } return MalList.create(value); } } ================================================ FILE: impls/chuck/types/subr/MalConj.ck ================================================ public class MalConj extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject list[]; MalObject.slice(args, 1) @=> MalObject rest[]; if( args[0].type == "list" ) { return MalList.create(MalObject.append(MalObject.reverse(rest), list)); } else // args[0].type == "vector" { return MalVector.create(MalObject.append(list, rest)); } } } ================================================ FILE: impls/chuck/types/subr/MalCons.ck ================================================ public class MalCons extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; args[1].malObjectValues() @=> MalObject list[]; return MalList.create(MalObject.append([arg], list)); } } ================================================ FILE: impls/chuck/types/subr/MalCount.ck ================================================ public class MalCount extends MalSubr { fun MalObject call(MalObject args[]) { args[0].type => string kind; if( kind == "list" || kind == "vector" ) { return MalInt.create(args[0].objects.size()); } else { return MalInt.create(0); } } } ================================================ FILE: impls/chuck/types/subr/MalDeref.ck ================================================ public class MalDeref extends MalSubr { fun MalObject call(MalObject args[]) { return args[0].malObjectValue(); } } ================================================ FILE: impls/chuck/types/subr/MalDissoc.ck ================================================ public class MalDissoc extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject map[]; MalObject.slice(args, 1) @=> MalObject ks[]; MalObject result[0]; string cachedKeys[0]; for( 0 => int i; i < ks.size(); i++ ) { ks[i].type => cachedKeys[ks[i].stringValue]; } for( 0 => int i; i < map.size(); 2 +=> i ) { map[i] @=> MalObject key; map[i+1] @=> MalObject value; if ( cachedKeys[key.stringValue] == null || cachedKeys[key.stringValue] != key.type ) { result << key; result << value; } } return MalHashMap.create(result); } } ================================================ FILE: impls/chuck/types/subr/MalDiv.ck ================================================ public class MalDiv extends MalSubr { fun MalObject call(MalObject args[]) { return MalInt.create(args[0].intValue / args[1].intValue); } } ================================================ FILE: impls/chuck/types/subr/MalDoReset.ck ================================================ public class MalDoReset extends MalSubr { fun MalObject call(MalObject args[]) { args[0]$MalAtom @=> MalAtom atom; args[1]$MalObject @=> MalObject value; value @=> atom.object; return value; } } ================================================ FILE: impls/chuck/types/subr/MalDoSwap.ck ================================================ public class MalDoSwap extends MalSubr { fun MalObject call(MalObject args[]) { args[0]$MalAtom @=> MalAtom atom; atom.malObjectValue() @=> MalObject value; args[1] @=> MalObject f; MalObject.slice(args, 2) @=> MalObject _args[]; MalObject.append([value], _args) @=> _args; (eval$MalSubr).apply(f, _args) @=> value; value @=> atom.object; return value; } } ================================================ FILE: impls/chuck/types/subr/MalEqual.ck ================================================ public class MalEqual extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject a; args[1] @=> MalObject b; if( ( a.type == "list" || a.type == "vector" ) && ( b.type == "list" || b.type == "vector" ) ) { a.malObjectValues() @=> MalObject as[]; b.malObjectValues() @=> MalObject bs[]; if( as.size() != bs.size() ) { return Constants.FALSE; } for( 0 => int i; i < as.size(); i++ ) { call([as[i], bs[i]]) @=> MalObject value; if( value.type != "true" ) { return Constants.FALSE; } } return Constants.TRUE; } if( a.type == "hashmap" && b.type == "hashmap" ) { a.malObjectValues() @=> MalObject akvs[]; b.malObjectValues() @=> MalObject bkvs[]; if( akvs.size() != bkvs.size() ) { return Constants.FALSE; } MalObject bmap[0]; for( 0 => int i; i < bkvs.size(); 2 +=> i ) { bkvs[i].stringValue => string keyName; bkvs[i+1] @=> bmap[keyName]; } for( 0 => int i; i < akvs.size(); 2 +=> i ) { akvs[i] @=> MalObject key; akvs[i+1] @=> MalObject value; key.stringValue => string keyName; if( bmap[keyName] == null || call([value, bmap[keyName]]).type != "true" ) { return Constants.FALSE; } } return Constants.TRUE; } if( a.type != b.type ) { return Constants.FALSE; } // NOTE: normally I'd go for a type variable, but its scope // isn't handled properly in the presence of a member variable a.type => string kind; if( kind == "true" || kind == "false" || kind == "nil" ) { return Constants.TRUE; } else if( kind == "int" ) { if( a.intValue == b.intValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } else if( kind == "string" ) { if( a.stringValue == b.stringValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } else if( kind == "symbol" ) { if( a.stringValue == b.stringValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } else if( kind == "keyword" ) { if( a.stringValue == b.stringValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } // HACK: return false for everything unknown for now return Constants.FALSE; } } ================================================ FILE: impls/chuck/types/subr/MalFirst.ck ================================================ public class MalFirst extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "nil" ) { return Constants.NIL; } arg.malObjectValues() @=> MalObject list[]; if( list.size() > 0 ) { return list[0]; } else { return Constants.NIL; } } } ================================================ FILE: impls/chuck/types/subr/MalGet.ck ================================================ public class MalGet extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "nil" ) { return Constants.NIL; } args[0].malObjectValues() @=> MalObject map[]; args[1].stringValue => string keyName; MalObject mapKey; MalObject mapValue; false => int isKeyPresent; 0 => int i; while( !isKeyPresent && i < map.size() ) { map[i] @=> mapKey; map[i+1] @=> mapValue; if( keyName == mapKey.stringValue && args[1].type == mapKey.type ) { true => isKeyPresent; } 2 +=> i; } if( isKeyPresent ) { return mapValue; } else { return Constants.NIL; } } } ================================================ FILE: impls/chuck/types/subr/MalGreater.ck ================================================ public class MalGreater extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].intValue > args[1].intValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalGreaterEqual.ck ================================================ public class MalGreaterEqual extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].intValue >= args[1].intValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalHashMapify.ck ================================================ public class MalHashMapify extends MalSubr { fun MalObject call(MalObject args[]) { return MalHashMap.create(args); } } ================================================ FILE: impls/chuck/types/subr/MalIsAtom.ck ================================================ public class MalIsAtom extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "atom" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsContains.ck ================================================ public class MalIsContains extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject map[]; args[1].stringValue => string keyName; MalObject mapKey; MalObject mapValue; false => int isKeyPresent; 0 => int i; while( !isKeyPresent && i < map.size() ) { map[i] @=> mapKey; if( keyName == mapKey.stringValue && args[1].type == mapKey.type ) { true => isKeyPresent; } 2 +=> i; } if( isKeyPresent ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsEmpty.ck ================================================ public class MalIsEmpty extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].objects.size() == 0 ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsFalse.ck ================================================ public class MalIsFalse extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "false" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsFn.ck ================================================ public class MalIsFn extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "subr" || ( args[0].type == "func" && !(args[0]$Func).isMacro ) ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsHashMap.ck ================================================ public class MalIsHashMap extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "hashmap" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsKeyword.ck ================================================ public class MalIsKeyword extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "keyword" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsList.ck ================================================ public class MalIsList extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "list" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsMacro.ck ================================================ public class MalIsMacro extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "func" && (args[0]$Func).isMacro ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsNil.ck ================================================ public class MalIsNil extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "nil" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsNumber.ck ================================================ public class MalIsNumber extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "int" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsString.ck ================================================ public class MalIsString extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].type == "string" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsSymbol.ck ================================================ public class MalIsSymbol extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "symbol" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsTrue.ck ================================================ public class MalIsTrue extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "true" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalIsVector.ck ================================================ public class MalIsVector extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "vector" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalKeys.ck ================================================ public class MalKeys extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject map[]; MalObject results[0]; for( 0 => int i; i < map.size(); 2 +=> i ) { results << map[i]; } return MalList.create(results); } } ================================================ FILE: impls/chuck/types/subr/MalKeywordify.ck ================================================ public class MalKeywordify extends MalSubr { fun MalObject call(MalObject args[]) { return MalKeyword.create(args[0].stringValue); } } ================================================ FILE: impls/chuck/types/subr/MalLess.ck ================================================ public class MalLess extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].intValue < args[1].intValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalLessEqual.ck ================================================ public class MalLessEqual extends MalSubr { fun MalObject call(MalObject args[]) { if( args[0].intValue <= args[1].intValue ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalListify.ck ================================================ public class MalListify extends MalSubr { fun MalObject call(MalObject args[]) { return MalList.create(args); } } ================================================ FILE: impls/chuck/types/subr/MalMap.ck ================================================ public class MalMap extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject f; args[1].malObjectValues() @=> MalObject list[]; for( 0 => int i; i < list.size(); i++ ) { (eval$MalSubr).apply(f, [list[i]]) @=> MalObject value; if( value.type == "error" ) { return value; } value @=> list[i]; } return MalList.create(list); } } ================================================ FILE: impls/chuck/types/subr/MalMeta.ck ================================================ public class MalMeta extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.meta == null ) { return Constants.NIL; } else { return (arg.meta)$MalObject; } } } ================================================ FILE: impls/chuck/types/subr/MalMul.ck ================================================ public class MalMul extends MalSubr { fun MalObject call(MalObject args[]) { return MalInt.create(args[0].intValue * args[1].intValue); } } ================================================ FILE: impls/chuck/types/subr/MalNth.ck ================================================ public class MalNth extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject list[]; args[1].intValue => int n; if( n < list.size() ) { return list[n]; } else { return MalError.create("out of bounds"); } } } ================================================ FILE: impls/chuck/types/subr/MalPrStr.ck ================================================ public class MalPrStr extends MalSubr { fun MalObject call(MalObject args[]) { string values[args.size()]; for( 0 => int i; i < values.size(); i++ ) { Printer.pr_str(args[i], true) => values[i]; } return MalString.create(String.join(values, " ")); } } ================================================ FILE: impls/chuck/types/subr/MalPrintln.ck ================================================ public class MalPrintln extends MalSubr { fun MalObject call(MalObject args[]) { string values[args.size()]; for( 0 => int i; i < values.size(); i++ ) { Printer.pr_str(args[i], false) => values[i]; } Util.println(String.join(values, " ")); return Constants.NIL; } } ================================================ FILE: impls/chuck/types/subr/MalPrn.ck ================================================ public class MalPrn extends MalSubr { fun MalObject call(MalObject args[]) { string values[args.size()]; for( 0 => int i; i < values.size(); i++ ) { Printer.pr_str(args[i], true) => values[i]; } Util.println(String.join(values, " ")); return Constants.NIL; } } ================================================ FILE: impls/chuck/types/subr/MalReadStr.ck ================================================ public class MalReadStr extends MalSubr { fun MalObject call(MalObject args[]) { args[0].stringValue => string input; return Reader.read_str(input); } } ================================================ FILE: impls/chuck/types/subr/MalReadline.ck ================================================ public class MalReadline extends MalSubr { fun MalObject call(MalObject args[]) { args[0].stringValue => string prompt; Readline.readline(prompt) => string input; if( input == null ) { return Constants.NIL; } else { return MalString.create(input); } } } ================================================ FILE: impls/chuck/types/subr/MalRest.ck ================================================ public class MalRest extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; MalObject result[0]; if( arg.type == "nil" ) { return MalList.create(result); } args[0].malObjectValues() @=> MalObject list[]; if( list.size() > 0 ) { MalObject.slice(list, 1) @=> result; } return MalList.create(result); } } ================================================ FILE: impls/chuck/types/subr/MalSeq.ck ================================================ public class MalSeq extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "nil" ) { return Constants.NIL; } else if( arg.type == "list" || arg.type == "vector" ) { args[0].malObjectValues() @=> MalObject list[]; if( list.size() > 0 ) { return MalList.create(list); } else { return Constants.NIL; } } else if( arg.type == "string" ) { args[0].stringValue => string value; if( value.length() > 0 ) { MalObject chars[value.length()]; for( 0 => int i; i < value.length(); i++ ) { MalString.create(value.substring(i, 1)) @=> chars[i]; } return MalList.create(chars); } else { return Constants.NIL; } } else { return MalError.create("Invalid argument"); } } } ================================================ FILE: impls/chuck/types/subr/MalSequential.ck ================================================ public class MalSequential extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; if( arg.type == "list" || arg.type == "vector" ) { return Constants.TRUE; } else { return Constants.FALSE; } } } ================================================ FILE: impls/chuck/types/subr/MalSlurp.ck ================================================ public class MalSlurp extends MalSubr { fun MalObject call(MalObject args[]) { args[0].stringValue => string filename; FileIO f; string output[0]; f.open(filename, FileIO.READ); while( f.more() ) { output << f.readLine(); } // HACK: not only do we assume files are joined by \n, but the // final newline cannot be detected otherwise String.join(output, "\n") => string content; if( f.size() == content.length() + 1 ) { "\n" +=> content; } f.close(); return MalString.create(content); } } ================================================ FILE: impls/chuck/types/subr/MalStr.ck ================================================ public class MalStr extends MalSubr { fun MalObject call(MalObject args[]) { string values[args.size()]; for( 0 => int i; i < values.size(); i++ ) { Printer.pr_str(args[i], false) => values[i]; } return MalString.create(String.join(values, "")); } } ================================================ FILE: impls/chuck/types/subr/MalSub.ck ================================================ public class MalSub extends MalSubr { fun MalObject call(MalObject args[]) { return MalInt.create(args[0].intValue - args[1].intValue); } } ================================================ FILE: impls/chuck/types/subr/MalSymbolify.ck ================================================ public class MalSymbolify extends MalSubr { fun MalObject call(MalObject args[]) { args[0].stringValue => string name; return MalSymbol.create(name); } } ================================================ FILE: impls/chuck/types/subr/MalThrow.ck ================================================ public class MalThrow extends MalSubr { fun MalObject call(MalObject args[]) { return MalError.create(args[0]); } } ================================================ FILE: impls/chuck/types/subr/MalTimeMs.ck ================================================ public class MalTimeMs extends MalSubr { fun MalObject call(MalObject args[]) { // HACK: Std.system returns the status code only... "/tmp/chuck-date." + Std.rand2(1000,9999) => string temp_file; Std.system("date +%s%3N > " + temp_file); FileIO f; f.open(temp_file, FileIO.READ); f => int timestamp; f.close(); Std.system("rm " + temp_file); return MalInt.create(timestamp); } } ================================================ FILE: impls/chuck/types/subr/MalVals.ck ================================================ public class MalVals extends MalSubr { fun MalObject call(MalObject args[]) { args[0].malObjectValues() @=> MalObject map[]; MalObject results[0]; for( 1 => int i; i < map.size(); 2 +=> i ) { results << map[i]; } return MalList.create(results); } } ================================================ FILE: impls/chuck/types/subr/MalVec.ck ================================================ 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.malObjectValues()); } } return MalError.create("vec: wrong arguments"); } } ================================================ FILE: impls/chuck/types/subr/MalVectorify.ck ================================================ public class MalVectorify extends MalSubr { fun MalObject call(MalObject args[]) { return MalVector.create(args); } } ================================================ FILE: impls/chuck/types/subr/MalWithMeta.ck ================================================ public class MalWithMeta extends MalSubr { fun MalObject call(MalObject args[]) { args[0] @=> MalObject arg; args[1] @=> MalObject meta; MalObject value; arg.clone() @=> value; meta$Object @=> value.meta; return value; } } ================================================ FILE: impls/chuck/util/Constants.ck ================================================ public class Constants { static MalTrue @ TRUE; static MalFalse @ FALSE; static MalNil @ NIL; } MalTrue.create() @=> Constants.TRUE; MalFalse.create() @=> Constants.FALSE; MalNil.create() @=> Constants.NIL; ================================================ FILE: impls/chuck/util/String.ck ================================================ public class String { // "x".substring(1) errors out (bug?), this doesn't fun static string slice(string input, int index) { if( index == input.length() ) { return ""; } else { return input.substring(index); } } fun static string slice(string input, int start, int end) { if( start == input.length() ) { return ""; } else { return input.substring(start, end - start); } } fun static string join(string parts[], string separator) { if( parts.size() == 0 ) { return ""; } parts[0] => string output; for( 1 => int i; i < parts.size(); i++ ) { output + separator + parts[i] => output; } return output; } fun static string[] split(string input, string separator) { string output[0]; if( input == "" ) { return output; } 0 => int offset; int index; while( true ) { input.find(separator, offset) => index; if( index == -1 ) { output << input.substring(offset); break; } output << input.substring(offset, index - offset); index + separator.length() => offset; } return output; } fun static string replaceAll(string input, string pat, string rep) { 0 => int offset; input => string output; int index; while( true ) { if( offset >= output.length() ) { break; } output.find(pat, offset) => index; if( index == -1 ) { break; } output.replace(index, pat.length(), rep); index + rep.length() => offset; } return output; } fun static string parse(string input) { slice(input, 1, input.length() - 1) => string output; replaceAll(output, "\\\\", "\177") => output; replaceAll(output, "\\\"", "\"") => output; replaceAll(output, "\\n", "\n") => output; replaceAll(output, "\177", "\\") => output; return output; } fun static string repr(string input) { input => string output; replaceAll(output, "\\", "\\\\") => output; replaceAll(output, "\n", "\\n") => output; replaceAll(output, "\"", "\\\"") => output; return "\"" + output + "\""; } } ================================================ FILE: impls/chuck/util/Util.ck ================================================ public class Util { fun static void println(string message) { chout <= message + "\n"; } fun static void panic(string message) { println("This shouldn't happen because: " + message); Machine.crash(); } } ================================================ FILE: impls/clojure/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install curl libreadline-dev libedit-dev # # Clojure (Java and lein) # RUN apt-get -y install leiningen ENV LEIN_HOME /mal/.lein ENV LEIN_JVM_OPTS -Duser.home=/mal # # ClojureScript (Node and Lumo) # # For building node modules RUN apt-get -y install g++ # Add nodesource apt repo config for 10.x stable RUN apt-get -y install gnupg RUN curl -sL https://deb.nodesource.com/setup_10.x | bash - # Install nodejs RUN apt-get -y install nodejs ENV NPM_CONFIG_CACHE /mal/.npm ## Install ffi and lumo-cljs modules globally #RUN npm install -g ffi lumo-cljs ENV HOME=/mal ================================================ FILE: impls/clojure/Makefile ================================================ clojure_MODE ?= clj SOURCES_UTIL = src/mal/readline.$(clojure_MODE) SOURCES_BASE = $(SOURCES_UTIL) src/mal/reader.cljc src/mal/printer.cljc SOURCES_LISP = src/mal/env.cljc src/mal/core.cljc src/mal/stepA_mal.cljc SRCS = $(SOURCES_BASE) src/mal/env.cljc src/mal/core.cljc SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) DEPS = $(if $(filter cljs,$(clojure_MODE)),node_modules,deps) dist: $(if $(filter cljs,$(clojure_MODE)),node_modules,mal.jar mal) deps: lein deps mal.jar: $(SOURCES) lein with-profile stepA uberjar cp target/stepA_mal.jar $@ SHELL := bash mal: mal.jar cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ chmod +x mal src/mal/%.cljc: $(DEPS) @true #src/mal/stepA_mal.cljc: $(DEPS) target/%.jar: src/mal/%.cljc $(SRCS) lein with-profile $(word 1,$(subst _, ,$*)) uberjar node_modules: npm install clean: rm -rf target/ mal.jar mal ================================================ FILE: impls/clojure/package.json ================================================ { "name": "mal", "version": "0.0.1", "description": "Make a Lisp (mal) language implemented in ClojureScript", "dependencies": { "ffi-napi": "2.4.x", "lumo-cljs": "1.10.1" } } ================================================ FILE: impls/clojure/project.clj ================================================ (defproject mal "0.0.1-SNAPSHOT" :description "Make-A-Lisp" :dependencies [[org.clojure/clojure "1.10.0"] [net.n01se/clojure-jna "1.0.0"]] ;; To run a step with correct readline behavior: ;; lein trampoline with-profile stepX run ;; To generate a executable uberjar (in target/) for a step: ;; lein with-profile stepX repl :profiles {:step0 {:main mal.step0-repl :uberjar-name "step0_repl.jar" :aot [mal.step0-repl]} :step1 {:main mal.step1-read-print :uberjar-name "step1_read_print.jar" :aot [mal.step1-read-print]} :step2 {:main mal.step2-eval :uberjar-name "step2_eval.jar" :aot [mal.step2-eval]} :step3 {:main mal.step3-env :uberjar-name "step3_env.jar" :aot [mal.step3-env]} :step4 {:main mal.step4-if-fn-do :uberjar-name "step4_if_fn_do.jar" :aot [mal.step4-if-fn-do]} :step5 {:main mal.step5-tco :uberjar-name "step5_tco.jar" :aot [mal.step5-tco]} :step6 {:main mal.step6-file :uberjar-name "step6_file.jar" :aot [mal.step6-file]} :step7 {:main mal.step7-quote :uberjar-name "step7_quote.jar" :aot [mal.step7-quote]} :step8 {:main mal.step8-macros :uberjar-name "step8_macros.jar" :aot [mal.step8-macros]} :step9 {:main mal.step9-try :uberjar-name "step9_try.jar" :aot [mal.step9-try]} :stepA {:main mal.stepA-mal :uberjar-name "stepA_mal.jar" :aot [mal.stepA-mal]}}) ================================================ FILE: impls/clojure/run ================================================ #!/usr/bin/env bash export PATH=$PATH:$(dirname $0)/node_modules/.bin STEP=${STEP:-stepA_mal} if [ "${clojure_MODE}" = "cljs" ]; then exec lumo -c $(dirname $0)/src -m mal.${STEP//_/-} "${@}" else exec java -jar $(dirname $0)/target/${STEP}.jar "${@}" fi ================================================ FILE: impls/clojure/src/mal/core.cljc ================================================ (ns mal.core (:refer-clojure :exclude [pr-str]) (:require [clojure.string :refer [join]] [mal.readline :as readline] [mal.reader :as reader] [mal.printer :refer [pr-str atom?]])) ;; Errors/exceptions (defn mal_throw [obj] (throw (ex-info "mal exception" {:data obj}))) ;; String functions #?(:cljs (defn slurp [f] (.readFileSync (js/require "fs") f "utf-8"))) ;; Numeric functions #?(:clj (defn time-ms [] (System/currentTimeMillis)) :cljs (defn time-ms [] (.getTime (js/Date.)))) ;; Metadata functions ;; - store metadata at :meta key of the real metadata (defn mal_with_meta [obj m] (let [new-meta (assoc (meta obj) :meta m)] (with-meta obj new-meta))) (defn mal_meta [obj] (:meta (meta obj))) ;; core_ns is core namespaces functions (def core_ns [['= =] ['throw mal_throw] ['nil? nil?] ['true? true?] ['false? false?] ['string? string?] ['symbol symbol] ['symbol? symbol?] ['keyword keyword] ['keyword? keyword?] ['number? number?] ['fn? (fn [o] (if (and (fn? o) (not (:ismacro (meta o)))) true false))] ['macro? (fn [o] (if (and (fn? o) (:ismacro (meta o))) true false))] ['pr-str (fn [& xs] (join " " (map #(pr-str % true) xs)))] ['str (fn [& xs] (join "" (map #(pr-str % false) xs)))] ['prn (fn [& xs] (println (join " " (map #(pr-str % true) xs))))] ['println (fn [& xs] (println (join " " (map #(pr-str % false) xs))))] ['readline readline/readline] ['read-string reader/read-string] ['slurp slurp] ['< <] ['<= <=] ['> >] ['>= >=] ['+ +] ['- -] ['* *] ['/ /] ['time-ms time-ms] ['list list] ['list? seq?] ['vector vector] ['vector? vector?] ['hash-map hash-map] ['map? map?] ['assoc assoc] ['dissoc dissoc] ['get get] ['contains? contains?] ['keys (fn [hm] (let [ks (keys hm)] (if (nil? ks) '() ks)))] ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))] ['sequential? sequential?] ['vec vec] ['cons cons] ['concat #(apply list (apply concat %&))] ['nth nth] ['first first] ['rest rest] ['empty? empty?] ['count count] ['apply apply] ['map #(apply list (map %1 %2))] ['conj conj] ['seq (fn [obj] (seq (if (string? obj) (map str obj) obj)))] ['with-meta mal_with_meta] ['meta mal_meta] ['atom atom] ['atom? atom?] ['deref deref] ['reset! reset!] ['swap! swap!]]) ================================================ FILE: impls/clojure/src/mal/env.cljc ================================================ (ns mal.env) (defn env [& [outer binds exprs]] ;;(prn "env" binds exprs) ;; (when (not= (count binds) (count exprs)) ;; (throw (Exception. "Arity mistmatch in env call"))) (atom (loop [env {:outer outer} b binds e exprs] (cond (= nil b) env (= '& (first b)) (assoc env (nth b 1) e) :else (recur (assoc env (first b) (first e)) (next b) (rest e)))))) (defn env-find [env k] (cond (contains? @env k) env (:outer @env) (env-find (:outer @env) k) :else nil)) (defn env-get [env k] (let [e (env-find env k)] (when-not e (throw (#?(:clj Exception. :cljs js/Error.) (str "'" k "' not found")))) (get @e k))) (defn env-set [env k v] (swap! env assoc k v) v) ================================================ FILE: impls/clojure/src/mal/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline"; // NOTE: libreadline is GPL //var RL_LIB = "libedit"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var ffi = require('ffi-napi'), fs = require('fs'); var rllib = ffi.Library(RL_LIB, { 'readline': [ 'string', [ 'string' ] ], 'add_history': [ 'int', [ 'string' ] ]}); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i s (S/replace "\\" "\\\\") (S/replace "\"" "\\\"") (S/replace "\n" "\\n"))) (defn pr-str ([obj] (pr-str obj true)) ([obj print-readably] (let [_r print-readably] (cond (= nil obj) "nil" (string? obj) (if _r (str "\"" (escape obj) "\"") obj) (list? obj) (str "(" (S/join " " (map #(pr-str % _r) obj)) ")") (vector? obj) (str "[" (S/join " " (map #(pr-str % _r) obj)) "]") (map? obj) (str "{" (S/join " " (map (fn [[k v]] (str (pr-str k _r) " " (pr-str v _r))) obj)) "}") (atom? obj) (str "(atom " (pr-str @obj _r) ")") :else (str obj))))) ================================================ FILE: impls/clojure/src/mal/reader.cljc ================================================ (ns mal.reader (:refer-clojure :exclude [read-string]) (:require [clojure.string :as S])) (defn throw-str [s] (throw #?(:cljs (js/Error. s) :clj (Exception. s)))) (defn rdr [tokens] {:tokens (vec tokens) :position (atom 0)}) (defn rdr-peek [rdr] (get (vec (:tokens rdr)) @(:position rdr))) (defn rdr-next [rdr] (get (vec (:tokens rdr)) (dec (swap! (:position rdr) inc)))) (def tok-re #"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:[\\].|[^\\\"])*\"?|;.*|[^\s\[\]{}()'\"`@,;]+)") (def int-re #"^-?[0-9]+$") (def str-re #"^\"((?:[\\].|[^\\\"])*)\"$") (def badstr-re #"^\"") (defn tokenize [s] (filter #(not= \; (first %)) (map second (re-seq tok-re s)))) (defn unescape [s] (-> s (S/replace "\\\\" "\u029e") (S/replace "\\\"" "\"") (S/replace "\\n" "\n") (S/replace "\u029e" "\\"))) (defn read-atom [rdr] (let [token (rdr-next rdr)] (cond (re-seq int-re token) #?(:cljs (js/parseInt token) :clj (Integer/parseInt token)) (re-seq str-re token) (unescape (second (re-find str-re token))) (re-seq badstr-re token) (throw-str (str "expected '\"', got EOF")) (= \: (get token 0)) (keyword (subs token 1)) (= "nil" token) nil (= "true" token) true (= "false" token) false :else (symbol token)))) (declare read-form) (defn read-seq [rdr start end] (assert (= start (rdr-next rdr))) ;; pull off start (loop [lst []] (let [token (rdr-peek rdr)] (cond (= token end) (do (rdr-next rdr) lst) (not token) (throw-str (str "expected '" end "', got EOF")) :else (recur (conj lst (read-form rdr))))))) (defn read-form [rdr] (let [tok (rdr-peek rdr)] (cond (= "'" tok) (do (rdr-next rdr) (list 'quote (read-form rdr))) (= "`" tok) (do (rdr-next rdr) (list 'quasiquote (read-form rdr))) (= "~" tok) (do (rdr-next rdr) (list 'unquote (read-form rdr))) (= "~@" tok) (do (rdr-next rdr) (list 'splice-unquote (read-form rdr))) (= "^" tok) (do (rdr-next rdr) (let [m (read-form rdr)] (list 'with-meta (read-form rdr) m))) (= "@" tok) (do (rdr-next rdr) (list 'deref (read-form rdr))) (= ")" tok) (throw-str "unexpected ')'") (= "(" tok) (apply list (read-seq rdr "(" ")")) (= "]" tok) (throw-str "unexpected ']'") (= "[" tok) (vec (read-seq rdr "[" "]")) (= "}" tok) (throw-str "unexpected '}'") (= "{" tok) (apply hash-map (read-seq rdr "{" "}")) :else (read-atom rdr)))) (defn read-string [s] (read-form (rdr (tokenize s)))) ================================================ FILE: impls/clojure/src/mal/readline.clj ================================================ (ns mal.readline (:require [clojure.string :refer [split]] [clojure.java.io :refer [file]] [net.n01se.clojure-jna :as jna])) (defonce history-loaded (atom nil)) (def HISTORY-FILE (str (System/getProperty "user.home") "/.mal-history")) ;; ;; Uncomment one of the following readline libraries ;; ;; editline (BSD) #_ (do (def readline-call (jna/to-fn String edit/readline)) (def add-history (jna/to-fn Void edit/add_history)) (def load-history #(doseq [line (split (slurp %) #"\n")] (jna/invoke Void edit/add_history line)))) ;; GNU Readline (GPL) ;; WARNING: distributing your code with GNU readline enabled means you ;; must release your program as GPL ;#_ (do (def readline-call (jna/to-fn String readline/readline)) (def add-history (jna/to-fn Void readline/add_history)) (def load-history (jna/to-fn Integer readline/read_history))) (defn readline [prompt & [lib]] (when (not @history-loaded) (reset! history-loaded true) (when (.canRead (file HISTORY-FILE)) (load-history HISTORY-FILE))) (let [line (readline-call prompt)] (when line (add-history line) (when (.canWrite (file HISTORY-FILE)) (spit HISTORY-FILE (str line "\n") :append true))) line)) ================================================ FILE: impls/clojure/src/mal/readline.cljs ================================================ (ns mal.readline) (def readline (.-readline (js/require "../src/mal/node_readline.js"))) ================================================ FILE: impls/clojure/src/mal/step0_repl.cljc ================================================ (ns mal.step0-repl (:require [mal.readline :as readline]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] strng) ;; eval (defn EVAL [ast env] ast) ;; print (defn PRINT [exp] exp) ;; repl (defn rep [strng] (PRINT (EVAL (READ strng), {}))) ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (println (rep line))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step1_read_print.cljc ================================================ (ns mal.step1-read-print (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] ast) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (defn rep [strng] (PRINT (EVAL (READ strng) {}))) ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step2_eval.cljc ================================================ (ns mal.step2-eval (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] ;; (println "EVAL:" (printer/pr-str ast) (keys @env)) ;; (flush) (cond (symbol? ast) (or (get env ast) (throw (#?(:clj Error. :cljs js/Error.) (str ast " not found")))) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (if (empty? ast) ast (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] (apply f args))) :else ;; not a list, map, symbol or vector ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env {'+ + '- - '* * '/ /}) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step3_env.cljc ================================================ (ns mal.step3-env (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) ;; apply (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] (apply f args)))) :else ;; not a list, map, symbol or vector ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) (env/env-set repl-env '+ +) (env/env-set repl-env '- -) (env/env-set repl-env '* *) (env/env-set repl-env '/ /) ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step4_if_fn_do.cljc ================================================ (ns mal.step4-if-fn-do (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'do (last (doall (map #(EVAL % env) (rest ast)))) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (EVAL a3 env) nil) (EVAL a2 env))) 'fn* (fn [& args] (EVAL a2 (env/env env a1 (or args '())))) ;; apply (let [el (map #(EVAL % env) ast) f (first el) args (rest el)] (apply f args)))) :else ;; not a list, map, symbol or vector ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step5_tco.cljc ================================================ (ns mal.step5-tco (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (with-meta (fn [& args] (EVAL a2 (env/env env a1 (or args '())))) {:expression a2 :environment env :parameters a1}) ;; apply (let [el (map #(EVAL % env) ast) f (first el) args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (repl-loop)) ================================================ FILE: impls/clojure/src/mal/step6_file.cljc ================================================ (ns mal.step6-file (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (defn EVAL [ast env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (with-meta (fn [& args] (EVAL a2 (env/env env a1 (or args '())))) {:expression a2 :environment env :parameters a1}) ;; apply (let [el (map #(EVAL % env) ast) f (first el) args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) (env/env-set repl-env '*ARGV* ()) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (env/env-set repl-env '*ARGV* (rest args)) (if args (rep (str "(load-file \"" (first args) "\")")) (repl-loop))) ================================================ FILE: impls/clojure/src/mal/step7_quote.cljc ================================================ (ns mal.step7-quote (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (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 (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 env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'quote a1 'quasiquote (recur (quasiquote a1) env) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (with-meta (fn [& args] (EVAL a2 (env/env env a1 (or args '())))) {:expression a2 :environment env :parameters a1}) ;; apply (let [el (map #(EVAL % env) ast) f (first el) args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) (env/env-set repl-env '*ARGV* ()) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (env/env-set repl-env '*ARGV* (rest args)) (if args (rep (str "(load-file \"" (first args) "\")")) (repl-loop))) ================================================ FILE: impls/clojure/src/mal/step8_macros.cljc ================================================ (ns mal.step8-macros (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (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 (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 env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'quote a1 'quasiquote (recur (quasiquote a1) env) 'defmacro! (let [func (EVAL a2 env) ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit mac (with-meta func {:orig (:orig (meta func)) :ismacro true})] (env/env-set env a1 mac)) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (let [func (fn [& args] (EVAL a2 (env/env env a1 (or args '()))))] (with-meta func ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit {:orig func :expression a2 :environment env :parameters a1})) ;; apply (let [f (EVAL a0 env) unevaluated_args (rest ast)] (if (:ismacro (meta f)) (recur (apply (:orig (meta f)) unevaluated_args) env) (let [args (map #(EVAL % env) unevaluated_args) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) (env/env-set repl-env '*ARGV* ()) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (env/env-set repl-env '*ARGV* (rest args)) (if args (rep (str "(load-file \"" (first args) "\")")) (repl-loop))) ================================================ FILE: impls/clojure/src/mal/step9_try.cljc ================================================ (ns mal.step9-try (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (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 (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 env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'quote a1 'quasiquote (recur (quasiquote a1) env) 'defmacro! (let [func (EVAL a2 env) ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit mac (with-meta func {:orig (:orig (meta func)) :ismacro true})] (env/env-set env a1 mac)) 'try* (if (= 'catch* (nth a2 0)) (try (EVAL a1 env) (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ei (EVAL (nth a2 2) (env/env env [(nth a2 1)] [(:data (ex-data ei))]))) (catch #?(:clj Throwable :cljs :default) t (EVAL (nth a2 2) (env/env env [(nth a2 1)] [#?(:clj (or (.getMessage t) (.toString t)) :cljs (.-message t))])))) (EVAL a1 env)) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (let [func (fn [& args] (EVAL a2 (env/env env a1 (or args '()))))] (with-meta func ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit {:orig func :expression a2 :environment env :parameters a1})) ;; apply (let [f (EVAL a0 env) unevaluated_args (rest ast)] (if (:ismacro (meta f)) (recur (apply (:orig (meta f)) unevaluated_args) env) (let [args (map #(EVAL % env) unevaluated_args) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) (env/env-set repl-env '*ARGV* ()) ;; core.mal: defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:cljs (catch ExceptionInfo e (println "Error:" (or (:data (ex-data e)) (.-stack e))))) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (env/env-set repl-env '*ARGV* (rest args)) (if args (rep (str "(load-file \"" (first args) "\")")) (repl-loop))) ================================================ FILE: impls/clojure/src/mal/stepA_mal.cljc ================================================ (ns mal.stepA-mal (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] [mal.printer :as printer] [mal.env :as env] [mal.core :as core]) #?(:clj (:gen-class))) ;; read (defn READ [& [strng]] (reader/read-string strng)) ;; eval (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 (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 env] (loop [ast ast env env] (let [e (env/env-find env 'DEBUG-EVAL)] (when e (let [v (env/env-get e 'DEBUG-EVAL)] (when (and (not= v nil) (not= v false)) (println "EVAL:" (printer/pr-str ast) (keys @env)) (flush))))) (cond (symbol? ast) (env/env-get env ast) (vector? ast) (vec (map #(EVAL % env) ast)) (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) (seq? ast) ;; apply list ;; indented to match later steps (let [[a0 a1 a2 a3] ast] (condp = a0 nil ast 'def! (env/env-set env a1 (EVAL a2 env)) 'let* (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] (env/env-set let-env b (EVAL e let-env))) (recur a2 let-env)) 'quote a1 'quasiquote (recur (quasiquote a1) env) 'defmacro! (let [func (EVAL a2 env) ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit mac (with-meta func {:orig (:orig (meta func)) :ismacro true})] (env/env-set env a1 mac)) 'clj* #?(:clj (eval (reader/read-string a1)) :cljs (throw (ex-info "clj* unsupported in ClojureScript mode" {}))) 'js* #?(:clj (throw (ex-info "js* unsupported in Clojure mode" {})) :cljs (js->clj (js/eval a1))) 'try* (if (= 'catch* (nth a2 0)) (try (EVAL a1 env) (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ei (EVAL (nth a2 2) (env/env env [(nth a2 1)] [(:data (ex-data ei))]))) (catch #?(:clj Throwable :cljs :default) t (EVAL (nth a2 2) (env/env env [(nth a2 1)] [#?(:clj (or (.getMessage t) (.toString t)) :cljs (.-message t))])))) (EVAL a1 env)) 'do (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if (let [cond (EVAL a1 env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 2) (recur a3 env) nil) (recur a2 env))) 'fn* (let [func (fn [& args] (EVAL a2 (env/env env a1 (or args '()))))] (with-meta func ;; Preserve unadorned function to workaround ;; ClojureScript function-with-meta arity limit {:orig func :expression a2 :environment env :parameters a1})) ;; apply (let [f (EVAL a0 env) unevaluated_args (rest ast)] (if (:ismacro (meta f)) (recur (apply (:orig (meta f)) unevaluated_args) env) (let [args (map #(EVAL % env) unevaluated_args) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) (apply f args))))))) :else ;; not a list, map, symbol or vector ast))) ;; print (defn PRINT [exp] (printer/pr-str exp)) ;; repl (def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) ;; core.clj: defined using Clojure (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) (env/env-set repl-env '*ARGV* ()) ;; core.mal: defined using the language itself #?(:clj (rep "(def! *host-language* \"clojure\")") :cljs (rep "(def! *host-language* \"clojurescript\")")) (rep "(def! not (fn* [a] (if a false true)))") (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ;; repl loop (defn repl-loop [] (let [line (readline/readline "user> ")] (when line (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment (try (println (rep line)) #?(:cljs (catch ExceptionInfo e (println "Error:" (or (:data (ex-data e)) (.-stack e))))) #?(:clj (catch Throwable e (clojure.repl/pst e)) :cljs (catch js/Error e (println (.-stack e)))))) (recur)))) (defn -main [& args] (env/env-set repl-env '*ARGV* (rest args)) (if args (rep (str "(load-file \"" (first args) "\")")) (do (rep "(println (str \"Mal [\" *host-language* \"]\"))") (repl-loop)))) ================================================ FILE: impls/clojure/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/clojure/tests/stepA_mal.mal ================================================ ;; Testing basic clojure/clojurescript interop (def! clj (= *host-language* "clojure")) (def! cljs (= *host-language* "clojurescript")) (if clj (clj* "7") (js* "7")) ;=>7 (if clj (clj* "\"abc\"") (js* "\"abc\"")) ;=>"abc" (if clj (clj* "{\"abc\" 123}") {"abc" 123}) ;=>{"abc" 123} (if clj (clj* "(prn \"foo\")") (js* "console.log('\"foo\"')")) ;/"foo" ;=>nil (if clj (clj* "(apply list (for [x [1 2 3]] (+ 1 x)))") '(2 3 4)) ;=>(2 3 4) (if cljs (js* "[1,2,3].map(function(x) {return 1+x})") [2 3 4]) ;=>[2 3 4] ================================================ FILE: impls/coffee/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm RUN DEBIAN_FRONTEND=noninteractive apt-get -y install coffeescript ENV NPM_CONFIG_CACHE /mal/.npm RUN touch /.coffee_history && chmod go+w /.coffee_history ================================================ FILE: impls/coffee/Makefile ================================================ SOURCES_BASE = node_readline.coffee types.coffee \ reader.coffee printer.coffee SOURCES_LISP = env.coffee core.coffee stepA_mal.coffee SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) STEPS = step0_repl.coffee step1_read_print.coffee \ step2_eval.coffee step3_env.coffee step4_if_fn_do.coffee \ step5_tco.coffee step6_file.coffee step7_quote.coffee \ step8_macros.coffee step9_try.coffee stepA_mal.coffee all: node_modules dist node_modules: npm install $(STEPS): node_modules dist: mal.coffee mal mal.coffee: $(SOURCES) cat $+ | grep -v "= *require('./" > $@ mal: mal.coffee echo "#!/usr/bin/env coffee" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.coffee mal ================================================ FILE: impls/coffee/core.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" [_pr_str, println] = [printer._pr_str, printer.println] # Sequence functions conj = (seq, args...) -> switch types._obj_type(seq) when 'list' lst = types._clone(seq) lst.unshift(x) for x in args lst when 'vector' lst = types._clone(seq) lst.push(args...) types._vector(lst...) else throw new Error "conj called on " + types._obj_type(seq) seq = (obj) -> switch types._obj_type(obj) when 'list' if obj.length == 0 then null else obj when 'vector' if obj.length == 0 then null else obj[0..-1] when 'string' if obj.length == 0 then null else obj.split('') when 'nil' null else throw new Error "seq: called on non-sequential " + types._obj_type(seq) # Metadata functions with_meta = (obj,m) -> new_obj = types._clone(obj) new_obj.__meta__ = m new_obj exports.ns = { '=': (a,b) -> types._equal_Q(a,b), 'throw': (a) -> throw {"object": a}, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, 'number?': (a) -> typeof a == 'number', 'fn?': (a) -> typeof a == 'function' and not types._macro_Q(a), 'macro?': types._macro_Q, 'pr-str': (a...) -> a.map((exp) -> _pr_str(exp,true)).join(" "), 'str': (a...) -> a.map((exp) -> _pr_str(exp,false)).join(""), 'prn': (a...) -> println(a.map((exp) -> _pr_str(exp,true))...), 'println': (a...) -> println(a.map((exp) -> _pr_str(exp,false))...), 'readline': readline.readline, 'read-string': reader.read_str, 'slurp': (a) -> require('fs').readFileSync(a, 'utf-8'), '<': (a,b) -> a': (a,b) -> a>b, '>=': (a,b) -> a>=b, '+': (a,b) -> a+b, '-': (a,b) -> a-b, '*': (a,b) -> a*b, '/': (a,b) -> a/b, 'time-ms': () -> new Date().getTime(), 'list': (a...) -> a, 'list?': types._list_Q, 'vector': (a...) -> types._vector(a...), 'vector?': types._vector_Q, 'hash-map': (a...) -> types._hash_map(a...), 'map?': types._hash_map_Q, 'assoc': (a,b...) -> types._assoc_BANG(types._clone(a), b...), 'dissoc': (a,b...) -> types._dissoc_BANG(types._clone(a), b...), 'get': (a,b) -> if a != null and b of a then a[b] else null, 'contains?': (a,b) -> b of a, 'keys': (a) -> k for k of a, 'vals': (a) -> v for k,v of a, '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, 'rest': (a) -> if a == null then [] else a[1..], 'empty?': (a) -> a.length == 0, 'count': (a) -> if a == null then 0 else a.length, 'apply': (a,b...) -> a(b[0..-2].concat(b[b.length-1])...), 'map': (a,b) -> b.map((x) -> a(x)), 'conj': conj, 'seq': seq, 'with-meta': with_meta, 'meta': (a) -> a.__meta__ or null, 'atom': types._atom, 'atom?': types._atom_Q, 'deref': (a) -> a.val, 'reset!': (a,b) -> a.val = b, 'swap!': (a,b,c...) -> a.val = b([a.val].concat(c)...), } # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/env.coffee ================================================ types = require "./types.coffee" # Env exports.Env = class Env constructor: (@outer=null, @binds=[], @exprs=[]) -> @data = {} if @binds.length > 0 for b,i in @binds if types._symbol_Q(b) && b.name == "&" @data[@binds[i+1].name] = @exprs[i..] break else @data[b.name] = @exprs[i] find: (key) -> if key of @data then @ else if @outer then @outer.find(key) else null set: (key, value) -> if not types._symbol_Q(key) throw new Error("env.set key must be symbol") @data[key.name] = value get: (key) -> env = @find(key) throw new Error("'" + key + "' not found") if !env env.data[key] # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/node_readline.coffee ================================================ # IMPORTANT: choose one RL_LIB = "libreadline.so.8" # NOTE: libreadline is GPL #RL_LIB = "libedit.so.2" HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history') rlwrap = {} # namespace for this module in web context koffi = require('koffi') fs = require('fs') rllib = null try rllib = koffi.load(RL_LIB) catch e console.error 'ERROR loading RL_LIB:', RL_LIB, e throw e readlineFunc = rllib.func('char *readline(char *)') addHistoryFunc = rllib.func('int add_history(char *)') rl_history_loaded = false exports.readline = rlwrap.readline = (prompt = 'user> ') -> if !rl_history_loaded rl_history_loaded = true lines = [] if fs.existsSync(HISTORY_FILE) lines = fs.readFileSync(HISTORY_FILE).toString().split("\n") # Max of 2000 lines lines = lines[Math.max(lines.length - 2000, 0)..] for line in lines when line != "" addHistoryFunc line line = readlineFunc prompt if line addHistoryFunc line try fs.appendFileSync HISTORY_FILE, line + "\n" catch exc # ignored true line # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/package.json ================================================ { "name": "mal", "version": "0.0.1", "description": "Make a Lisp (mal) language implemented in CoffeeScript", "dependencies": { "coffeescript": "^2.7.0", "koffi": "^2.12.1" } } ================================================ FILE: impls/coffee/printer.coffee ================================================ types = require "./types.coffee" exports.println = (args...) -> console.log(args.join(" ")) || null exports._pr_str = _pr_str = (obj, print_readably=true) -> _r = print_readably switch types._obj_type obj when 'list' then '(' + obj.map((e) -> _pr_str(e,_r)).join(' ') + ')' when 'vector' then '[' + obj.map((e) -> _pr_str(e,_r)).join(' ') + ']' when 'hash-map' ret = [] ret.push(_pr_str(k,_r), _pr_str(v,_r)) for k,v of obj '{' + ret.join(' ') + '}' when 'string' if _r then '"' + (obj.replace(/\\/g, '\\\\') .replace(/"/g, '\\"') .replace(/\n/g, '\\n')) + '"' else obj when 'keyword' then ":" + obj.slice(1) when 'symbol' then obj.name when 'nil' then 'nil' when 'atom' then "(atom " + _pr_str(obj.val,_r) + ")" else obj.toString() # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/reader.coffee ================================================ types = require "./types.coffee" _symbol = types._symbol class Reader constructor: (@tokens) -> @position = 0 next: -> @tokens[@position++] peek: -> @tokens[@position] skip: -> @position++ @ tokenize = (str) -> re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g results = [] while (match = re.exec(str)[1]) != "" continue if match[0] == ';' results.push(match) results read_atom = (rdr) -> token = rdr.next() if token.match /^-?[0-9]+$/ then parseInt token,10 else if token.match /^-?[0-9][0-9.]*$/ then parseFloat token,10 else if token.match /^"(?:\\.|[^\\"])*"$/ token.slice(1, token.length-1) .replace(/\\(.)/g, (_, c) -> if c == 'n' then '\n' else c) else if token[0] == '"' throw new Error "expected '\"', got EOF" else if token[0] == ':' then types._keyword(token[1..]) else if token == "nil" then null else if token == "true" then true else if token == "false" then false else _symbol(token) read_list = (rdr, start='(', end=')') -> ast = [] token = rdr.next() throw new Error "expected '" + start + "'" if token != start while (token = rdr.peek()) != end throw new Error "expected '" + end + "', got EOF" if !token ast.push read_form rdr rdr.next() ast read_vector = (rdr) -> types._vector(read_list(rdr, '[', ']')...) read_hash_map = (rdr) -> types._hash_map(read_list(rdr, '{', '}')...) read_form = (rdr) -> token = rdr.peek() switch token when '\'' then [_symbol('quote'), read_form(rdr.skip())] when '`' then [_symbol('quasiquote'), read_form(rdr.skip())] when '~' then [_symbol('unquote'), read_form(rdr.skip())] when '~@' then [_symbol('splice-unquote'), read_form(rdr.skip())] when '^' meta = read_form(rdr.skip()) [_symbol('with-meta'), read_form(rdr), meta] when '@' then [_symbol('deref'), read_form(rdr.skip())] # list when ')' then throw new Error "unexpected ')'" when '(' then read_list(rdr) # vector when ']' then throw new Error "unexpected ']'" when '[' then read_vector(rdr) # hash-map when '}' then throw new Error "unexpected '}'" when '{' then read_hash_map(rdr) # atom else read_atom(rdr) exports.BlankException = BlankException = (msg) -> null exports.read_str = read_str = (str) -> tokens = tokenize(str) throw new BlankException() if tokens.length == 0 read_form(new Reader(tokens)) #console.log read_str "(1 \"two\" three)" #console.log read_str "[1 2 3]" #console.log read_str '{"abc" 123 "def" 456}' # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/run ================================================ #!/usr/bin/env bash exec coffee $(dirname $0)/${STEP:-stepA_mal}.coffee "${@}" ================================================ FILE: impls/coffee/step0_repl.coffee ================================================ readline = require "./node_readline.coffee" # read READ = (str) -> str # eval EVAL = (ast, env) -> ast # print PRINT = (exp) -> exp # repl rep = (str) -> PRINT(EVAL(READ(str), {})) # repl loop while (line = readline.readline("user> ")) != null continue if line == "" console.log rep line # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step1_read_print.coffee ================================================ readline = require "./node_readline.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> ast # print PRINT = (exp) -> printer._pr_str exp, true # repl rep = (str) -> PRINT(EVAL(READ(str), {})) # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step2_eval.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> # console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env[ast.name] else if types._list_Q(ast) then # exit this switch else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [f, args...] = ast.map((a) -> EVAL(a, env)) f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = {} rep = (str) -> PRINT(EVAL(READ(str), repl_env)) repl_env["+"] = (a,b) -> a+b repl_env["-"] = (a,b) -> a-b repl_env["*"] = (a,b) -> a*b repl_env["/"] = (a,b) -> a/b # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step3_env.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [a0, a1, a2, a3] = ast switch a0.name when "def!" env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) EVAL(a2, let_env) else [f, args...] = ast.map((a) -> EVAL(a, env)) f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) repl_env.set types._symbol("+"), (a,b) -> a+b repl_env.set types._symbol("-"), (a,b) -> a-b repl_env.set types._symbol("*"), (a,b) -> a*b repl_env.set types._symbol("/"), (a,b) -> a/b # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step4_if_fn_do.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [a0, a1, a2, a3] = ast switch a0.name when "def!" env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) EVAL(a2, let_env) when "do" el = ast[1..].map((a) -> EVAL(a, env)) el[el.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then EVAL(a3, env) else null else EVAL(a2, env) when "fn*" (args...) -> EVAL(a2, new Env(env, a1, args)) else [f, args...] = ast.map((a) -> EVAL(a, env)) f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step5_tco.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else [f, args...] = ast.map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step6_file.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else [f, args...] = ast.map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) repl_env.set types._symbol('*ARGV*'), [] # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if process? && process.argv.length > 2 repl_env.set types._symbol('*ARGV*'), process.argv[3..] rep('(load-file "' + process.argv[2] + '")') process.exit 0 # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step7_quote.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval 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 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 EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast if ast.length == 0 then return ast # apply list [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "quote" return a1 when "quasiquote" ast = quasiquote(a1) when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else [f, args...] = ast.map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) repl_env.set types._symbol('*ARGV*'), [] # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if process? && process.argv.length > 2 repl_env.set types._symbol('*ARGV*'), process.argv[3..] rep('(load-file "' + process.argv[2] + '")') process.exit 0 # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step8_macros.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval 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 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 EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast # apply list if ast.length == 0 then return ast [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "quote" return a1 when "quasiquote" ast = quasiquote(a1) when "defmacro!" f = EVAL(a2, env) f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else f = EVAL(a0, env) if f.__ismacro__ ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) continue args = ast[1..].map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) repl_env.set types._symbol('*ARGV*'), [] # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if process? && process.argv.length > 2 repl_env.set types._symbol('*ARGV*'), process.argv[3..] rep('(load-file "' + process.argv[2] + '")') process.exit 0 # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? then console.log exc.stack else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/step9_try.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval 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 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 EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast # apply list if ast.length == 0 then return ast [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "quote" return a1 when "quasiquote" ast = quasiquote(a1) when "defmacro!" f = EVAL(a2, env) f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) when "try*" try return EVAL(a1, env) catch exc if a2 && a2[0].name == "catch*" if exc.object? then exc = exc.object else exc = exc.message return EVAL a2[2], new Env(env, [a2[1]], [exc]) else throw exc when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else f = EVAL(a0, env) if f.__ismacro__ ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) continue args = ast[1..].map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) repl_env.set types._symbol('*ARGV*'), [] # core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if process? && process.argv.length > 2 repl_env.set types._symbol('*ARGV*'), process.argv[3..] rep('(load-file "' + process.argv[2] + '")') process.exit 0 # repl loop while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? console.log exc.stack else if exc.object? console.log "Error:", printer._pr_str exc.object, true else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/stepA_mal.coffee ================================================ readline = require "./node_readline.coffee" types = require "./types.coffee" reader = require "./reader.coffee" printer = require "./printer.coffee" Env = require("./env.coffee").Env core = require("./core.coffee") # read READ = (str) -> reader.read_str str # eval 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 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 EVAL = (ast, env) -> loop dbgenv = env.find("DEBUG-EVAL") if dbgenv dbgeval = dbgenv.get("DEBUG-EVAL") if dbgeval != null and dbgeval != false console.log "EVAL:", printer._pr_str ast if types._symbol_Q(ast) then return env.get ast.name else if types._list_Q(ast) then # exit this switch else if types._vector_Q(ast) return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast return new_hm else return ast # apply list if ast.length == 0 then return ast [a0, a1, a2, a3] = ast switch a0.name when "def!" return env.set(a1, EVAL(a2, env)) when "let*" let_env = new Env(env) for k,i in a1 when i %% 2 == 0 let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env when "quote" return a1 when "quasiquote" ast = quasiquote(a1) when "defmacro!" f = EVAL(a2, env) f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) when "try*" try return EVAL(a1, env) catch exc if a2 && a2[0].name == "catch*" if exc.object? then exc = exc.object else exc = exc.message || exc.toString() return EVAL a2[2], new Env(env, [a2[1]], [exc]) else throw exc when "js*" res = eval(a1.toString()) return if typeof(res) == 'undefined' then null else res when "." el = ast[2..].map((a) -> EVAL(a, env)) return eval(a1.toString())(el...) when "do" ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) if cond == null or cond == false if a3? then ast = a3 else return null else ast = a2 when "fn*" return types._function(EVAL, a2, env, a1) else f = EVAL(a0, env) if f.__ismacro__ ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) continue args = ast[1..].map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) # print PRINT = (exp) -> printer._pr_str exp, true # repl repl_env = new Env() rep = (str) -> PRINT(EVAL(READ(str), repl_env)) # core.coffee: defined using CoffeeScript repl_env.set types._symbol(k), v for k,v of core.ns repl_env.set types._symbol('eval'), (ast) -> EVAL(ast, repl_env) repl_env.set types._symbol('*ARGV*'), [] # core.mal: defined using the language itself rep("(def! *host-language* \"CoffeeScript\")") rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if process? && process.argv.length > 2 repl_env.set types._symbol('*ARGV*'), process.argv[3..] rep('(load-file "' + process.argv[2] + '")') process.exit 0 # repl loop rep("(println (str \"Mal [\" *host-language* \"]\"))") while (line = readline.readline("user> ")) != null continue if line == "" try console.log rep line catch exc continue if exc instanceof reader.BlankException if exc.stack? and exc.stack.length > 2000 console.log exc.stack.slice(0,1000) + "\n ..." + exc.stack.slice(-1000) else if exc.stack? console.log exc.stack else if exc.object? console.log "Error:", printer._pr_str exc.object, true else console.log exc # vim: ts=2:sw=2 ================================================ FILE: impls/coffee/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/coffee/tests/stepA_mal.mal ================================================ ;; Testing basic bash interop (js* "7") ;=>7 (js* "'7'") ;=>"7" (js* "[7,8,9]") ;=>(7 8 9) (js* "console.log('hello');") ;/hello ;=>nil (js* "foo=8;") (js* "foo;") ;=>8 (js* "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") ;=>"XaY XbY XcY" (js* "[1,2,3].map(function(x){return 1+x})") ;=>(2 3 4) ================================================ FILE: impls/coffee/types.coffee ================================================ Env = require("./env.coffee").Env E = exports # General functions E._obj_type = _obj_type = (obj) -> if _symbol_Q(obj) then 'symbol' else if _list_Q(obj) then 'list' else if _vector_Q(obj) then 'vector' else if _hash_map_Q(obj) then 'hash-map' else if _nil_Q(obj) then 'nil' else if _true_Q(obj) then 'true' else if _false_Q(obj) then 'false' else if _atom_Q(obj) then 'atom' else switch typeof obj when 'number' then 'number' when 'function' then 'function' when 'string' if obj[0] == '\u029e' then 'keyword' else 'string' else throw new Error "Unknown type '" + typeof(obj) + "'" E._sequential_Q = _sequential_Q = (o) -> _list_Q(o) or _vector_Q(o) E._equal_Q = _equal_Q = (a,b) -> [ota, otb] = [_obj_type(a), _obj_type(b)] if !(ota == otb or (_sequential_Q(a) && _sequential_Q(b))) return false switch (ota) when 'symbol' then a.name == b.name when 'list', 'vector' return false if a.length != b.length for av,i in a return false if !_equal_Q(av, b[i]) true when 'hash-map' akeys = (key for key of a) bkeys = (key for key of b) return false if akeys.length != bkeys.length for akey,i in akeys return false if !_equal_Q(a[akey], b[akey]) true else a == b E._clone = _clone = (obj) -> switch _obj_type(obj) when 'list' then obj[0..-1] when 'vector' then _vector(obj[0..-1]...) when 'hash-map' new_obj = {} new_obj[k] = v for k,v of obj new_obj when 'function' new_obj = (args...) -> obj(args...) new_obj[k] = v for k,v of obj new_obj else throw new Error "clone called on non-collection" + _obj_type(obj) # Scalars E._nil_Q = _nil_Q = (o) -> o == null E._true_Q = _true_Q = (o) -> o == true E._false_Q = _false_Q = (o) -> o == false E._string_Q = _string_Q = (o) -> _obj_type(o) == 'string' # Symbols class Symbol constructor: (@name) -> E._symbol = (str) -> new Symbol str E._symbol_Q = _symbol_Q = (o) -> o instanceof Symbol # Keywords E._keyword = _keyword = (o) -> _keyword_Q(o) && o || ("\u029e" + o) E._keyword_Q = _keyword_Q = (o) -> typeof o == 'string' && o[0] == "\u029e" # Functions E._function = (evalfn, ast, env, params) -> fn = (args...) -> evalfn(ast, new Env(env, params, args)) fn.__ast__ = ast fn.__gen_env__ = (args) -> new Env(env, params, args) fn.__ismacro__ = false fn E._function_Q = _function_Q = (o) -> !!o.__ast__ E._macro_Q = _macro_Q = (o) -> _function_Q(o) and o.__ismacro__ # Lists E._list_Q = _list_Q = (o) -> Array.isArray(o) && !o.__isvector__ # Vectors E._vector = _vector = (args...) -> v = args v.__isvector__ = true v E._vector_Q = _vector_Q = (o) -> Array.isArray(o) && !!o.__isvector__ # Hash Maps E._hash_map = (args...) -> args = [{}].concat args _assoc_BANG(args...) E._assoc_BANG = _assoc_BANG = (hm, args...) -> if args.length %% 2 == 1 throw new Error "Odd number of hash map arguments" hm[k] = args[i+1] for k, i in args when i %% 2 == 0 hm E._dissoc_BANG = (hm, args...) -> delete hm[k] for k, i in args hm E._hash_map_Q = _hash_map_Q = (o) -> typeof o == "object" && !Array.isArray(o) && !(o == null) && !(o instanceof Symbol) && !(o instanceof Atom) # Atoms class Atom constructor: (@val) -> E._atom = (val) -> new Atom val E._atom_Q = _atom_Q = (o) -> o instanceof Atom # vim: ts=2:sw=2 ================================================ FILE: impls/common-lisp/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install curl git libreadline-dev libedit-dev # Install sbcl RUN apt-get -y install sbcl # Install cl-asdf (CLISP does not seem to come with it) RUN apt-get -y install cl-launch cl-asdf cl-ppcre RUN cd /tmp && \ git clone https://gitlab.common-lisp.net/xcvb/cl-launch.git && \ cd cl-launch && \ make install # Install wget needed to install quicklisp RUN apt-get -y install wget # Install quicklisp RUN HOME=/ && \ cd /tmp && \ wget https://beta.quicklisp.org/quicklisp.lisp && \ sbcl --load quicklisp.lisp --quit --eval '(quicklisp-quickstart:install)' --eval '(ql-util:without-prompting (ql:add-to-init-file))' RUN chmod -R a+rwx /quicklisp RUN chmod a+rwx /.sbclrc RUN mkdir -p /.cache RUN chmod -R a+rwx /.cache ================================================ FILE: impls/common-lisp/Makefile ================================================ # Helper functions define record_lisp $(shell (test -f "hist/$(1)_impl" && grep -q $(2) "hist/$(1)_impl") || echo $(2) > "hist/$(1)_impl") endef define steps $(if $(MAKECMDGOALS),\ $(if $(findstring all,$(MAKECMDGOALS)),\ stepA_mal,\ $(filter step%, $(MAKECMDGOALS))),\ stepA_mal) endef LISP ?= sbcl ABCL ?= abcl MKCL ?= mkcl BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ step5_tco step6_file step7_quote step8_macros step9_try stepA_mal # TODO: In theory cl-launch should be able to build standalone executable using # MKCL unfortunately the executable crashes on startup STANDALONE_EXE = sbcl clisp ccl ecl cmucl ROOT_DIR := $(shell dirname $(realpath $(lastword $(MAKEFILE_LIST)))) # Record the Common Lisp implementation used for all steps built in this # invocation This is used in the targets to rebuild the step if the # implementation changes $(foreach step, $(call steps), $(call record_lisp,$(patsubst step%,%,$(step)),$(LISP))) .PRECIOUS: hist/%_impl all : $(BINS) hist/%_impl: ; # CL_LAUNCH_VERSION is only defined while building it. We change to the # directory of the CL_LAUNCH_FILE in --wrap script so that the script can find the dumped # image even if invoked from some directory different from where it # currently resides step% : src/step%.lisp src/utils.lisp src/types.lisp src/env.lisp src/printer.lisp src/reader.lisp src/core.lisp hist/%_impl ifeq ($(LISP),clisp) @echo "==============================================================" @echo "WARNING: This build might fail since GNU Clisp does not have bundled version of asdf (yet)" @echo "Please do something like below to make it work" @echo "(mkdir -p ~/common-lisp/ && cd ~/common-lisp && git clone -b release https://gitlab.common-lisp.net/asdf/asdf.git && cd asdf && make)" @echo "==============================================================" endif ifneq ($(filter $(LISP),$(STANDALONE_EXE)),) sbcl --eval '(load "~/quicklisp/setup.lisp")' --eval '(asdf:initialize-source-registry `(:source-registry (:tree "$(ROOT_DIR)") :inherit-configuration))' --eval '(ql:quickload :uiop)' --eval '(ql:quickload :cl-readline)' --eval '(ql:quickload :genhash)' --eval '(asdf:load-system "$@")' --eval '(asdf:operate :build-op "$@")' --eval "(save-lisp-and-die \"$@\" :executable t :toplevel #'(lambda () (mal:main)))" --quit else ifeq ($(LISP),abcl) echo -n '#!/bin/sh\ncd `dirname $$0` ; $(ABCL) --noinform --noinit --nosystem --load run-abcl.lisp -- $@ $$@' > $@ chmod +x $@ else ifeq ($(LISP),mkcl) $(MKCL) -eval '(progn (require "asdf") (push *default-pathname-defaults* asdf:*central-registry*) (asdf:load-system "$@") (quit))' echo -n '#!/bin/sh\ncd `dirname $$0` ; $(MKCL) -q -load run-mkcl.lisp -- $@ $$@' > $@ chmod +x $@ else ifeq ($(LISP),allegro) cl-launch --wrap 'if [ -z "$$CL_LAUNCH_VERSION" ] ; then cd "$$(dirname $$CL_LAUNCH_FILE)" ; fi' --verbose --lisp $(LISP) --source-registry $(ROOT_DIR) --system $@ --dump images/$@.$(LISP).image -o $@ --entry 'mal:main' else @echo "Unsupported Lisp implementation $(LISP)" @exit 1 endif clean: find . -maxdepth 1 -name 'step*' -executable -delete rm -f *.lib *.fas[l] images/* hist/*_impl ================================================ FILE: impls/common-lisp/README.org ================================================ * Implementation of MAL in Common Lisp ** Introduction This is a portable implementation of MAL in Common Lisp. It has been tested to work with following Common Lisp implementations - Steel Bank Common Lisp [[http://sbcl.org/]] - Clozure Common Lisp [[http://ccl.clozure.com/]] - CMU Common Lisp [[https://www.cons.org/cmucl/]] - GNU CLISP [[http://www.clisp.org/]] - Embeddable Common Lisp [[https://common-lisp.net/project/ecl/]] - ManKai Common Lisp https://common-lisp.net/project/mkcl/ - Allegro CL [[http://franz.com/products/allegro-common-lisp/]] - Armed Bear Common Lisp [[http://abcl.org/]] [[http://www.cliki.net/cl-launch][cl-launch]] to build executable/wrapper scripts for most of the above implementations. ** Dependencies - cl-launch For building command line executable scripts. See [[http://www.cliki.net/cl-launch][cl-launch]] - quicklisp For installing dependencies. See [[https://www.quicklisp.org/beta/][quicklisp]] - readline For readline integration. You can install it on Ubuntu using apt the package is ~libreadline-dev~. If you wish to run the implementation using Allegro CL, you will also have to install the 32 bit version of readline (~lib32readline-dev~ on Ubuntu) - (Optional) asdf This is needed if you want to run the implementation using GNU CLISP, since GNU CLISP does not ship with ~asdf~ and ~cl-launch~ depends on it. You can install it on Ubuntu using apt the package is ~cl-asdf~ ** Running using different implementations By default the MAL is built using ~sbcl~, you can control this using ~LISP~ environment variable. The variable should be set to the cl-launch "nickname" for implementation. The nicknames that work currently are |------------------------+----------| | Implementation | Nickname | |------------------------+----------| | Steel Bank Common Lisp | sbcl | | Clozure Common Lisp | ccl | | CMU Common Lisp | cmucl | | GNU CLISP | clisp | | Embeddable Common Lisp | ecl | | ManKai Common Lisp | mkcl | | Allegro CL | allegro | | Armed Bear Common Lisp | abcl | |------------------------+----------| For example to build with GNU CLISP, you need to do the following #+BEGIN_SRC sh cd common-lisp ; LISP=clisp make #+END_SRC You can control the implementation binary used for the build using environment variables. For a given implementation nickname, the environment variable will be the capitalization of the given nickname. |------------------------+-------------| | Implementation | Binary Path | |------------------------+-------------| | Steel Bank Common Lisp | SBCL | | Clozure Common Lisp | CCL | | CMU Common Lisp | CMUCL | | GNU CLISP | CLISP | | Embeddable Common Lisp | ECL | | ManKai Common Lisp | MKCL | | Allegro CL | ALLEGRO | | Armed Bear Common Lisp | ABCL | |------------------------+-------------| For example to build MAL with Clozure CL installed in ~\~/.roswell/impls/x86-64/linux/ccl-bin/1.11/lx86cl64~, you need to do the following #+BEGIN_SRC sh cd common-lisp ; LISP=ccl CCL=~/.roswell/impls/x86-64/linux/ccl-bin/1.11/lx86cl64 make #+END_SRC You can use the variables ~*cl-implementation*~ and ~*cl-version*~ can be used to in MAL REPL to check the Common Lisp implementation and the version used for building it. ** Interop There is some basic interop in the form ~cl-eval~ which takes a string and evaluates it as Common Lisp code, the result is returned in form of a MAL value, as such you are limited to code that produces values that have MAL counterparts. ** Known Issues ABCL takes a long to boot as such it needs to be run with ~TEST_OPTS~ set to ~--start-timeout 120~ ================================================ FILE: impls/common-lisp/fake-readline.lisp ================================================ ;; For some reason MKCL fails to find libreadline.so as a result cl-readline ;; fails. To avoid conditionals in the code we fake the cl-readline interface ;; and use it in asdf definitions when running under MKCL (defpackage :cl-readline (:nicknames :rl) (:use :common-lisp)) (in-package :cl-readline) (defun readline (&keys prompt already-prompted num-chars erase-empty-line add-history novelty-check) (declare (ignorable ignored)) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun register-function (&rest ignored) (declare (ignorable ignored))) ================================================ FILE: impls/common-lisp/hist/.keepdir ================================================ ================================================ FILE: impls/common-lisp/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/common-lisp/run-abcl.lisp ================================================ (require 'asdf) (push *default-pathname-defaults* asdf:*central-registry*) ;; Suppress compilation output (let ((*error-output* (make-broadcast-stream)) (*standard-output* (make-broadcast-stream))) (asdf:load-system (car ext:*command-line-argument-list*) :verbose nil)) (mal:main (cdr ext:*command-line-argument-list*)) (cl-user::quit) ================================================ FILE: impls/common-lisp/run-mkcl.lisp ================================================ (require 'asdf) (push *default-pathname-defaults* asdf:*central-registry*) (defvar *raw-command-line-args* (loop :for index :from 1 :below (mkcl:argc) :collect (mkcl:argv index))) (defvar *command-line-args* (subseq *raw-command-line-args* (min (1+ (position "--" *raw-command-line-args* :test #'string=)) (length *raw-command-line-args*)))) ;; Suppress compilation output (let ((*error-output* (make-broadcast-stream)) (*standard-output* (make-broadcast-stream))) (format *standard-output* "~a" *command-line-args*) (asdf:load-system (car *command-line-args*) :verbose nil)) (mal:main (cdr *command-line-args*)) (quit) ================================================ FILE: impls/common-lisp/src/core.lisp ================================================ (defpackage :core (:use :common-lisp :utils :types :reader :printer :genhash :alexandria) (:export :ns)) (in-package :core) (define-condition index-error (mal-error) ((size :initarg :size :reader index-error-size) (index :initarg :index :reader index-error-index) (sequence :initarg :sequence :reader index-error-sequence)) (:report (lambda (condition stream) (format stream "Index out of range (~a), length is ~a but index given was ~a" (printer:pr-str (index-error-sequence condition)) (index-error-size condition) (index-error-index condition))))) (defmacro wrap-boolean (form) `(if ,form mal-true mal-false)) (defvar ns nil) (defmacro defmal (name arglist &rest body) (let* ((symbol-name (if (stringp name) name ;; Since common lisp intern all the symbols in ;; uppercase (by default) we need to convert the ;; symbol to lowercase while introducing it in MAL ;; environment (string-downcase (symbol-name name)))) (internal-name (format nil "MAL-~a" (string-upcase symbol-name)))) `(push (cons (make-mal-symbol ,symbol-name) (make-mal-builtin-fn (defun ,(intern internal-name) ,arglist ,@body))) ns))) (defmal + (value1 value2) (make-mal-number (+ (mal-data-value value1) (mal-data-value value2)))) (defmal - (value1 value2) (make-mal-number (- (mal-data-value value1) (mal-data-value value2)))) (defmal * (value1 value2) (make-mal-number (* (mal-data-value value1) (mal-data-value value2)))) (defmal / (value1 value2) (make-mal-number (round (/ (mal-data-value value1) (mal-data-value value2))))) (defmal prn (&rest strings) ;; Using write-line instead of (format *standard-output* ... ) since the later prints ;; and extra newline at start in GNU CLISP, if environment variable PERL_RL is true ;; or terminal is dumb (write-line (format nil "~{~a~^ ~}" (mapcar (lambda (string) (printer:pr-str string t)) strings))) mal-nil) (defmal println (&rest strings) ;; Using write-line instead of (format *standard-output* ... ) since the later prints ;; and extra newline at start in GNU CLISP, if environment variable PERL_RL is true ;; or terminal is dumb (write-line (format nil "~{~a~^ ~}" (mapcar (lambda (string) (printer:pr-str string nil)) strings))) mal-nil) (defmal pr-str (&rest strings) (make-mal-string (format nil "~{~a~^ ~}" (mapcar (lambda (string) (printer:pr-str string t)) strings)))) (defmal str (&rest strings) (make-mal-string (format nil "~{~a~}" (mapcar (lambda (string) (printer:pr-str string nil)) strings)))) (defmal list (&rest values) (make-mal-list values)) (defmal list? (value) (wrap-boolean (mal-list-p value))) (defmal empty? (value) (wrap-boolean (zerop (length (mal-data-value value))))) (defmal count (value) (make-mal-number (length (mal-data-value value)))) (defmal = (value1 value2) (wrap-boolean (mal-data-value= value1 value2))) (defmal < (value1 value2) (wrap-boolean (< (mal-data-value value1) (mal-data-value value2)))) (defmal > (value1 value2) (wrap-boolean (> (mal-data-value value1) (mal-data-value value2)))) (defmal <= (value1 value2) (wrap-boolean (<= (mal-data-value value1) (mal-data-value value2)))) (defmal >= (value1 value2) (wrap-boolean (>= (mal-data-value value1) (mal-data-value value2)))) (defmal read-string (value) (reader:read-str (mal-data-value value))) (defmal slurp (filename) (make-mal-string (read-file-string (mal-data-value filename)))) (defmal atom (value) (make-mal-atom value)) (defmal atom? (value) (wrap-boolean (mal-atom-p value))) (defmal deref (atom) (mal-data-value atom)) (defmal reset! (atom value) (setf (mal-data-value atom) value)) (defmal swap! (atom fn &rest args) (setf (mal-data-value atom) (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))))) (defmal concat (&rest lists) (make-mal-list (apply #'concatenate 'list (mapcar #'mal-data-value lists)))) (defmal nth (sequence index) (or (nth (mal-data-value index) (listify (mal-data-value sequence))) (error 'index-error :size (length (mal-data-value sequence)) :index (mal-data-value index) :sequence sequence))) (defmal first (sequence) (or (first (listify (mal-data-value sequence))) mal-nil)) (defmal rest (sequence) (make-mal-list (rest (listify (mal-data-value sequence))))) (defmal throw (value) (error 'mal-user-exception :data value)) (defmal apply (fn &rest values) (let ((last (listify (mal-data-value (car (last values))))) (butlast (butlast values))) (apply (mal-data-value fn) (append butlast last)))) (defmal map (fn sequence) (let ((applicants (listify (mal-data-value sequence)))) (make-mal-list (mapcar (mal-data-value fn) applicants)))) (defmal nil? (value) (wrap-boolean (mal-nil-p value))) (defmal true? (value) (wrap-boolean (and (mal-boolean-p value) (mal-data-value value)))) (defmal false? (value) (wrap-boolean (and (mal-boolean-p value) (not (mal-data-value value))))) (defmal number? (value) (wrap-boolean (mal-number-p value))) (defmal symbol (string) (make-mal-symbol (mal-data-value string))) (defmal symbol? (value) (wrap-boolean (mal-symbol-p value))) (defmal keyword (keyword) (if (mal-keyword-p keyword) keyword (make-mal-keyword (format nil ":~a" (mal-data-value keyword))))) (defmal keyword? (value) (wrap-boolean (mal-keyword-p value))) (defmal vector (&rest elements) (make-mal-vector (map 'vector #'identity elements))) (defmal vector? (value) (wrap-boolean (mal-vector-p value))) (defmal fn? (value) (wrap-boolean (or (mal-builtin-fn-p value) (and (mal-fn-p value) (not (cdr (assoc :is-macro (mal-data-attrs value)))))))) (defmal macro? (value) (wrap-boolean (and (mal-fn-p value) (cdr (assoc :is-macro (mal-data-attrs value)))))) (defmal hash-map (&rest elements) (let ((hash-map (make-mal-value-hash-table))) (loop for (key value) on elements by #'cddr do (setf (hashref key hash-map) value)) (make-mal-hash-map hash-map))) (defmal map? (value) (wrap-boolean (mal-hash-map-p value))) (defmal assoc (hash-map &rest elements) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-map (make-mal-value-hash-table))) (hashmap (lambda (key value) (declare (ignorable value)) (setf (hashref key new-hash-map) (hashref key hash-map-value))) hash-map-value) (loop for (key value) on elements by #'cddr do (setf (hashref key new-hash-map) value)) (make-mal-hash-map new-hash-map))) (defmal dissoc (hash-map &rest elements) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-map (make-mal-value-hash-table))) (hashmap (lambda (key value) (declare (ignorable value)) (when (not (member key elements :test #'mal-data-value=)) (setf (hashref key new-hash-map) (hashref key hash-map-value)))) hash-map-value) (make-mal-hash-map new-hash-map))) (defmal get (hash-map key) (or (and (mal-hash-map-p hash-map) (hashref key (mal-data-value hash-map))) types:mal-nil)) (defmal contains? (hash-map key) (if (genhash:hashref key (types:mal-data-value hash-map)) types:mal-true types:mal-false)) (defmal keys (hash-map) (let ((hash-map-value (mal-data-value hash-map)) keys) (hashmap (lambda (key value) (declare (ignorable value)) (push key keys)) hash-map-value) (make-mal-list (nreverse keys)))) (defmal vals (hash-map) (let ((hash-map-value (mal-data-value hash-map)) values) (hashmap (lambda (key value) (declare (ignorable key)) (push value values)) hash-map-value) (make-mal-list (nreverse values)))) (defmal sequential? (value) (wrap-boolean (or (mal-vector-p value) (mal-list-p value)))) (defmal readline (prompt) (format *standard-output* (mal-data-value prompt)) (force-output *standard-output*) (make-mal-string (read-line *standard-input* nil))) (defmal string? (value) (wrap-boolean (mal-string-p value))) (defmal time-ms () (make-mal-number (round (/ (get-internal-real-time) (/ internal-time-units-per-second 1000))))) (defmal conj (value &rest elements) (cond ((mal-list-p value) (make-mal-list (append (nreverse elements) (mal-data-value value)))) ((mal-vector-p value) (make-mal-vector (concatenate 'vector (mal-data-value value) elements))) (t (error 'mal-user-exception)))) (defmal seq (value) (if (zerop (length (mal-data-value value))) mal-nil (cond ((mal-list-p value) value) ((mal-vector-p value) (make-mal-list (listify (mal-data-value value)))) ((mal-string-p value) (make-mal-list (mapcar (alexandria:compose #'make-mal-string #'string) (coerce (mal-data-value value) 'list)))) (t (error 'mal-user-exception))))) (defmal with-meta (value meta) (funcall (switch-mal-type value (types:string #'make-mal-string) (types:symbol #'make-mal-symbol) (types:list #'make-mal-list) (types:vector #'make-mal-vector) (types:hash-map #'make-mal-hash-map) (types:fn #'make-mal-fn) (types:builtin-fn #'make-mal-builtin-fn)) (mal-data-value value) :meta meta :attrs (mal-data-attrs value))) (defmal meta (value) (or (types:mal-data-meta value) types:mal-nil)) (defun wrap-value (value &optional booleanp listp) (typecase value (number (make-mal-number value)) ;; This needs to be before symbol since nil is a symbol (null (cond (booleanp mal-false) (listp (make-mal-list value)) (t mal-nil))) ;; This needs to before symbol since t, nil are symbols (boolean (if value mal-true mal-nil)) (keyword (make-mal-keyword value)) (symbol (make-mal-symbol (symbol-name value))) (string (make-mal-string value)) (list (make-mal-list (map 'list #'wrap-value value))) (vector (make-mal-vector (map 'vector #'wrap-value value))) (hash-table (make-mal-hash-map (let ((new-hash-table (make-mal-value-hash-table))) (hashmap (lambda (key value) (setf (hashref (wrap-value key) new-hash-table) (wrap-value value))) value) new-hash-table))))) ;; Since a nil in Common LISP may mean an empty list or boolean false or ;; simply nil, the caller can specify the preferred type while evaluating an ;; expression (defmal cl-eval (code &optional booleanp listp) (wrap-value (eval (read-from-string (mal-data-value code))) (and booleanp (mal-data-value booleanp)) (and listp (mal-data-value listp)))) ================================================ FILE: impls/common-lisp/src/env.lisp ================================================ (defpackage :env (:use :common-lisp :types) (:shadow :symbol) (:export :undefined-symbol :create-mal-env :get-env :set-env :mal-env-bindings)) (in-package :env) (define-condition undefined-symbol (mal-runtime-exception) ((symbol :initarg :symbol :reader symbol)) (:report (lambda (condition stream) (format stream "'~a' not found" (symbol condition))))) (define-condition arity-mismatch (mal-runtime-exception) ((required :initarg :required :reader required) (provided :initarg :provided :reader provided)) (:report (lambda (condition stream) (format stream "Unexpected number of arguments provided, expected ~a, got ~a" (required condition) (provided condition))))) (defstruct mal-env (bindings (make-hash-table :test 'equal) :read-only t) (parent nil :read-only t)) (defun get-env (env symbol) (or (gethash symbol (mal-env-bindings env)) (let ((outer (mal-env-parent env))) (if outer (get-env outer symbol) nil)))) (defun set-env (env symbol value) (setf (gethash (mal-data-value symbol) (mal-env-bindings env)) value)) (defun create-mal-env (&key parent binds exprs) (let ((env (make-mal-env :parent parent)) (params-length (length binds)) (arg-length (length exprs))) (flet ((arity-mismatch () (error 'arity-mismatch :required params-length :provided arg-length))) (loop for key = (pop binds) while key do (if (string/= (mal-data-value key) "&") (set-env env key (or (pop exprs) (arity-mismatch))) (progn (set-env env (or (pop binds) (arity-mismatch)) (make-mal-list exprs)) (setq binds nil)))) env))) ================================================ FILE: impls/common-lisp/src/printer.lisp ================================================ (defpackage :printer (:use :common-lisp :types) (:import-from :genhash :hashmap) (:import-from :cl-ppcre :regex-replace) (:import-from :utils :replace-all :listify) (:export :pr-str)) (in-package :printer) (defun pr-mal-sequence (start-delimiter sequence end-delimiter &optional (print-readably t)) (format nil "~a~{~a~^ ~}~a" start-delimiter (mapcar (lambda (value) (pr-str value print-readably)) (listify (mal-data-value sequence))) end-delimiter)) (defun pr-mal-hash-map (hash-map &optional (print-readably t) &aux repr) (hashmap (lambda (key value) (push (pr-str value print-readably) repr) (push (pr-str key print-readably) repr)) (mal-data-value hash-map)) (format nil "{~{~a ~a~^ ~}}" repr)) (defun pr-string (ast &optional (print-readably t)) (if print-readably (replace-all (prin1-to-string (mal-data-value ast)) " " "\\n") (mal-data-value ast))) (defun pr-str (ast &optional (print-readably t)) (when ast (switch-mal-type ast (types:number (format nil "~d" (mal-data-value ast))) (types:boolean (if (mal-data-value ast) "true" "false")) (types:nil "nil") (types:string (pr-string ast print-readably)) (types:symbol (format nil "~a" (mal-data-value ast))) (types:keyword (format nil "~a" (mal-data-value ast))) (types:list (pr-mal-sequence "(" ast ")" print-readably)) (types:vector (pr-mal-sequence "[" ast "]" print-readably)) (types:hash-map (pr-mal-hash-map ast print-readably)) (types:atom (format nil "(atom ~a)" (pr-str (mal-data-value ast)))) (types:fn "#") (types:builtin-fn "#")))) ================================================ FILE: impls/common-lisp/src/reader.lisp ================================================ (defpackage :reader (:use :common-lisp :types :alexandria) (:import-from :genhash :hashref) (:import-from :cl-ppcre :create-scanner :do-matches-as-strings :scan) (:import-from :utils :replace-all) (:export :read-str :eof :unexpected-token)) (in-package :reader) ;; Possible errors that can be raised while reading a string (define-condition unexpected-token (error) ((expected :initarg :expected :reader expected-token) (actual :initarg :actual :reader actual-token)) (:report (lambda (condition stream) (format stream "Unexpected token (~a) encountered while reading, expected ~a" (actual-token condition) (expected-token condition)))) (:documentation "Error raised when an unexpected token is encountered while reading.")) (define-condition eof (error) ((context :initarg :context :reader context)) (:report (lambda (condition stream) (format stream "EOF encountered while reading '~a'" (context condition)))) (:documentation "Error raised when EOF is encountered while reading.")) (defvar *tokenizer-re* (create-scanner "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") "Regular expression to tokenize Lisp code") (defvar *number-re* (create-scanner "^(-|\\+)?[\\d]+$") "Regular expression to match a number") (defvar *string-re* (create-scanner "^\"(?:\\\\.|[^\\\\\"])*\"$") "Regular expression to match a string") (defvar *whitespace-chars* '(#\Space #\Newline #\Backspace #\Tab #\Linefeed #\Page #\Return #\Rubout #\,) "Characters to treat as whitespace, these are trimmed in `tokenize'") (defun tokenize (string) "Tokenize given string. This function extracts all tokens from the string using *tokenizer-re* comments are ignored. Implementation notes: The regex scan generates some empty tokens, not really sure why." (let (tokens) (do-matches-as-strings (match *tokenizer-re* string) (let ((token (string-trim *whitespace-chars* match))) (unless (or (zerop (length token)) (char= (char token 0) #\;)) (push token tokens)))) (nreverse tokens))) ;; Reader (defstruct (token-reader) (tokens nil)) (defun peek (reader) "Returns the next token in the reader without advancing the token stream." (car (token-reader-tokens reader))) (defun next (reader) "Returns the next token and advances the token stream." (pop (token-reader-tokens reader))) (defun consume (reader &optional (token nil token-provided-p)) "Consume the next token and advance the token stream. If the optional argument token is provided the token stream is advanced only if token being consumes matches it otherwise and unexpected token error is raised" (let ((actual-token (pop (token-reader-tokens reader)))) (when (and token-provided-p (not (equal actual-token token))) (error 'unexpected-token :expected token :actual actual-token))) reader) (defun parse-string (token) ;; read-from-string doesn't handle \n (if (and (> (length token) 1) (scan *string-re* token)) (let ((input (subseq token 1 (1- (length token))))) (with-output-to-string (out) (with-input-from-string (in input) (loop while (peek-char nil in nil) do (let ((char (read-char in))) (if (eql char #\\ ) (let ((char (read-char in))) (if (eql char #\n) (terpri out) (princ char out))) (princ char out))))))) (error 'eof :context "string"))) (defun expand-quote (reader) (let ((quote-sym (make-mal-symbol (switch ((next reader) :test #'string=) ("'" "quote") ("`" "quasiquote") ("~" "unquote") ("~@" "splice-unquote") ("@" "deref"))))) (make-mal-list (list quote-sym (read-form reader))))) (defun read-mal-sequence (reader &optional (type 'list) &aux forms) (let ((context (string-downcase (symbol-name type))) (delimiter (if (equal type 'list) ")" "]"))) ;; Consume the opening brace (consume reader) (setf forms (loop until (string= (peek reader) delimiter) collect (read-form-or-eof reader context))) ;; Consume the closing brace (consume reader) (apply type forms))) (defun read-hash-map (reader) (let ((map (make-mal-value-hash-table)) (context "hash-map")) ;; Consume the open brace (consume reader) (loop until (string= (peek reader) "}") do (setf (hashref (read-form-or-eof reader context) map) (read-form-or-eof reader context))) ;; Consume the closing brace (consume reader) map)) (defun read-atom (reader) (let ((token (next reader))) (cond ((string= token "false") mal-false) ((string= token "true") mal-true) ((string= token "nil") mal-nil) ((char= (char token 0) #\") (make-mal-string (parse-string token))) ((char= (char token 0) #\:) (make-mal-keyword token)) ((scan *number-re* token) (make-mal-number (read-from-string token))) (t (make-mal-symbol token))))) (defun read-form-with-meta (reader) (consume reader) (let ((meta (read-form-or-eof reader "object meta")) (value (read-form-or-eof reader "object meta"))) (make-mal-list (list (make-mal-symbol "with-meta") value meta)))) (defun read-form (reader) (switch ((peek reader) :test #'equal) (nil nil) ("(" (make-mal-list (read-mal-sequence reader 'list))) ("[" (make-mal-vector (read-mal-sequence reader 'vector))) ("{" (make-mal-hash-map (read-hash-map reader))) ("^" (read-form-with-meta reader)) ("'" (expand-quote reader)) ("`" (expand-quote reader)) ("~" (expand-quote reader)) ("~@" (expand-quote reader)) ("@" (expand-quote reader)) (t (read-atom reader)))) (defun read-form-or-eof (reader context) (or (read-form reader) (error 'eof :context context))) (defun read-str (string) (read-form (make-token-reader :tokens (tokenize string)))) ================================================ FILE: impls/common-lisp/src/step0_repl.lisp ================================================ (defpackage :mal (:use :common-lisp) (:import-from :uiop :getenv) (:import-from :cl-readline :readline) (:export :main)) (in-package :mal) (defun mal-read (string) string) (defun mal-eval (ast) ast) (defun mal-print (expression) expression) (defun rep (string) (mal-print (mal-eval (mal-read string)))) (defvar *use-readline-p* nil) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (uiop:getenv "PERL_RL") "false") (string= (uiop:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step1_read_print.lisp ================================================ (defpackage :mal (:use :common-lisp :reader :printer) (:import-from :utils :getenv) (:import-from :cl-readline :readline) (:export :main)) (in-package :mal) (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (declare (ignorable env)) ast) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) (make-hash-table :test #'equal))) (reader:eof (condition) (format nil "~a" condition)))) (defvar *use-readline-p* nil) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step2_eval.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (make-hash-table :test 'equal)) (setf (gethash "+" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (+ (mal-data-value value1) (mal-data-value value2)))))) (setf (gethash "-" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (- (mal-data-value value1) (mal-data-value value2)))))) (setf (gethash "*" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (* (mal-data-value value1) (mal-data-value value2)))))) (setf (gethash "/" *repl-env*) (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (/ (mal-data-value value1) (mal-data-value value2)))))) (defun lookup-env (symbol env) (let ((key (mal-data-value symbol))) (multiple-value-bind (value present-p) (gethash key env) (if present-p value (error 'env:undefined-symbol :symbol (format nil "~a" key)))))) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (defun mal-eval (ast env) ;; (write-line (format nil "EVAL: ~a" (pr-str ast))) ;; (force-output *standard-output*) (switch-mal-type ast (types:symbol (lookup-env ast env)) (types:list (eval-list ast env)) (types:vector (make-mal-vector (eval-sequence 'vector ast env))) (types:hash-map (eval-hash-map ast env )) (types:any ast))) (defun mal-read (string) (reader:read-str string)) (defun eval-list (ast env) (if (null (mal-data-value ast)) ast (let ((evaluated-list (eval-sequence 'list ast env))) (apply (mal-data-value (car evaluated-list)) (cdr evaluated-list))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of *repl-env* when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step3_env.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :genhash) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (env:create-mal-env)) (env:set-env *repl-env* (make-mal-symbol "+") (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (+ (mal-data-value value1) (mal-data-value value2)))))) (env:set-env *repl-env* (make-mal-symbol "-") (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (- (mal-data-value value1) (mal-data-value value2)))))) (env:set-env *repl-env* (make-mal-symbol "*") (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (* (mal-data-value value1) (mal-data-value value2)))))) (env:set-env *repl-env* (make-mal-symbol "/") (make-mal-builtin-fn (lambda (value1 value2) (make-mal-number (/ (mal-data-value value1) (mal-data-value value2)))))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (defun mal-eval (ast env) (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) (switch-mal-type ast (types:symbol (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key))))) (types:list (eval-list ast env)) (types:vector (make-mal-vector (eval-sequence 'vector ast env))) (types:hash-map (eval-hash-map ast env )) (types:any ast))) (defun eval-let* (forms env) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (mal-eval (third forms) new-env))) (defun eval-list (ast env) (let ((forms (mal-data-value ast))) (cond ((zerop (length forms)) ast) ((mal-data-value= mal-def! (first forms)) (env:set-env env (second forms) (mal-eval (third forms) env))) ((mal-data-value= mal-let* (first forms)) (eval-let* forms env)) (t (let ((evaluated-list (eval-sequence 'list ast env))) (apply (mal-data-value (car evaluated-list)) (cdr evaluated-list))))))) (defun mal-read (string) (reader:read-str string)) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step4_if_fn_do.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (defun mal-eval (ast env) (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) (switch-mal-type ast (types:symbol (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key))))) (types:list (eval-list ast env)) (types:vector (make-mal-vector (eval-sequence 'vector ast env))) (types:hash-map (eval-hash-map ast env)) (types:any ast))) (defun eval-let* (forms env) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (mal-eval (third forms) new-env))) (defun eval-list (ast env) (let ((forms (mal-data-value ast))) (cond ((zerop (length forms)) ast) ((mal-data-value= mal-def! (first forms)) (env:set-env env (second forms) (mal-eval (third forms) env))) ((mal-data-value= mal-let* (first forms)) (eval-let* forms env)) ((mal-data-value= mal-do (first forms)) (car (last (mapcar (lambda (form) (mal-eval form env)) (cdr forms))))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (mal-eval (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms)) env))) ((mal-data-value= mal-fn* (first forms)) (make-mal-fn (let ((arglist (second forms)) (body (third forms))) (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args)))))) (t (let* ((evaluated-list (eval-sequence 'list ast env)) (function (car evaluated-list))) ;; If first element is a mal function unwrap it (apply (mal-data-value function) (cdr evaluated-list))))))) (defun mal-read (string) (reader:read-str string)) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (rep "(def! not (fn* (a) (if a false true)))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step5_tco.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env)))))) (t (let* ((evaluated-list (eval-sequence 'list ast env)) (function (car evaluated-list))) ;; If first element is a mal function unwrap it (if (not (mal-fn-p function)) (return (apply (mal-data-value function) (cdr evaluated-list))) (let* ((attrs (mal-data-attrs function))) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (cdr evaluated-list)))))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (rep "(def! not (fn* (a) (if a false true)))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun main (&optional (argv nil argv-provided-p)) (declare (ignorable argv argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step6_file.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env)))))) (t (let* ((evaluated-list (eval-sequence 'list ast env)) (function (car evaluated-list))) ;; If first element is a mal function unwrap it (if (not (mal-fn-p function)) (return (apply (mal-data-value function) (cdr evaluated-list))) (let* ((attrs (mal-data-attrs function))) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (cdr evaluated-list)))))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (env:set-env *repl-env* (make-mal-symbol "eval") (make-mal-builtin-fn (lambda (ast) (mal-eval ast *repl-env*)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun repl () (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) (defun run-file (file) (rep (format nil "(load-file \"~a\")" file))) (defun main (&optional (argv nil argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (let ((args (if argv-provided-p argv (cdr (utils:raw-command-line-arguments))))) (env:set-env *repl-env* (make-mal-symbol "*ARGV*") (make-mal-list (mapcar #'make-mal-string (cdr args)))) (if (null args) (repl) (run-file (car args))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step7_quote.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) (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")) (defun eval-sequence (type sequence env) (map type (lambda (ast) (mal-eval ast env)) (mal-data-value sequence))) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (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) (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 mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (eval-sequence 'vector ast env)))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-quote (first forms)) (return (second forms))) ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env)))))) (t (let* ((evaluated-list (eval-sequence 'list ast env)) (function (car evaluated-list))) ;; If first element is a mal function unwrap it (if (not (mal-fn-p function)) (return (apply (mal-data-value function) (cdr evaluated-list))) (let* ((attrs (mal-data-attrs function))) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (cdr evaluated-list)))))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (error (condition) (format nil "~a" condition)))) (env:set-env *repl-env* (make-mal-symbol "eval") (make-mal-builtin-fn (lambda (ast) (mal-eval ast *repl-env*)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun repl () (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) (defun run-file (file) (rep (format nil "(load-file \"~a\")" file))) (defun main (&optional (argv nil argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (let ((args (if argv-provided-p argv (cdr (utils:raw-command-line-arguments))))) (env:set-env *repl-env* (make-mal-symbol "*ARGV*") (make-mal-list (mapcar #'make-mal-string (cdr args)))) (if (null args) (repl) (run-file (car args))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step8_macros.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (define-condition invalid-function (mal-runtime-exception) ((form :initarg :form :reader form) (context :initarg :context :reader context)) (:report (lambda (condition stream) (format stream "Invalid function '~a' provided while ~a" (printer:pr-str (form condition)) (if (string= (context condition) "apply") "applying" "defining macro"))))) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) (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!")) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (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) (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 mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) (mal-data-value ast))))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-quote (first forms)) (return (second forms))) ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-defmacro! (first forms)) (let ((value (mal-eval (third forms) env))) (return (if (mal-fn-p value) (env:set-env env (second forms) (progn (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) value)) (error 'invalid-function :form value :context "macro"))))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env) (cons :is-macro nil)))))) (t (let ((function (mal-eval (car forms) env)) (args (cdr forms))) ;; If first element is a mal function unwrap it (cond ((mal-fn-p function) (let ((attrs (mal-data-attrs function))) (if (cdr (assoc :is-macro attrs)) (setf ast (apply (mal-data-value function) args)) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function :context "apply")))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (mal-error (condition) (format nil "~a" condition)) (error (condition) (format nil "Internal error: ~a" condition)))) (env:set-env *repl-env* (make-mal-symbol "eval") (make-mal-builtin-fn (lambda (ast) (mal-eval ast *repl-env*)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun repl () (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) (defun run-file (file) (rep (format nil "(load-file \"~a\")" file))) (defun main (&optional (argv nil argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (let ((args (if argv-provided-p argv (cdr (utils:raw-command-line-arguments))))) (env:set-env *repl-env* (make-mal-symbol "*ARGV*") (make-mal-list (mapcar #'make-mal-string (cdr args)))) (if (null args) (repl) (run-file (car args))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/step9_try.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (define-condition invalid-function (mal-runtime-exception) ((form :initarg :form :reader form) (context :initarg :context :reader context)) (:report (lambda (condition stream) (format stream "Invalid function '~a' provided while ~a" (printer:pr-str (form condition)) (if (string= (context condition) "apply") "applying" "defining macro"))))) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) (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!")) (defvar mal-try* (make-mal-symbol "try*")) (defvar mal-catch* (make-mal-symbol "catch*")) (defvar mal-throw (make-mal-symbol "throw")) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (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) (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 mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) (mal-data-value ast))))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-quote (first forms)) (return (second forms))) ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-defmacro! (first forms)) (let ((value (mal-eval (third forms) env))) (return (if (mal-fn-p value) (env:set-env env (second forms) (progn (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) value)) (error 'invalid-function :form value :context "macro"))))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env) (cons :is-macro nil)))))) ((mal-data-value= mal-try* (first forms)) (if (not (third forms)) (return (mal-eval (second forms) env)) (handler-case (return (mal-eval (second forms) env)) (error (condition) (let ((catch-forms (mal-data-value (third forms)))) (when (mal-data-value= mal-catch* (first catch-forms)) (return (mal-eval (third catch-forms) (env:create-mal-env :parent env :binds (list (second catch-forms)) :exprs (list (if (typep condition 'mal-user-exception) (mal-exception-data condition) (make-mal-string (format nil "~a" condition))))))))))))) (t (let ((function (mal-eval (car forms) env)) (args (cdr forms))) ;; If first element is a mal function unwrap it (cond ((mal-fn-p function) (let ((attrs (mal-data-attrs function))) (if (cdr (assoc :is-macro attrs)) (setf ast (apply (mal-data-value function) args)) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function :context "apply")))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (mal-error (condition) (format nil "Error: ~a" condition)) (mal-runtime-exception (condition) (format nil "Exception: ~a" condition)) (mal-user-exception (condition) (format nil "Exception: ~a" (pr-str (mal-exception-data condition)))) (error (condition) (format nil "Internal error: ~a" condition)))) (env:set-env *repl-env* (make-mal-symbol "eval") (make-mal-builtin-fn (lambda (ast) (mal-eval ast *repl-env*)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun repl () (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) (defun run-file (file) (rep (format nil "(load-file \"~a\")" file))) (defun main (&optional (argv nil argv-provided-p)) (setf *use-readline-p* (not (or (string= (uiop:getenv "PERL_RL") "false") (string= (uiop:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (let ((args (if argv-provided-p argv (cdr (utils:raw-command-line-arguments))))) (env:set-env *repl-env* (make-mal-symbol "*ARGV*") (make-mal-list (mapcar #'make-mal-string (cdr args)))) (if (null args) (repl) (run-file (car args))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail. #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/stepA_mal.lisp ================================================ (defpackage :mal (:use :common-lisp :types :env :reader :printer :core) (:import-from :cl-readline :readline :register-function) (:import-from :genhash :hashref :hashmap) (:import-from :utils :listify :getenv :common-prefix) (:export :main)) (in-package :mal) (define-condition invalid-function (mal-runtime-exception) ((form :initarg :form :reader form) (context :initarg :context :reader context)) (:report (lambda (condition stream) (format stream "Invalid function '~a' provided while ~a" (printer:pr-str (form condition)) (if (string= (context condition) "apply") "applying" "defining macro"))))) (defvar *repl-env* (env:create-mal-env)) (dolist (binding core:ns) (env:set-env *repl-env* (car binding) (cdr binding))) (defvar mal-def! (make-mal-symbol "def!")) (defvar mal-let* (make-mal-symbol "let*")) (defvar mal-do (make-mal-symbol "do")) (defvar mal-if (make-mal-symbol "if")) (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) (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!")) (defvar mal-try* (make-mal-symbol "try*")) (defvar mal-catch* (make-mal-symbol "catch*")) (defvar mal-throw (make-mal-symbol "throw")) (defun eval-hash-map (hash-map env) (let ((hash-map-value (mal-data-value hash-map)) (new-hash-table (make-mal-value-hash-table))) (genhash:hashmap (lambda (key value) (setf (genhash:hashref key new-hash-table) (mal-eval value env))) hash-map-value) (make-mal-hash-map new-hash-table))) (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) (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 mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop do (let ((debug-eval (env:get-env env "DEBUG-EVAL"))) (when (and debug-eval (not (mal-data-value= debug-eval mal-false)) (not (mal-data-value= debug-eval mal-false))) (write-line (format nil "EVAL: ~a" (pr-str ast))) (force-output *standard-output*))) do (switch-mal-type ast (types:symbol (return (let ((key (mal-data-value ast))) (or (env:get-env env key) (error 'undefined-symbol :symbol (format nil "~a" key)))))) (types:vector (return (make-mal-vector (map 'vector (lambda (x) (mal-eval x env)) (mal-data-value ast))))) (types:hash-map (return (eval-hash-map ast env))) (types:list (let ((forms (mal-data-value ast))) (cond ((null forms) (return ast)) ((mal-data-value= mal-quote (first forms)) (return (second forms))) ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) ((mal-data-value= mal-defmacro! (first forms)) (let ((value (mal-eval (third forms) env))) (return (if (mal-fn-p value) (env:set-env env (second forms) (progn (setf (cdr (assoc :is-macro (mal-data-attrs value))) t) value)) (error 'invalid-function :form value :context "macro"))))) ((mal-data-value= mal-let* (first forms)) (let ((new-env (env:create-mal-env :parent env)) (bindings (utils:listify (mal-data-value (second forms))))) (mapcar (lambda (binding) (env:set-env new-env (car binding) (mal-eval (or (cdr binding) mal-nil) new-env))) (loop for (symbol value) on bindings by #'cddr collect (cons symbol value))) (setf ast (third forms) env new-env))) ((mal-data-value= mal-do (first forms)) (mapc (lambda (form) (mal-eval form env)) (butlast (cdr forms))) (setf ast (car (last forms)))) ((mal-data-value= mal-if (first forms)) (let ((predicate (mal-eval (second forms) env))) (setf ast (if (or (mal-data-value= predicate mal-nil) (mal-data-value= predicate mal-false)) (or (fourth forms) mal-nil) (third forms))))) ((mal-data-value= mal-fn* (first forms)) (return (let ((arglist (second forms)) (body (third forms))) (make-mal-fn (lambda (&rest args) (mal-eval body (env:create-mal-env :parent env :binds (listify (mal-data-value arglist)) :exprs args))) :attrs (list (cons :params arglist) (cons :ast body) (cons :env env) (cons :is-macro nil)))))) ((mal-data-value= mal-try* (first forms)) (if (not (third forms)) (return (mal-eval (second forms) env)) (handler-case (return (mal-eval (second forms) env)) (error (condition) (let ((catch-forms (mal-data-value (third forms)))) (when (mal-data-value= mal-catch* (first catch-forms)) (return (mal-eval (third catch-forms) (env:create-mal-env :parent env :binds (list (second catch-forms)) :exprs (list (if (typep condition 'mal-user-exception) (mal-exception-data condition) (make-mal-string (format nil "~a" condition))))))))))))) (t (let ((function (mal-eval (car forms) env)) (args (cdr forms))) ;; If first element is a mal function unwrap it (cond ((mal-fn-p function) (let ((attrs (mal-data-attrs function))) (if (cdr (assoc :is-macro attrs)) (setf ast (apply (mal-data-value function) args)) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) :exprs (map 'list (lambda (x) (mal-eval x env)) args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) (map 'list (lambda (x) (mal-eval x env)) args)))) (t (error 'invalid-function :form function :context "apply")))))))) (types:any (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) (defun rep (string) (handler-case (mal-print (mal-eval (mal-read string) *repl-env*)) (mal-error (condition) (format nil "Error: ~a" condition)) (mal-runtime-exception (condition) (format nil "Exception: ~a" condition)) (mal-user-exception (condition) (format nil "Exception: ~a" (pr-str (mal-exception-data condition)))) (error (condition) (format nil "Internal error: ~a" condition)))) (env:set-env *repl-env* (make-mal-symbol "eval") (make-mal-builtin-fn (lambda (ast) (mal-eval ast *repl-env*)))) (env:set-env *repl-env* (make-mal-symbol "*cl-implementation*") (make-mal-string (lisp-implementation-type))) (env:set-env *repl-env* (make-mal-symbol "*cl-version*") (make-mal-string (lisp-implementation-version))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (rep "(def! *host-language* \"common-lisp\")") (defvar *use-readline-p* nil) (defun complete-toplevel-symbols (input &rest ignored) (declare (ignorable ignored)) (let (candidates) (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*) when (let ((pos (search input key))) (and pos (zerop pos))) do (push key candidates)) (if (= 1 (length candidates)) (cons (car candidates) candidates) (cons (apply #'utils:common-prefix candidates) candidates)))) (defun raw-input (prompt) (format *standard-output* prompt) (force-output *standard-output*) (read-line *standard-input* nil)) (defun mal-readline (prompt) (if *use-readline-p* (rl:readline :prompt prompt :add-history t :novelty-check #'string/=) (raw-input prompt))) (defun mal-writeline (string) (when string (write-line string) (force-output *standard-output*))) (defun repl () (rep "(println (str \"Mal [\" *host-language* \"]\"))") (loop do (let ((line (mal-readline "user> "))) (if line (mal-writeline (rep line)) (return))))) (defun run-file (file) (rep (format nil "(load-file \"~a\")" file))) (defun main (&optional (argv nil argv-provided-p)) (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false") (string= (utils:getenv "TERM") "dumb")))) ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment ;; variable which the test runner sets causing `read-line' on *standard-input* ;; to fail with an empty stream error. The following reinitializes the ;; standard streams ;; ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html #+clisp (setf *standard-input* (ext:make-stream :input) *standard-output* (ext:make-stream :output :buffered t) *error-output* (ext:make-stream :error :buffered t)) ;; CCL fails with a error while registering completion function ;; See also https://github.com/mrkkrp/cl-readline/issues/5 #-ccl (rl:register-function :complete #'complete-toplevel-symbols) (let ((args (if argv-provided-p argv (cdr (utils:raw-command-line-arguments))))) (env:set-env *repl-env* (make-mal-symbol "*ARGV*") (make-mal-list (mapcar #'make-mal-string (cdr args)))) (if (null args) (repl) (run-file (car args))))) ;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an ;;; image containing foreign libraries is restored. The extra messages cause the ;;; MAL testcases to fail #+cmucl (progn (defvar *old-standard-output* *standard-output* "Keep track of current value standard output, this is restored after image restore completes") (defun muffle-output () (setf *standard-output* (make-broadcast-stream))) (defun restore-output () (setf *standard-output* *old-standard-output*)) (pushnew #'muffle-output ext:*after-save-initializations*) (setf ext:*after-save-initializations* (append ext:*after-save-initializations* (list #'restore-output)))) ================================================ FILE: impls/common-lisp/src/types.lisp ================================================ (defpackage :types (:use :common-lisp :genhash) (:import-from :utils :listify) (:export :mal-data-value= ;; Accessors :mal-data-value :mal-data-type :mal-data-meta :mal-data-attrs ;; Mal values :number :make-mal-number :mal-number-p :boolean :mal-boolean-p :nil :mal-nil-p :string :make-mal-string :mal-string-p :symbol :make-mal-symbol :mal-symbol-p :keyword :make-mal-keyword :mal-keyword-p :list :make-mal-list :mal-list-p :vector :make-mal-vector :mal-vector-p :hash-map :make-mal-hash-map :mal-hash-map-p :atom :make-mal-atom :mal-atom-p :builtin-fn :make-mal-builtin-fn :mal-builtin-fn-p :fn :make-mal-fn :mal-fn-p :any :switch-mal-type ;; Singleton values :mal-nil :mal-true :mal-false ;; Hashing mal values :make-mal-value-hash-table ;; Error types :mal-exception :mal-exception-data ;; Exceptions raised by the runtime :mal-runtime-exception ;; Exception raised by user code :mal-user-exception ;; Error :mal-error)) (in-package :types) (define-condition mal-error (error) nil) (define-condition mal-exception (error) nil) (define-condition mal-runtime-exception (mal-exception) nil) (define-condition mal-user-exception (mal-exception) ((data :accessor mal-exception-data :initarg :data))) (defstruct mal-data (value nil) (type nil :read-only t) meta attrs) ;; Create a constructor and predicate for given type (defmacro define-mal-type (type) (let ((constructor (intern (format nil "MAKE-MAL-~a" (symbol-name type)))) (predicate (intern (format nil "MAL-~a-P" (symbol-name type))))) `(progn (defun ,constructor (value &key meta attrs) (make-mal-data :type ',type :value value :meta meta :attrs attrs)) (defun ,predicate (value) (when (typep value 'mal-data) (eq (mal-data-type value) ',type)))))) (define-mal-type number) (define-mal-type symbol) (define-mal-type keyword) (define-mal-type string) (define-mal-type boolean) (define-mal-type nil) (define-mal-type list) (define-mal-type vector) (define-mal-type hash-map) (define-mal-type atom) (define-mal-type fn) (define-mal-type builtin-fn) (defvar mal-nil (make-mal-nil nil)) (defvar mal-true (make-mal-boolean t)) (defvar mal-false (make-mal-boolean nil)) ;; Generic type (defvar any) (defmacro switch-mal-type (ast &body forms) `(let ((type (mal-data-type ,ast))) (cond ,@(mapcar (lambda (form) (list (or (equal (car form) t) (equal (car form) 'any) (list 'equal (list 'quote (car form)) 'type)) (cadr form))) forms)))) (defun mal-sequence= (value1 value2) (let ((sequence1 (listify (mal-data-value value1))) (sequence2 (listify (mal-data-value value2)))) (when (= (length sequence1) (length sequence2)) (every #'identity (loop for x in sequence1 for y in sequence2 collect (mal-data-value= x y)))))) (defun mal-hash-map= (value1 value2) (let ((map1 (mal-data-value value1)) (map2 (mal-data-value value2)) (identical t)) (when (= (generic-hash-table-count map1) (generic-hash-table-count map2)) (hashmap (lambda (key value) (declare (ignorable value)) (setf identical (and identical (mal-data-value= (hashref key map1) (hashref key map2))))) map1) identical))) (defun mal-data-value= (value1 value2) (when (and (typep value1 'mal-data) (typep value2 'mal-data)) (if (equal (mal-data-type value1) (mal-data-type value2)) (switch-mal-type value1 (list (mal-sequence= value1 value2)) (vector (mal-sequence= value1 value2)) (hash-map (mal-hash-map= value1 value2)) (any (equal (mal-data-value value1) (mal-data-value value2)))) (when (or (and (mal-list-p value1) (mal-vector-p value2)) (and (mal-list-p value2) (mal-vector-p value1))) (mal-sequence= value1 value2))))) (defun mal-sxhash (value) (sxhash (mal-data-value value))) (defun make-mal-value-hash-table () (unless (gethash 'mal-data-value-hash genhash::*hash-test-designator-map*) ;; sxhash does not work well with compound types, use a custom ;; hash function which hashes the underlying value instead (let ((hash-function #'mal-sxhash)) (register-test-designator 'mal-data-value-hash hash-function #'mal-data-value=))) (make-generic-hash-table :test 'mal-data-value-hash)) ================================================ FILE: impls/common-lisp/src/utils.lisp ================================================ (defpackage :utils (:use :common-lisp :uiop) (:export :replace-all :getenv :read-file-string :raw-command-line-arguments :listify :common-prefix)) (in-package :utils) (defun replace-all (string part replacement &key (test #'char=)) "Returns a new string in which all the occurences of the part is replaced with replacement." (with-output-to-string (out) (loop with part-length = (length part) for old-pos = 0 then (+ pos part-length) for pos = (search part string :start2 old-pos :test test) do (write-string string out :start old-pos :end (or pos (length string))) when pos do (write-string replacement out) while pos))) (defun listify (sequence) "Convert a sequence to a list" (map 'list #'identity sequence)) (defun common-prefix (&rest strings) (if (not strings) "" (let* ((char-lists (mapcar (lambda (string) (coerce string 'list)) strings)) (char-tuples (apply #'mapcar #'list char-lists)) (count 0)) (loop for char-tuple in char-tuples while (every (lambda (char) (equal char (car char-tuple))) char-tuple) do (incf count)) (subseq (car strings) 0 count)))) ================================================ FILE: impls/common-lisp/step0_repl.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step0_repl" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 0 of MAL in Common Lisp" :serial t :components ((:file "step0_repl")) :depends-on (:uiop :cl-readline) :pathname "src/") ================================================ FILE: impls/common-lisp/step1_read_print.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step1_read_print" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 1 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "reader") (:file "printer") (:file "step1_read_print")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step2_eval.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step2_eval" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 2 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "step2_eval")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step3_env.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step3_env" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 3 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "step3_env")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step4_if_fn_do.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step4_if_fn_do" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 4 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step4_if_fn_do")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step5_tco.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step5_tco" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 5 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step5_tco")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step6_file.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step6_file" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 6 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step6_file")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step7_quote.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step7_quote" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 7 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step7_quote")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step8_macros.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step8_macros" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 8 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step8_macros")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/step9_try.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "step9_try" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of step 9 of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "step9_try")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/stepA_mal.asd ================================================ #-quicklisp (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) (ql:quickload :uiop :silent t :verbose nil) (ql:quickload :cl-ppcre :silent t) (ql:quickload :genhash :silent t) (ql:quickload :alexandria :silent t) #-mkcl (ql:quickload :cl-readline :silent t) #+mkcl (load "fake-readline.lisp") (defpackage #:mal-asd (:use :cl :asdf)) (in-package :mal-asd) (defsystem "stepA_mal" :name "MAL" :version "1.0" :author "Iqbal Ansari" :description "Implementation of MAL in Common Lisp" :serial t :components ((:file "utils") (:file "types") (:file "env") (:file "reader") (:file "printer") (:file "core") (:file "stepA_mal")) :depends-on (:uiop :cl-readline :cl-ppcre :genhash) :pathname "src/") ================================================ FILE: impls/common-lisp/tests/stepA_mal.mal ================================================ ;; Testing clisp interop (cl-eval "42") ;=>42 (cl-eval "(+ 1 1)") ;=>2 (cl-eval "(setq foo 1 bar 2 baz 3)") (cl-eval "(list foo bar baz)") ;=>(1 2 3) (cl-eval "7") ;=>7 ;; ;; Testing boolean flag (cl-eval "(= 123 123)" true) ;=>true (cl-eval "(= 123 456)") ;=>nil (cl-eval "(= 123 456)" true) ;=>false ;; ;; Testing list flag (cl-eval "(last nil)" false true) ;=>() (cl-eval "nil" false true) ;=>() (cl-eval "nil") ;=>nil ;; ;; Testing creation of Common Lisp Objects (cl-eval "#(1 2)") ;=>[1 2] ;;; Not testing with elements since order in hashtable cannot be guaranteed (cl-eval "(make-hash-table)") ;=>{} (cl-eval "(defun redundant-identity (x) x)")) ;=>REDUNDANT-IDENTITY (cl-eval "(redundant-identity 2)")) ;=>2 (cl-eval "(defun range (max &key (min 0) (step 1)) (loop for n from min below max by step collect n))") ;=>RANGE (cl-eval "(range 10 :min 0 :step 1)") ;=>(0 1 2 3 4 5 6 7 8 9) (cl-eval "(mapcar #'1+ (range 10 :min 0 :step 1))") ;=>(1 2 3 4 5 6 7 8 9 10) ================================================ FILE: impls/cpp/.gitignore ================================================ .deps *.o *.a step0_repl step1_read_print ================================================ FILE: impls/cpp/Core.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "StaticList.h" #include "Types.h" #include #include #include #define CHECK_ARGS_IS(expected) \ checkArgsIs(name.c_str(), expected, \ std::distance(argsBegin, argsEnd)) #define CHECK_ARGS_BETWEEN(min, max) \ checkArgsBetween(name.c_str(), min, max, \ std::distance(argsBegin, argsEnd)) #define CHECK_ARGS_AT_LEAST(expected) \ checkArgsAtLeast(name.c_str(), expected, \ std::distance(argsBegin, argsEnd)) static String printValues(malValueIter begin, malValueIter end, const String& sep, bool readably); static StaticList handlers; #define ARG(type, name) type* name = VALUE_CAST(type, *argsBegin++) #define FUNCNAME(uniq) builtIn ## uniq #define HRECNAME(uniq) handler ## uniq #define BUILTIN_DEF(uniq, symbol) \ static malBuiltIn::ApplyFunc FUNCNAME(uniq); \ static StaticList::Node HRECNAME(uniq) \ (handlers, new malBuiltIn(symbol, FUNCNAME(uniq))); \ malValuePtr FUNCNAME(uniq)(const String& name, \ malValueIter argsBegin, malValueIter argsEnd) #define BUILTIN(symbol) BUILTIN_DEF(__LINE__, symbol) #define BUILTIN_ISA(symbol, type) \ BUILTIN(symbol) { \ CHECK_ARGS_IS(1); \ return mal::boolean(DYNAMIC_CAST(type, *argsBegin)); \ } #define BUILTIN_IS(op, constant) \ BUILTIN(op) { \ CHECK_ARGS_IS(1); \ return mal::boolean(*argsBegin == mal::constant()); \ } #define BUILTIN_INTOP(op, checkDivByZero) \ BUILTIN(#op) { \ CHECK_ARGS_IS(2); \ ARG(malInteger, lhs); \ ARG(malInteger, rhs); \ if (checkDivByZero) { \ MAL_CHECK(rhs->value() != 0, "Division by zero"); \ } \ return mal::integer(lhs->value() op rhs->value()); \ } BUILTIN_ISA("atom?", malAtom); BUILTIN_ISA("keyword?", malKeyword); BUILTIN_ISA("list?", malList); BUILTIN_ISA("map?", malHash); BUILTIN_ISA("number?", malInteger); BUILTIN_ISA("sequential?", malSequence); BUILTIN_ISA("string?", malString); BUILTIN_ISA("symbol?", malSymbol); BUILTIN_ISA("vector?", malVector); BUILTIN_INTOP(+, false); BUILTIN_INTOP(/, true); BUILTIN_INTOP(*, false); BUILTIN_INTOP(%, true); BUILTIN_IS("true?", trueValue); BUILTIN_IS("false?", falseValue); BUILTIN_IS("nil?", nilValue); BUILTIN("-") { int argCount = CHECK_ARGS_BETWEEN(1, 2); ARG(malInteger, lhs); if (argCount == 1) { return mal::integer(- lhs->value()); } ARG(malInteger, rhs); return mal::integer(lhs->value() - rhs->value()); } BUILTIN("<=") { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::boolean(lhs->value() <= rhs->value()); } BUILTIN(">=") { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::boolean(lhs->value() >= rhs->value()); } BUILTIN("<") { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::boolean(lhs->value() < rhs->value()); } BUILTIN(">") { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::boolean(lhs->value() > rhs->value()); } BUILTIN("=") { CHECK_ARGS_IS(2); const malValue* lhs = (*argsBegin++).ptr(); const malValue* rhs = (*argsBegin++).ptr(); return mal::boolean(lhs->isEqualTo(rhs)); } BUILTIN("apply") { CHECK_ARGS_AT_LEAST(2); malValuePtr op = *argsBegin++; // this gets checked in APPLY // Copy the first N-1 arguments in. malValueVec args(argsBegin, argsEnd-1); // Then append the argument as a list. const malSequence* lastArg = VALUE_CAST(malSequence, *(argsEnd-1)); for (int i = 0; i < lastArg->count(); i++) { args.push_back(lastArg->item(i)); } return APPLY(op, args.begin(), args.end()); } BUILTIN("assoc") { CHECK_ARGS_AT_LEAST(1); ARG(malHash, hash); return hash->assoc(argsBegin, argsEnd); } BUILTIN("atom") { CHECK_ARGS_IS(1); return mal::atom(*argsBegin); } BUILTIN("concat") { int count = 0; for (auto it = argsBegin; it != argsEnd; ++it) { const malSequence* seq = VALUE_CAST(malSequence, *it); count += seq->count(); } malValueVec* items = new malValueVec(count); int offset = 0; for (auto it = argsBegin; it != argsEnd; ++it) { const malSequence* seq = STATIC_CAST(malSequence, *it); std::copy(seq->begin(), seq->end(), items->begin() + offset); offset += seq->count(); } return mal::list(items); } BUILTIN("conj") { CHECK_ARGS_AT_LEAST(1); ARG(malSequence, seq); return seq->conj(argsBegin, argsEnd); } BUILTIN("cons") { CHECK_ARGS_IS(2); malValuePtr first = *argsBegin++; ARG(malSequence, rest); malValueVec* items = new malValueVec(1 + rest->count()); items->at(0) = first; std::copy(rest->begin(), rest->end(), items->begin() + 1); return mal::list(items); } BUILTIN("contains?") { CHECK_ARGS_IS(2); if (*argsBegin == mal::nilValue()) { return *argsBegin; } ARG(malHash, hash); return mal::boolean(hash->contains(*argsBegin)); } BUILTIN("count") { CHECK_ARGS_IS(1); if (*argsBegin == mal::nilValue()) { return mal::integer(0); } ARG(malSequence, seq); return mal::integer(seq->count()); } BUILTIN("deref") { CHECK_ARGS_IS(1); ARG(malAtom, atom); return atom->deref(); } BUILTIN("dissoc") { CHECK_ARGS_AT_LEAST(1); ARG(malHash, hash); return hash->dissoc(argsBegin, argsEnd); } BUILTIN("empty?") { CHECK_ARGS_IS(1); ARG(malSequence, seq); return mal::boolean(seq->isEmpty()); } BUILTIN("eval") { CHECK_ARGS_IS(1); return EVAL(*argsBegin, NULL); } BUILTIN("first") { CHECK_ARGS_IS(1); if (*argsBegin == mal::nilValue()) { return mal::nilValue(); } ARG(malSequence, seq); return seq->first(); } BUILTIN("fn?") { CHECK_ARGS_IS(1); malValuePtr arg = *argsBegin++; // Lambdas are functions, unless they're macros. if (const malLambda* lambda = DYNAMIC_CAST(malLambda, arg)) { return mal::boolean(!lambda->isMacro()); } // Builtins are functions. return mal::boolean(DYNAMIC_CAST(malBuiltIn, arg)); } BUILTIN("get") { CHECK_ARGS_IS(2); if (*argsBegin == mal::nilValue()) { return *argsBegin; } ARG(malHash, hash); return hash->get(*argsBegin); } BUILTIN("hash-map") { return mal::hash(argsBegin, argsEnd, true); } BUILTIN("keys") { CHECK_ARGS_IS(1); ARG(malHash, hash); return hash->keys(); } BUILTIN("keyword") { CHECK_ARGS_IS(1); const malValuePtr arg = *argsBegin++; if (malKeyword* s = DYNAMIC_CAST(malKeyword, arg)) return s; if (const malString* s = DYNAMIC_CAST(malString, arg)) return mal::keyword(":" + s->value()); MAL_FAIL("keyword expects a keyword or string"); } BUILTIN("list") { return mal::list(argsBegin, argsEnd); } BUILTIN("macro?") { CHECK_ARGS_IS(1); // Macros are implemented as lambdas, with a special flag. const malLambda* lambda = DYNAMIC_CAST(malLambda, *argsBegin); return mal::boolean((lambda != NULL) && lambda->isMacro()); } BUILTIN("map") { CHECK_ARGS_IS(2); malValuePtr op = *argsBegin++; // this gets checked in APPLY ARG(malSequence, source); const int length = source->count(); malValueVec* items = new malValueVec(length); auto it = source->begin(); for (int i = 0; i < length; i++) { items->at(i) = APPLY(op, it+i, it+i+1); } return mal::list(items); } BUILTIN("meta") { CHECK_ARGS_IS(1); malValuePtr obj = *argsBegin++; return obj->meta(); } BUILTIN("nth") { CHECK_ARGS_IS(2); ARG(malSequence, seq); ARG(malInteger, index); int i = index->value(); MAL_CHECK(i >= 0 && i < seq->count(), "Index out of range"); return seq->item(i); } BUILTIN("pr-str") { return mal::string(printValues(argsBegin, argsEnd, " ", true)); } BUILTIN("println") { std::cout << printValues(argsBegin, argsEnd, " ", false) << "\n"; return mal::nilValue(); } BUILTIN("prn") { std::cout << printValues(argsBegin, argsEnd, " ", true) << "\n"; return mal::nilValue(); } BUILTIN("read-string") { CHECK_ARGS_IS(1); ARG(malString, str); return readStr(str->value()); } BUILTIN("readline") { CHECK_ARGS_IS(1); ARG(malString, str); return readline(str->value()); } BUILTIN("reset!") { CHECK_ARGS_IS(2); ARG(malAtom, atom); return atom->reset(*argsBegin); } BUILTIN("rest") { CHECK_ARGS_IS(1); if (*argsBegin == mal::nilValue()) { return mal::list(new malValueVec(0)); } ARG(malSequence, seq); return seq->rest(); } BUILTIN("seq") { CHECK_ARGS_IS(1); malValuePtr arg = *argsBegin++; if (arg == mal::nilValue()) { return mal::nilValue(); } if (const malSequence* seq = DYNAMIC_CAST(malSequence, arg)) { return seq->isEmpty() ? mal::nilValue() : mal::list(seq->begin(), seq->end()); } if (const malString* strVal = DYNAMIC_CAST(malString, arg)) { const String str = strVal->value(); int length = str.length(); if (length == 0) return mal::nilValue(); malValueVec* items = new malValueVec(length); for (int i = 0; i < length; i++) { (*items)[i] = mal::string(str.substr(i, 1)); } return mal::list(items); } MAL_FAIL("%s is not a string or sequence", arg->print(true).c_str()); } BUILTIN("slurp") { CHECK_ARGS_IS(1); ARG(malString, filename); std::ios_base::openmode openmode = std::ios::ate | std::ios::in | std::ios::binary; std::ifstream file(filename->value().c_str(), openmode); MAL_CHECK(!file.fail(), "Cannot open %s", filename->value().c_str()); String data; data.reserve(file.tellg()); file.seekg(0, std::ios::beg); data.append(std::istreambuf_iterator(file.rdbuf()), std::istreambuf_iterator()); return mal::string(data); } BUILTIN("str") { return mal::string(printValues(argsBegin, argsEnd, "", false)); } BUILTIN("swap!") { CHECK_ARGS_AT_LEAST(2); ARG(malAtom, atom); malValuePtr op = *argsBegin++; // this gets checked in APPLY malValueVec args(1 + argsEnd - argsBegin); args[0] = atom->deref(); std::copy(argsBegin, argsEnd, args.begin() + 1); malValuePtr value = APPLY(op, args.begin(), args.end()); return atom->reset(value); } BUILTIN("symbol") { CHECK_ARGS_IS(1); ARG(malString, token); return mal::symbol(token->value()); } BUILTIN("throw") { CHECK_ARGS_IS(1); throw *argsBegin; } BUILTIN("time-ms") { CHECK_ARGS_IS(0); using namespace std::chrono; milliseconds ms = duration_cast( high_resolution_clock::now().time_since_epoch() ); return mal::integer(ms.count()); } BUILTIN("vals") { CHECK_ARGS_IS(1); ARG(malHash, hash); 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); } BUILTIN("with-meta") { CHECK_ARGS_IS(2); malValuePtr obj = *argsBegin++; malValuePtr meta = *argsBegin++; return obj->withMeta(meta); } void installCore(malEnvPtr env) { for (auto it = handlers.begin(), end = handlers.end(); it != end; ++it) { malBuiltIn* handler = *it; env->set(handler->name(), handler); } } static String printValues(malValueIter begin, malValueIter end, const String& sep, bool readably) { String out; if (begin != end) { out += (*begin)->print(readably); ++begin; } for ( ; begin != end; ++begin) { out += sep; out += (*begin)->print(readably); } return out; } ================================================ FILE: impls/cpp/Debug.h ================================================ #ifndef INCLUDE_DEBUG_H #define INCLUDE_DEBUG_H #include #include #define DEBUG_TRACE 1 //#define DEBUG_OBJECT_LIFETIMES 1 //#define DEBUG_ENV_LIFETIMES 1 #define DEBUG_TRACE_FILE stderr #define NOOP do { } while (false) #define NOTRACE(...) NOOP #if DEBUG_TRACE #define TRACE(...) fprintf(DEBUG_TRACE_FILE, __VA_ARGS__) #else #define TRACE NOTRACE #endif #if DEBUG_OBJECT_LIFETIMES #define TRACE_OBJECT TRACE #else #define TRACE_OBJECT NOTRACE #endif #if DEBUG_ENV_LIFETIMES #define TRACE_ENV TRACE #else #define TRACE_ENV NOTRACE #endif #define _ASSERT(file, line, condition, ...) \ if (!(condition)) { \ printf("Assertion failed at %s(%d): ", file, line); \ printf(__VA_ARGS__); \ exit(1); \ } else { } #define ASSERT(condition, ...) \ _ASSERT(__FILE__, __LINE__, condition, __VA_ARGS__) #endif // INCLUDE_DEBUG_H ================================================ FILE: impls/cpp/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Install g++ for any C/C++ based implementations RUN apt-get -y install g++ libreadline-dev ================================================ FILE: impls/cpp/Environment.cpp ================================================ #include "Environment.h" #include "Types.h" #include malEnv::malEnv(malEnvPtr outer) : m_outer(outer) { TRACE_ENV("Creating malEnv %p, outer=%p\n", this, m_outer.ptr()); } malEnv::malEnv(malEnvPtr outer, const StringVec& bindings, malValueIter argsBegin, malValueIter argsEnd) : m_outer(outer) { TRACE_ENV("Creating malEnv %p, outer=%p\n", this, m_outer.ptr()); int n = bindings.size(); auto it = argsBegin; for (int i = 0; i < n; i++) { if (bindings[i] == "&") { MAL_CHECK(i == n - 2, "There must be one parameter after the &"); set(bindings[n-1], mal::list(it, argsEnd)); return; } MAL_CHECK(it != argsEnd, "Not enough parameters"); set(bindings[i], *it); ++it; } MAL_CHECK(it == argsEnd, "Too many parameters"); } malEnv::~malEnv() { TRACE_ENV("Destroying malEnv %p, outer=%p\n", this, m_outer.ptr()); } malEnvPtr malEnv::find(const String& symbol) { for (malEnvPtr env = this; env; env = env->m_outer) { if (env->m_map.find(symbol) != env->m_map.end()) { return env; } } return NULL; } malValuePtr malEnv::get(const String& symbol) { for (malEnvPtr env = this; env; env = env->m_outer) { auto it = env->m_map.find(symbol); if (it != env->m_map.end()) { return it->second; } } MAL_FAIL("'%s' not found", symbol.c_str()); } malValuePtr malEnv::set(const String& symbol, malValuePtr value) { m_map[symbol] = value; return value; } malEnvPtr malEnv::getRoot() { // Work our way down the the global environment. for (malEnvPtr env = this; ; env = env->m_outer) { if (!env->m_outer) { return env; } } } ================================================ FILE: impls/cpp/Environment.h ================================================ #ifndef INCLUDE_ENVIRONMENT_H #define INCLUDE_ENVIRONMENT_H #include "MAL.h" #include class malEnv : public RefCounted { public: malEnv(malEnvPtr outer = NULL); malEnv(malEnvPtr outer, const StringVec& bindings, malValueIter argsBegin, malValueIter argsEnd); ~malEnv(); malValuePtr get(const String& symbol); malEnvPtr find(const String& symbol); malValuePtr set(const String& symbol, malValuePtr value); malEnvPtr getRoot(); private: typedef std::map Map; Map m_map; malEnvPtr m_outer; }; #endif // INCLUDE_ENVIRONMENT_H ================================================ FILE: impls/cpp/MAL.h ================================================ #ifndef INCLUDE_MAL_H #define INCLUDE_MAL_H #include "Debug.h" #include "RefCountedPtr.h" #include "String.h" #include "Validation.h" #include class malValue; typedef RefCountedPtr malValuePtr; typedef std::vector malValueVec; typedef malValueVec::iterator malValueIter; class malEnv; typedef RefCountedPtr malEnvPtr; // step*.cpp extern malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd); extern malValuePtr EVAL(malValuePtr ast, malEnvPtr env); extern malValuePtr readline(const String& prompt); extern String rep(const String& input, malEnvPtr env); // Core.cpp extern void installCore(malEnvPtr env); // Reader.cpp extern malValuePtr readStr(const String& input); #endif // INCLUDE_MAL_H ================================================ FILE: impls/cpp/Makefile ================================================ uname_S := $(shell sh -c 'uname -s 2>/dev/null || echo not') CXX=g++ ifeq ($(uname_S),Darwin) # Native build on yosemite. Requires: brew install readline READLINE=/usr/local/opt/readline INCPATHS=-I$(READLINE)/include LIBPATHS=-L$(READLINE)/lib endif LD=$(CXX) AR=ar DEBUG=-ggdb CXXFLAGS=-O3 -Wall $(DEBUG) $(INCPATHS) -std=c++11 LDFLAGS=-O3 $(DEBUG) $(LIBPATHS) -L. -lreadline -lhistory LIBSOURCES=Core.cpp Environment.cpp Reader.cpp ReadLine.cpp String.cpp \ Types.cpp Validation.cpp LIBOBJS=$(LIBSOURCES:%.cpp=%.o) MAINS=$(wildcard step*.cpp) TARGETS=$(MAINS:%.cpp=%) .PHONY: all clean .SUFFIXES: .cpp .o all: $(TARGETS) dist: mal mal: stepA_mal cp $< $@ .deps: *.cpp *.h $(CXX) $(CXXFLAGS) -MM *.cpp > .deps $(TARGETS): %: %.o libmal.a $(LD) $^ -o $@ $(LDFLAGS) libmal.a: $(LIBOBJS) $(AR) rcs $@ $^ .cpp.o: $(CXX) $(CXXFLAGS) -c $< -o $@ clean: rm -rf *.o $(TARGETS) libmal.a .deps mal -include .deps ================================================ FILE: impls/cpp/README.md ================================================ # Compilation notes ## Mac OSX This C++ implementation was developed on Mac OS X Yosemite, and uses the stock g++ compiler. The only other requirement is GNU Readline, which I got from homebrew. brew install readline You may need to edit the READLINE path in the Makefile. ## Ubuntu 14.10/15.04 This should compile on Ubuntu 14.10 and 15.04 with the following packages apt-get install clang-3.5 libreadline-dev make ## Docker For everyone else, there is a Dockerfile and associated docker.sh script which can be used to make and run this implementation. * build the docker image ./docker build * make the MAL binaries: ./docker make * run one of the implementations: ./docker run ./stepA_mal * open a shell inside the docker container: ./docker run ================================================ FILE: impls/cpp/ReadLine.cpp ================================================ #include "ReadLine.h" #include "String.h" #include #include #include #include #include #include ReadLine::ReadLine(const String& historyFile) : m_historyPath(copyAndFree(tilde_expand(historyFile.c_str()))) { read_history(m_historyPath.c_str()); } ReadLine::~ReadLine() { } bool ReadLine::get(const String& prompt, String& out) { char *line = readline(prompt.c_str()); if (line == NULL) { return false; } add_history(line); // Add input to in-memory history append_history(1, m_historyPath.c_str()); out = line; free(line); return true; } ================================================ FILE: impls/cpp/ReadLine.h ================================================ #ifndef INCLUDE_READLINE_H #define INCLUDE_READLINE_H #include "String.h" class ReadLine { public: ReadLine(const String& historyFile); ~ReadLine(); bool get(const String& prompt, String& line); private: String m_historyPath; }; #endif // INCLUDE_READLINE_H ================================================ FILE: impls/cpp/Reader.cpp ================================================ #include "MAL.h" #include "Types.h" #include typedef std::regex Regex; static const Regex intRegex("^[-+]?\\d+$"); static const Regex closeRegex("[\\)\\]}]"); static const Regex whitespaceRegex("[\\s,]+|;.*"); static const Regex tokenRegexes[] = { Regex("~@"), Regex("[\\[\\]{}()'`~^@]"), Regex("\"(?:\\\\.|[^\\\\\"])*\""), Regex("[^\\s\\[\\]{}('\"`,;)]+"), }; class Tokeniser { public: Tokeniser(const String& input); String peek() const { ASSERT(!eof(), "Tokeniser reading past EOF in peek\n"); return m_token; } String next() { ASSERT(!eof(), "Tokeniser reading past EOF in next\n"); String ret = peek(); nextToken(); return ret; } bool eof() const { return m_iter == m_end; } private: void skipWhitespace(); void nextToken(); bool matchRegex(const Regex& regex); typedef String::const_iterator StringIter; String m_token; StringIter m_iter; StringIter m_end; }; Tokeniser::Tokeniser(const String& input) : m_iter(input.begin()) , m_end(input.end()) { nextToken(); } bool Tokeniser::matchRegex(const Regex& regex) { if (eof()) { return false; } std::smatch match; auto flags = std::regex_constants::match_continuous; if (!std::regex_search(m_iter, m_end, match, regex, flags)) { return false; } ASSERT(match.size() == 1, "Should only have one submatch, not %lu\n", match.size()); ASSERT(match.position(0) == 0, "Need to match first character\n"); ASSERT(match.length(0) > 0, "Need to match a non-empty string\n"); // Don't advance m_iter now, do it after we've consumed the token in // next(). If we do it now, we hit eof() when there's still one token left. m_token = match.str(0); return true; } void Tokeniser::nextToken() { m_iter += m_token.size(); skipWhitespace(); if (eof()) { return; } for (auto &it : tokenRegexes) { if (matchRegex(it)) { return; } } String mismatch(m_iter, m_end); if (mismatch[0] == '"') { MAL_CHECK(false, "expected '\"', got EOF"); } else { MAL_CHECK(false, "unexpected '%s'", mismatch.c_str()); } } void Tokeniser::skipWhitespace() { while (matchRegex(whitespaceRegex)) { m_iter += m_token.size(); } } static malValuePtr readAtom(Tokeniser& tokeniser); static malValuePtr readForm(Tokeniser& tokeniser); static void readList(Tokeniser& tokeniser, malValueVec* items, const String& end); static malValuePtr processMacro(Tokeniser& tokeniser, const String& symbol); malValuePtr readStr(const String& input) { Tokeniser tokeniser(input); if (tokeniser.eof()) { throw malEmptyInputException(); } return readForm(tokeniser); } static malValuePtr readForm(Tokeniser& tokeniser) { MAL_CHECK(!tokeniser.eof(), "expected form, got EOF"); String token = tokeniser.peek(); MAL_CHECK(!std::regex_match(token, closeRegex), "unexpected '%s'", token.c_str()); if (token == "(") { tokeniser.next(); std::unique_ptr items(new malValueVec); readList(tokeniser, items.get(), ")"); return mal::list(items.release()); } if (token == "[") { tokeniser.next(); std::unique_ptr items(new malValueVec); readList(tokeniser, items.get(), "]"); return mal::vector(items.release()); } if (token == "{") { tokeniser.next(); malValueVec items; readList(tokeniser, &items, "}"); return mal::hash(items.begin(), items.end(), false); } return readAtom(tokeniser); } static malValuePtr readAtom(Tokeniser& tokeniser) { struct ReaderMacro { const char* token; const char* symbol; }; ReaderMacro macroTable[] = { { "@", "deref" }, { "`", "quasiquote" }, { "'", "quote" }, { "~@", "splice-unquote" }, { "~", "unquote" }, }; struct Constant { const char* token; malValuePtr value; }; Constant constantTable[] = { { "false", mal::falseValue() }, { "nil", mal::nilValue() }, { "true", mal::trueValue() }, }; String token = tokeniser.next(); if (token[0] == '"') { return mal::string(unescape(token)); } if (token[0] == ':') { return mal::keyword(token); } if (token == "^") { malValuePtr meta = readForm(tokeniser); malValuePtr value = readForm(tokeniser); // Note that meta and value switch places return mal::list(mal::symbol("with-meta"), value, meta); } for (auto &constant : constantTable) { if (token == constant.token) { return constant.value; } } for (auto ¯o : macroTable) { if (token == macro.token) { return processMacro(tokeniser, macro.symbol); } } if (std::regex_match(token, intRegex)) { return mal::integer(token); } return mal::symbol(token); } static void readList(Tokeniser& tokeniser, malValueVec* items, const String& end) { while (1) { MAL_CHECK(!tokeniser.eof(), "expected '%s', got EOF", end.c_str()); if (tokeniser.peek() == end) { tokeniser.next(); return; } items->push_back(readForm(tokeniser)); } } static malValuePtr processMacro(Tokeniser& tokeniser, const String& symbol) { return mal::list(mal::symbol(symbol), readForm(tokeniser)); } ================================================ FILE: impls/cpp/RefCountedPtr.h ================================================ #ifndef INCLUDE_REFCOUNTEDPTR_H #define INCLUDE_REFCOUNTEDPTR_H #include "Debug.h" #include class RefCounted { public: RefCounted() : m_refCount(0) { } virtual ~RefCounted() { } const RefCounted* acquire() const { m_refCount++; return this; } int release() const { return --m_refCount; } int refCount() const { return m_refCount; } private: RefCounted(const RefCounted&); // no copy ctor RefCounted& operator = (const RefCounted&); // no assignments mutable int m_refCount; }; template class RefCountedPtr { public: RefCountedPtr() : m_object(0) { } RefCountedPtr(T* object) : m_object(0) { acquire(object); } RefCountedPtr(const RefCountedPtr& rhs) : m_object(0) { acquire(rhs.m_object); } const RefCountedPtr& operator = (const RefCountedPtr& rhs) { acquire(rhs.m_object); return *this; } bool operator == (const RefCountedPtr& rhs) const { return m_object == rhs.m_object; } bool operator != (const RefCountedPtr& rhs) const { return m_object != rhs.m_object; } operator bool () const { return m_object != NULL; } ~RefCountedPtr() { release(); } T* operator -> () const { return m_object; } T* ptr() const { return m_object; } private: void acquire(T* object) { if (object != NULL) { object->acquire(); } release(); m_object = object; } void release() { if ((m_object != NULL) && (m_object->release() == 0)) { delete m_object; } } T* m_object; }; #endif // INCLUDE_REFCOUNTEDPTR_H ================================================ FILE: impls/cpp/StaticList.h ================================================ #ifndef INCLUDE_STATICLIST_H #define INCLUDE_STATICLIST_H template class StaticList { public: StaticList() : m_head(NULL) { } class Iterator; Iterator begin() { return Iterator(m_head); } Iterator end() { return Iterator(NULL); } class Node { public: Node(StaticList& list, T item) : m_item(item), m_next(list.m_head) { list.m_head = this; } private: friend class Iterator; T m_item; Node* m_next; }; class Iterator { public: Iterator& operator ++ () { m_node = m_node->m_next; return *this; } T& operator * () { return m_node->m_item; } bool operator != (const Iterator& that) { return m_node != that.m_node; } private: friend class StaticList; Iterator(Node* node) : m_node(node) { } Node* m_node; }; private: friend class Node; Node* m_head; }; #endif // INCLUDE_STATICLIST_H ================================================ FILE: impls/cpp/String.cpp ================================================ #include "Debug.h" #include "String.h" #include #include #include #include // Adapted from: http://stackoverflow.com/questions/2342162 String stringPrintf(const char* fmt, ...) { int size = strlen(fmt); // make a guess String str; va_list ap; while (1) { str.resize(size); va_start(ap, fmt); int n = vsnprintf((char *)str.data(), size, fmt, ap); va_end(ap); if (n > -1 && n < size) { // Everything worked str.resize(n); return str; } if (n > -1) // Needed size returned size = n + 1; // For null char else size *= 2; // Guess at a larger size (OS specific) } return str; } String copyAndFree(char* mallocedString) { String ret(mallocedString); free(mallocedString); return ret; } String escape(const String& in) { String out; out.reserve(in.size() * 2 + 2); // each char may get escaped + two "'s out += '"'; for (auto it = in.begin(), end = in.end(); it != end; ++it) { char c = *it; switch (c) { case '\\': out += "\\\\"; break; case '\n': out += "\\n"; break; case '"': out += "\\\""; break; default: out += c; break; }; } out += '"'; out.shrink_to_fit(); return out; } static char unescape(char c) { switch (c) { case '\\': return '\\'; case 'n': return '\n'; case '"': return '"'; default: return c; } } String unescape(const String& in) { String out; out.reserve(in.size()); // unescaped string will always be shorter // in will have double-quotes at either end, so move the iterators in for (auto it = in.begin()+1, end = in.end()-1; it != end; ++it) { char c = *it; if (c == '\\') { ++it; if (it != end) { out += unescape(*it); } } else { out += c; } } out.shrink_to_fit(); return out; } ================================================ FILE: impls/cpp/String.h ================================================ #ifndef INCLUDE_STRING_H #define INCLUDE_STRING_H #include #include typedef std::string String; typedef std::vector StringVec; #define STRF stringPrintf #define PLURAL(n) &("s"[(n)==1]) extern String stringPrintf(const char* fmt, ...); extern String copyAndFree(char* mallocedString); extern String escape(const String& s); extern String unescape(const String& s); #endif // INCLUDE_STRING_H ================================================ FILE: impls/cpp/Types.cpp ================================================ #include "Debug.h" #include "Environment.h" #include "Types.h" #include #include #include namespace mal { malValuePtr atom(malValuePtr value) { return malValuePtr(new malAtom(value)); }; malValuePtr boolean(bool value) { return value ? trueValue() : falseValue(); } malValuePtr builtin(const String& name, malBuiltIn::ApplyFunc handler) { return malValuePtr(new malBuiltIn(name, handler)); }; malValuePtr falseValue() { static malValuePtr c(new malConstant("false")); return malValuePtr(c); }; malValuePtr hash(const malHash::Map& map) { return malValuePtr(new malHash(map)); } malValuePtr hash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated) { return malValuePtr(new malHash(argsBegin, argsEnd, isEvaluated)); } malValuePtr integer(int64_t value) { return malValuePtr(new malInteger(value)); }; malValuePtr integer(const String& token) { return integer(std::stoi(token)); }; malValuePtr keyword(const String& token) { return malValuePtr(new malKeyword(token)); }; malValuePtr lambda(const StringVec& bindings, malValuePtr body, malEnvPtr env) { return malValuePtr(new malLambda(bindings, body, env)); } malValuePtr list(malValueVec* items) { return malValuePtr(new malList(items)); }; malValuePtr list(malValueIter begin, malValueIter end) { return malValuePtr(new malList(begin, end)); }; malValuePtr list(malValuePtr a) { malValueVec* items = new malValueVec(1); items->at(0) = a; return malValuePtr(new malList(items)); } malValuePtr list(malValuePtr a, malValuePtr b) { malValueVec* items = new malValueVec(2); items->at(0) = a; items->at(1) = b; return malValuePtr(new malList(items)); } malValuePtr list(malValuePtr a, malValuePtr b, malValuePtr c) { malValueVec* items = new malValueVec(3); items->at(0) = a; items->at(1) = b; items->at(2) = c; return malValuePtr(new malList(items)); } malValuePtr macro(const malLambda& lambda) { return malValuePtr(new malLambda(lambda, true)); }; malValuePtr nilValue() { static malValuePtr c(new malConstant("nil")); return malValuePtr(c); }; malValuePtr string(const String& token) { return malValuePtr(new malString(token)); } malValuePtr symbol(const String& token) { return malValuePtr(new malSymbol(token)); }; malValuePtr trueValue() { static malValuePtr c(new malConstant("true")); return malValuePtr(c); }; malValuePtr vector(malValueVec* items) { return malValuePtr(new malVector(items)); }; malValuePtr vector(malValueIter begin, malValueIter end) { return malValuePtr(new malVector(begin, end)); }; }; malValuePtr malBuiltIn::apply(malValueIter argsBegin, malValueIter argsEnd) const { return m_handler(m_name, argsBegin, argsEnd); } static String makeHashKey(malValuePtr key) { if (const malString* skey = DYNAMIC_CAST(malString, key)) { return skey->print(true); } else if (const malKeyword* kkey = DYNAMIC_CAST(malKeyword, key)) { return kkey->print(true); } MAL_FAIL("%s is not a string or keyword", key->print(true).c_str()); } static malHash::Map addToMap(malHash::Map& map, malValueIter argsBegin, malValueIter argsEnd) { // This is intended to be called with pre-evaluated arguments. for (auto it = argsBegin; it != argsEnd; ++it) { String key = makeHashKey(*it++); map[key] = *it; } return map; } static malHash::Map createMap(malValueIter argsBegin, malValueIter argsEnd) { MAL_CHECK(std::distance(argsBegin, argsEnd) % 2 == 0, "hash-map requires an even-sized list"); malHash::Map map; return addToMap(map, argsBegin, argsEnd); } malHash::malHash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated) : m_map(createMap(argsBegin, argsEnd)) , m_isEvaluated(isEvaluated) { } malHash::malHash(const malHash::Map& map) : m_map(map) , m_isEvaluated(true) { } malValuePtr malHash::assoc(malValueIter argsBegin, malValueIter argsEnd) const { MAL_CHECK(std::distance(argsBegin, argsEnd) % 2 == 0, "assoc requires an even-sized list"); malHash::Map map(m_map); return mal::hash(addToMap(map, argsBegin, argsEnd)); } bool malHash::contains(malValuePtr key) const { auto it = m_map.find(makeHashKey(key)); return it != m_map.end(); } malValuePtr malHash::dissoc(malValueIter argsBegin, malValueIter argsEnd) const { malHash::Map map(m_map); for (auto it = argsBegin; it != argsEnd; ++it) { String key = makeHashKey(*it); map.erase(key); } return mal::hash(map); } malValuePtr malHash::eval(malEnvPtr env) { if (m_isEvaluated) { return malValuePtr(this); } malHash::Map map; for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { map[it->first] = EVAL(it->second, env); } return mal::hash(map); } malValuePtr malHash::get(malValuePtr key) const { auto it = m_map.find(makeHashKey(key)); return it == m_map.end() ? mal::nilValue() : it->second; } malValuePtr malHash::keys() const { malValueVec* keys = new malValueVec(); keys->reserve(m_map.size()); for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { if (it->first[0] == '"') { keys->push_back(mal::string(unescape(it->first))); } else { keys->push_back(mal::keyword(it->first)); } } return mal::list(keys); } malValuePtr malHash::values() const { malValueVec* keys = new malValueVec(); keys->reserve(m_map.size()); for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) { keys->push_back(it->second); } return mal::list(keys); } String malHash::print(bool readably) const { String s = "{"; auto it = m_map.begin(), end = m_map.end(); if (it != end) { s += it->first + " " + it->second->print(readably); ++it; } for ( ; it != end; ++it) { s += " " + it->first + " " + it->second->print(readably); } return s + "}"; } bool malHash::doIsEqualTo(const malValue* rhs) const { const malHash::Map& r_map = static_cast(rhs)->m_map; if (m_map.size() != r_map.size()) { return false; } for (auto it0 = m_map.begin(), end0 = m_map.end(), it1 = r_map.begin(); it0 != end0; ++it0, ++it1) { if (it0->first != it1->first) { return false; } if (!it0->second->isEqualTo(it1->second.ptr())) { return false; } } return true; } malLambda::malLambda(const StringVec& bindings, malValuePtr body, malEnvPtr env) : m_bindings(bindings) , m_body(body) , m_env(env) , m_isMacro(false) { } malLambda::malLambda(const malLambda& that, malValuePtr meta) : malApplicable(meta) , m_bindings(that.m_bindings) , m_body(that.m_body) , m_env(that.m_env) , m_isMacro(that.m_isMacro) { } malLambda::malLambda(const malLambda& that, bool isMacro) : malApplicable(that.m_meta) , m_bindings(that.m_bindings) , m_body(that.m_body) , m_env(that.m_env) , m_isMacro(isMacro) { } malValuePtr malLambda::apply(malValueIter argsBegin, malValueIter argsEnd) const { return EVAL(m_body, makeEnv(argsBegin, argsEnd)); } malValuePtr malLambda::doWithMeta(malValuePtr meta) const { return new malLambda(*this, meta); } malEnvPtr malLambda::makeEnv(malValueIter argsBegin, malValueIter argsEnd) const { return malEnvPtr(new malEnv(m_env, m_bindings, argsBegin, argsEnd)); } malValuePtr malList::conj(malValueIter argsBegin, malValueIter argsEnd) const { int oldItemCount = std::distance(begin(), end()); int newItemCount = std::distance(argsBegin, argsEnd); malValueVec* items = new malValueVec(oldItemCount + newItemCount); std::reverse_copy(argsBegin, argsEnd, items->begin()); std::copy(begin(), end(), items->begin() + newItemCount); return mal::list(items); } malValuePtr malList::eval(malEnvPtr env) { // Note, this isn't actually called since the TCO updates, but // is required for the earlier steps, so don't get rid of it. if (count() == 0) { return malValuePtr(this); } std::unique_ptr items(evalItems(env)); auto it = items->begin(); malValuePtr op = *it; return APPLY(op, ++it, items->end()); } String malList::print(bool readably) const { return '(' + malSequence::print(readably) + ')'; } malValuePtr malValue::eval(malEnvPtr env) { // Default case of eval is just to return the object itself. return malValuePtr(this); } bool malValue::isEqualTo(const malValue* rhs) const { // Special-case. Vectors and Lists can be compared. bool matchingTypes = (typeid(*this) == typeid(*rhs)) || (dynamic_cast(this) && dynamic_cast(rhs)); return matchingTypes && doIsEqualTo(rhs); } bool malValue::isTrue() const { return (this != mal::falseValue().ptr()) && (this != mal::nilValue().ptr()); } malValuePtr malValue::meta() const { return m_meta.ptr() == NULL ? mal::nilValue() : m_meta; } malValuePtr malValue::withMeta(malValuePtr meta) const { return doWithMeta(meta); } malSequence::malSequence(malValueVec* items) : m_items(items) { } malSequence::malSequence(malValueIter begin, malValueIter end) : m_items(new malValueVec(begin, end)) { } malSequence::malSequence(const malSequence& that, malValuePtr meta) : malValue(meta) , m_items(new malValueVec(*(that.m_items))) { } malSequence::~malSequence() { delete m_items; } bool malSequence::doIsEqualTo(const malValue* rhs) const { const malSequence* rhsSeq = static_cast(rhs); if (count() != rhsSeq->count()) { return false; } for (malValueIter it0 = m_items->begin(), it1 = rhsSeq->begin(), end = m_items->end(); it0 != end; ++it0, ++it1) { if (! (*it0)->isEqualTo((*it1).ptr())) { return false; } } return true; } malValueVec* malSequence::evalItems(malEnvPtr env) const { malValueVec* items = new malValueVec;; items->reserve(count()); for (auto it = m_items->begin(), end = m_items->end(); it != end; ++it) { items->push_back(EVAL(*it, env)); } return items; } malValuePtr malSequence::first() const { return count() == 0 ? mal::nilValue() : item(0); } String malSequence::print(bool readably) const { String str; auto end = m_items->cend(); auto it = m_items->cbegin(); if (it != end) { str += (*it)->print(readably); ++it; } for ( ; it != end; ++it) { str += " "; str += (*it)->print(readably); } return str; } malValuePtr malSequence::rest() const { malValueIter start = (count() > 0) ? begin() + 1 : end(); return mal::list(start, end()); } String malString::escapedValue() const { return escape(value()); } String malString::print(bool readably) const { return readably ? escapedValue() : value(); } malValuePtr malSymbol::eval(malEnvPtr env) { return env->get(value()); } malValuePtr malVector::conj(malValueIter argsBegin, malValueIter argsEnd) const { int oldItemCount = std::distance(begin(), end()); int newItemCount = std::distance(argsBegin, argsEnd); malValueVec* items = new malValueVec(oldItemCount + newItemCount); std::copy(begin(), end(), items->begin()); std::copy(argsBegin, argsEnd, items->begin() + oldItemCount); return mal::vector(items); } malValuePtr malVector::eval(malEnvPtr env) { return mal::vector(evalItems(env)); } String malVector::print(bool readably) const { return '[' + malSequence::print(readably) + ']'; } ================================================ FILE: impls/cpp/Types.h ================================================ #ifndef INCLUDE_TYPES_H #define INCLUDE_TYPES_H #include "MAL.h" #include #include class malEmptyInputException : public std::exception { }; class malValue : public RefCounted { public: malValue() { TRACE_OBJECT("Creating malValue %p\n", this); } malValue(malValuePtr meta) : m_meta(meta) { TRACE_OBJECT("Creating malValue %p\n", this); } virtual ~malValue() { TRACE_OBJECT("Destroying malValue %p\n", this); } malValuePtr withMeta(malValuePtr meta) const; virtual malValuePtr doWithMeta(malValuePtr meta) const = 0; malValuePtr meta() const; bool isTrue() const; bool isEqualTo(const malValue* rhs) const; virtual malValuePtr eval(malEnvPtr env); virtual String print(bool readably) const = 0; protected: virtual bool doIsEqualTo(const malValue* rhs) const = 0; malValuePtr m_meta; }; template T* value_cast(malValuePtr obj, const char* typeName) { T* dest = dynamic_cast(obj.ptr()); MAL_CHECK(dest != NULL, "%s is not a %s", obj->print(true).c_str(), typeName); return dest; } #define VALUE_CAST(Type, Value) value_cast(Value, #Type) #define DYNAMIC_CAST(Type, Value) (dynamic_cast((Value).ptr())) #define STATIC_CAST(Type, Value) (static_cast((Value).ptr())) #define WITH_META(Type) \ virtual malValuePtr doWithMeta(malValuePtr meta) const { \ return new Type(*this, meta); \ } \ class malConstant : public malValue { public: malConstant(String name) : m_name(name) { } malConstant(const malConstant& that, malValuePtr meta) : malValue(meta), m_name(that.m_name) { } virtual String print(bool readably) const { return m_name; } virtual bool doIsEqualTo(const malValue* rhs) const { return this == rhs; // these are singletons } WITH_META(malConstant); private: const String m_name; }; class malInteger : public malValue { public: malInteger(int64_t value) : m_value(value) { } malInteger(const malInteger& that, malValuePtr meta) : malValue(meta), m_value(that.m_value) { } virtual String print(bool readably) const { return std::to_string(m_value); } int64_t value() const { return m_value; } virtual bool doIsEqualTo(const malValue* rhs) const { return m_value == static_cast(rhs)->m_value; } WITH_META(malInteger); private: const int64_t m_value; }; class malStringBase : public malValue { public: malStringBase(const String& token) : m_value(token) { } malStringBase(const malStringBase& that, malValuePtr meta) : malValue(meta), m_value(that.value()) { } virtual String print(bool readably) const { return m_value; } String value() const { return m_value; } private: const String m_value; }; class malString : public malStringBase { public: malString(const String& token) : malStringBase(token) { } malString(const malString& that, malValuePtr meta) : malStringBase(that, meta) { } virtual String print(bool readably) const; String escapedValue() const; virtual bool doIsEqualTo(const malValue* rhs) const { return value() == static_cast(rhs)->value(); } WITH_META(malString); }; class malKeyword : public malStringBase { public: malKeyword(const String& token) : malStringBase(token) { } malKeyword(const malKeyword& that, malValuePtr meta) : malStringBase(that, meta) { } virtual bool doIsEqualTo(const malValue* rhs) const { return value() == static_cast(rhs)->value(); } WITH_META(malKeyword); }; class malSymbol : public malStringBase { public: malSymbol(const String& token) : malStringBase(token) { } malSymbol(const malSymbol& that, malValuePtr meta) : malStringBase(that, meta) { } virtual malValuePtr eval(malEnvPtr env); virtual bool doIsEqualTo(const malValue* rhs) const { return value() == static_cast(rhs)->value(); } WITH_META(malSymbol); }; class malSequence : public malValue { public: malSequence(malValueVec* items); malSequence(malValueIter begin, malValueIter end); malSequence(const malSequence& that, malValuePtr meta); virtual ~malSequence(); virtual String print(bool readably) const; malValueVec* evalItems(malEnvPtr env) const; int count() const { return m_items->size(); } bool isEmpty() const { return m_items->empty(); } malValuePtr item(int index) const { return (*m_items)[index]; } malValueIter begin() const { return m_items->begin(); } malValueIter end() const { return m_items->end(); } virtual bool doIsEqualTo(const malValue* rhs) const; virtual malValuePtr conj(malValueIter argsBegin, malValueIter argsEnd) const = 0; malValuePtr first() const; virtual malValuePtr rest() const; private: malValueVec* const m_items; }; class malList : public malSequence { public: malList(malValueVec* items) : malSequence(items) { } malList(malValueIter begin, malValueIter end) : malSequence(begin, end) { } malList(const malList& that, malValuePtr meta) : malSequence(that, meta) { } virtual String print(bool readably) const; virtual malValuePtr eval(malEnvPtr env); virtual malValuePtr conj(malValueIter argsBegin, malValueIter argsEnd) const; WITH_META(malList); }; class malVector : public malSequence { public: malVector(malValueVec* items) : malSequence(items) { } malVector(malValueIter begin, malValueIter end) : malSequence(begin, end) { } malVector(const malVector& that, malValuePtr meta) : malSequence(that, meta) { } virtual malValuePtr eval(malEnvPtr env); virtual String print(bool readably) const; virtual malValuePtr conj(malValueIter argsBegin, malValueIter argsEnd) const; WITH_META(malVector); }; class malApplicable : public malValue { public: malApplicable() { } malApplicable(malValuePtr meta) : malValue(meta) { } virtual malValuePtr apply(malValueIter argsBegin, malValueIter argsEnd) const = 0; }; class malHash : public malValue { public: typedef std::map Map; malHash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated); malHash(const malHash::Map& map); malHash(const malHash& that, malValuePtr meta) : malValue(meta), m_map(that.m_map), m_isEvaluated(that.m_isEvaluated) { } malValuePtr assoc(malValueIter argsBegin, malValueIter argsEnd) const; malValuePtr dissoc(malValueIter argsBegin, malValueIter argsEnd) const; bool contains(malValuePtr key) const; malValuePtr eval(malEnvPtr env); malValuePtr get(malValuePtr key) const; malValuePtr keys() const; malValuePtr values() const; virtual String print(bool readably) const; virtual bool doIsEqualTo(const malValue* rhs) const; WITH_META(malHash); private: const Map m_map; const bool m_isEvaluated; }; class malBuiltIn : public malApplicable { public: typedef malValuePtr (ApplyFunc)(const String& name, malValueIter argsBegin, malValueIter argsEnd); malBuiltIn(const String& name, ApplyFunc* handler) : m_name(name), m_handler(handler) { } malBuiltIn(const malBuiltIn& that, malValuePtr meta) : malApplicable(meta), m_name(that.m_name), m_handler(that.m_handler) { } virtual malValuePtr apply(malValueIter argsBegin, malValueIter argsEnd) const; virtual String print(bool readably) const { return STRF("#builtin-function(%s)", m_name.c_str()); } virtual bool doIsEqualTo(const malValue* rhs) const { return this == rhs; // these are singletons } String name() const { return m_name; } WITH_META(malBuiltIn); private: const String m_name; ApplyFunc* m_handler; }; class malLambda : public malApplicable { public: malLambda(const StringVec& bindings, malValuePtr body, malEnvPtr env); malLambda(const malLambda& that, malValuePtr meta); malLambda(const malLambda& that, bool isMacro); virtual malValuePtr apply(malValueIter argsBegin, malValueIter argsEnd) const; malValuePtr getBody() const { return m_body; } malEnvPtr makeEnv(malValueIter argsBegin, malValueIter argsEnd) const; virtual bool doIsEqualTo(const malValue* rhs) const { return this == rhs; // do we need to do a deep inspection? } virtual String print(bool readably) const { return STRF("#user-%s(%p)", m_isMacro ? "macro" : "function", this); } bool isMacro() const { return m_isMacro; } virtual malValuePtr doWithMeta(malValuePtr meta) const; private: const StringVec m_bindings; const malValuePtr m_body; const malEnvPtr m_env; const bool m_isMacro; }; class malAtom : public malValue { public: malAtom(malValuePtr value) : m_value(value) { } malAtom(const malAtom& that, malValuePtr meta) : malValue(meta), m_value(that.m_value) { } virtual bool doIsEqualTo(const malValue* rhs) const { return this->m_value->isEqualTo(rhs); } virtual String print(bool readably) const { return "(atom " + m_value->print(readably) + ")"; }; malValuePtr deref() const { return m_value; } malValuePtr reset(malValuePtr value) { return m_value = value; } WITH_META(malAtom); private: malValuePtr m_value; }; namespace mal { malValuePtr atom(malValuePtr value); malValuePtr boolean(bool value); malValuePtr builtin(const String& name, malBuiltIn::ApplyFunc handler); malValuePtr falseValue(); malValuePtr hash(malValueIter argsBegin, malValueIter argsEnd, bool isEvaluated); malValuePtr hash(const malHash::Map& map); malValuePtr integer(int64_t value); malValuePtr integer(const String& token); malValuePtr keyword(const String& token); malValuePtr lambda(const StringVec&, malValuePtr, malEnvPtr); malValuePtr list(malValueVec* items); malValuePtr list(malValueIter begin, malValueIter end); malValuePtr list(malValuePtr a); malValuePtr list(malValuePtr a, malValuePtr b); malValuePtr list(malValuePtr a, malValuePtr b, malValuePtr c); malValuePtr macro(const malLambda& lambda); malValuePtr nilValue(); malValuePtr string(const String& token); malValuePtr symbol(const String& token); malValuePtr trueValue(); malValuePtr vector(malValueVec* items); malValuePtr vector(malValueIter begin, malValueIter end); }; #endif // INCLUDE_TYPES_H ================================================ FILE: impls/cpp/Validation.cpp ================================================ #include "Validation.h" int checkArgsIs(const char* name, int expected, int got) { MAL_CHECK(got == expected, "\"%s\" expects %d arg%s, %d supplied", name, expected, PLURAL(expected), got); return got; } int checkArgsBetween(const char* name, int min, int max, int got) { MAL_CHECK((got >= min) && (got <= max), "\"%s\" expects between %d and %d arg%s, %d supplied", name, min, max, PLURAL(max), got); return got; } int checkArgsAtLeast(const char* name, int min, int got) { MAL_CHECK(got >= min, "\"%s\" expects at least %d arg%s, %d supplied", name, min, PLURAL(min), got); return got; } int checkArgsEven(const char* name, int got) { MAL_CHECK(got % 2 == 0, "\"%s\" expects an even number of args, %d supplied", name, got); return got; } ================================================ FILE: impls/cpp/Validation.h ================================================ #ifndef INCLUDE_VALIDATION_H #define INCLUDE_VALIDATION_H #include "String.h" #define MAL_CHECK(condition, ...) \ if (!(condition)) { throw STRF(__VA_ARGS__); } else { } #define MAL_FAIL(...) MAL_CHECK(false, __VA_ARGS__) extern int checkArgsIs(const char* name, int expected, int got); extern int checkArgsBetween(const char* name, int min, int max, int got); extern int checkArgsAtLeast(const char* name, int min, int got); extern int checkArgsEven(const char* name, int got); #endif // INCLUDE_VALIDATION_H ================================================ FILE: impls/cpp/docker.sh ================================================ #!/usr/bin/env bash IMAGE_NAME=mal-cpp CONTAINER_NAME=mal-cpp-running run() { docker rm -f $CONTAINER_NAME > /dev/null 2>/dev/null docker run -v $PWD:/mal -ti --name $CONTAINER_NAME $IMAGE_NAME "$@" } case $1 in build) docker build -t $IMAGE_NAME . ;; run) shift run "$@" ;; make) shift run make "$@" ;; *) echo "usage: $0 [build|run|make]" exit 1 ;; esac ================================================ FILE: impls/cpp/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/cpp/step0_repl.cpp ================================================ #include "String.h" #include "ReadLine.h" #include #include String READ(const String& input); String EVAL(const String& ast); String PRINT(const String& ast); String rep(const String& input); static ReadLine s_readLine("~/.mal-history"); int main(int argc, char* argv[]) { String prompt = "user> "; String input; while (s_readLine.get(prompt, input)) { std::cout << rep(input) << "\n"; } return 0; } String rep(const String& input) { return PRINT(EVAL(READ(input))); } String READ(const String& input) { return input; } String EVAL(const String& ast) { return ast; } String PRINT(const String& ast) { return ast; } ================================================ FILE: impls/cpp/step1_read_print.cpp ================================================ #include "MAL.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static ReadLine s_readLine("~/.mal-history"); static String rep(const String& input); static malValuePtr EVAL(malValuePtr ast); int main(int argc, char* argv[]) { String prompt = "user> "; String input; while (s_readLine.get(prompt, input)) { String out; try { out = rep(input); } catch (malEmptyInputException&) { continue; // no output } catch (String& s) { out = s; }; std::cout << out << "\n"; } return 0; } static String rep(const String& input) { return PRINT(EVAL(READ(input))); } malValuePtr READ(const String& input) { return readStr(input); } static malValuePtr EVAL(malValuePtr ast) { return ast; } String PRINT(malValuePtr ast) { return ast->print(true); } // These have been added after step 1 to keep the linker happy. malValuePtr EVAL(malValuePtr ast, malEnvPtr) { return ast; } malValuePtr APPLY(malValuePtr ast, malValueIter, malValueIter) { return ast; } ================================================ FILE: impls/cpp/step2_eval.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static ReadLine s_readLine("~/.mal-history"); static malBuiltIn::ApplyFunc builtIn_add, builtIn_sub, builtIn_mul, builtIn_div; int main(int argc, char* argv[]) { String prompt = "user> "; String input; malEnvPtr replEnv(new malEnv); replEnv->set("+", mal::builtin("+", &builtIn_add)); replEnv->set("-", mal::builtin("-", &builtIn_sub)); replEnv->set("*", mal::builtin("+", &builtIn_mul)); replEnv->set("/", mal::builtin("/", &builtIn_div)); while (s_readLine.get(prompt, input)) { String out; try { out = rep(input, replEnv); } catch (malEmptyInputException&) { continue; // no output } catch (String& s) { out = s; }; std::cout << out << "\n"; } return 0; } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { // std::cout << "EVAL: " << PRINT(ast) << "\n"; return ast->eval(env); } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } #define ARG(type, name) type* name = VALUE_CAST(type, *argsBegin++) #define CHECK_ARGS_IS(expected) \ checkArgsIs(name.c_str(), expected, std::distance(argsBegin, argsEnd)) #define CHECK_ARGS_BETWEEN(min, max) \ checkArgsBetween(name.c_str(), min, max, std::distance(argsBegin, argsEnd)) static malValuePtr builtIn_add(const String& name, malValueIter argsBegin, malValueIter argsEnd) { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::integer(lhs->value() + rhs->value()); } static malValuePtr builtIn_sub(const String& name, malValueIter argsBegin, malValueIter argsEnd) { int argCount = CHECK_ARGS_BETWEEN(1, 2); ARG(malInteger, lhs); if (argCount == 1) { return mal::integer(- lhs->value()); } ARG(malInteger, rhs); return mal::integer(lhs->value() - rhs->value()); } static malValuePtr builtIn_mul(const String& name, malValueIter argsBegin, malValueIter argsEnd) { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); return mal::integer(lhs->value() * rhs->value()); } static malValuePtr builtIn_div(const String& name, malValueIter argsBegin, malValueIter argsEnd) { CHECK_ARGS_IS(2); ARG(malInteger, lhs); ARG(malInteger, rhs); MAL_CHECK(rhs->value() != 0, "Division by zero"); \ return mal::integer(lhs->value() / rhs->value()); } ================================================ FILE: impls/cpp/step3_env.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); while (s_readLine.get(prompt, input)) { String out; try { out = rep(input, replEnv); } catch (malEmptyInputException&) { continue; // no output } catch (String& s) { out = s; }; std::cout << out << "\n"; } return 0; } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } return EVAL(list->item(2), inner); } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr items(list->evalItems(env)); malValuePtr op = items->at(0); return APPLY(op, items->begin()+1, items->end()); } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step4_if_fn_do.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); while (s_readLine.get(prompt, input)) { String out; try { out = rep(input, replEnv); } catch (malEmptyInputException&) { continue; // no output } catch (String& s) { out = s; }; std::cout << out << "\n"; } return 0; } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } return EVAL(list->item(argCount), env); } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } return EVAL(list->item(isTrue ? 2 : 3), env); } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } return EVAL(list->item(2), inner); } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { return EVAL(lambda->getBody(), lambda->makeEnv(items->begin()+1, items->end())); } else { return APPLY(op, items->begin()+1, items->end()); } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static const char* malFunctionTable[] = { "(def! not (fn* (cond) (if cond false true)))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step5_tco.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); while (s_readLine.get(prompt, input)) { String out; try { out = rep(input, replEnv); } catch (malEmptyInputException&) { continue; // no output } catch (String& s) { out = s; }; std::cout << out << "\n"; } return 0; } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { ast = lambda->getBody(); env = lambda->makeEnv(items->begin()+1, items->end()); continue; // TCO } else { return APPLY(op, items->begin()+1, items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static const char* malFunctionTable[] = { "(def! not (fn* (cond) (if cond false true)))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step6_file.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); makeArgv(replEnv, argc - 2, argv + 2); if (argc > 1) { String filename = escape(argv[1]); safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); return 0; } while (s_readLine.get(prompt, input)) { String out = safeRep(input, replEnv); if (out.length() > 0) std::cout << out << "\n"; } return 0; } static String safeRep(const String& input, malEnvPtr env) { try { return rep(input, env); } catch (malEmptyInputException&) { return String(); } catch (String& s) { return s; }; } static void makeArgv(malEnvPtr env, int argc, char* argv[]) { malValueVec* args = new malValueVec(); for (int i = 0; i < argc; i++) { args->push_back(mal::string(argv[i])); } env->set("*ARGV*", mal::list(args)); } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { ast = lambda->getBody(); env = lambda->makeEnv(items->begin()+1, items->end()); continue; // TCO } else { return APPLY(op, items->begin()+1, items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static const char* malFunctionTable[] = { "(def! not (fn* (cond) (if cond false true)))", "(def! load-file (fn* (filename) \ (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step7_quote.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); makeArgv(replEnv, argc - 2, argv + 2); if (argc > 1) { String filename = escape(argv[1]); safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); return 0; } while (s_readLine.get(prompt, input)) { String out = safeRep(input, replEnv); if (out.length() > 0) std::cout << out << "\n"; } return 0; } static String safeRep(const String& input, malEnvPtr env) { try { return rep(input, env); } catch (malEmptyInputException&) { return String(); } catch (String& s) { return s; }; } static void makeArgv(malEnvPtr env, int argc, char* argv[]) { malValueVec* args = new malValueVec(); for (int i = 0; i < argc; i++) { args->push_back(mal::string(argv[i])); } env->set("*ARGV*", mal::list(args)); } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); continue; // TCO } if (special == "quote") { checkArgsIs("quote", 1, argCount); return list->item(1); } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { ast = lambda->getBody(); env = lambda->makeEnv(items->begin()+1, items->end()); continue; // TCO } else { return APPLY(op, items->begin()+1, items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static bool isSymbol(malValuePtr obj, const String& text) { const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); return sym && (sym->value() == text); } // Return arg when ast matches ('sym, arg), else NULL. static malValuePtr starts_with(const malValuePtr ast, const char* sym) { 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) { if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); const malSequence* seq = DYNAMIC_CAST(malSequence, obj); if (!seq) return obj; 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[] = { "(def! not (fn* (cond) (if cond false true)))", "(def! load-file (fn* (filename) \ (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step8_macros.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); // Installs functions and macros implemented in MAL. static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); makeArgv(replEnv, argc - 2, argv + 2); if (argc > 1) { String filename = escape(argv[1]); safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); return 0; } while (s_readLine.get(prompt, input)) { String out = safeRep(input, replEnv); if (out.length() > 0) std::cout << out << "\n"; } return 0; } static String safeRep(const String& input, malEnvPtr env) { try { return rep(input, env); } catch (malEmptyInputException&) { return String(); } catch (String& s) { return s; }; } static void makeArgv(malEnvPtr env, int argc, char* argv[]) { malValueVec* args = new malValueVec(); for (int i = 0; i < argc; i++) { args->push_back(mal::string(argv[i])); } env->set("*ARGV*", mal::list(args)); } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "defmacro!") { checkArgsIs("defmacro!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); malValuePtr body = EVAL(list->item(2), env); const malLambda* lambda = VALUE_CAST(malLambda, body); return env->set(id->value(), mal::macro(*lambda)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); continue; // TCO } if (special == "quote") { checkArgsIs("quote", 1, argCount); return list->item(1); } } // Now we're left with the case of a regular list to be evaluated. malValuePtr op = EVAL(list->item(0), env); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { if (lambda->isMacro()) { ast = lambda->apply(list->begin()+1, list->end()); continue; // TCO } malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); ast = lambda->getBody(); env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); return APPLY(op, items->begin(), items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static bool isSymbol(malValuePtr obj, const String& text) { const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); return sym && (sym->value() == text); } // Return arg when ast matches ('sym, arg), else NULL. static malValuePtr starts_with(const malValuePtr ast, const char* sym) { 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) { if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); const malSequence* seq = DYNAMIC_CAST(malSequence, obj); if (!seq) return obj; 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[] = { "(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)))))))", "(def! not (fn* (cond) (if cond false true)))", "(def! load-file (fn* (filename) \ (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/step9_try.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); // Installs functions and macros implemented in MAL. static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); makeArgv(replEnv, argc - 2, argv + 2); if (argc > 1) { String filename = escape(argv[1]); safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); return 0; } while (s_readLine.get(prompt, input)) { String out = safeRep(input, replEnv); if (out.length() > 0) std::cout << out << "\n"; } return 0; } static String safeRep(const String& input, malEnvPtr env) { try { return rep(input, env); } catch (malEmptyInputException&) { return String(); } catch (malValuePtr& mv) { return "Error: " + mv->print(true); } catch (String& s) { return "Error: " + s; }; } static void makeArgv(malEnvPtr env, int argc, char* argv[]) { malValueVec* args = new malValueVec(); for (int i = 0; i < argc; i++) { args->push_back(mal::string(argv[i])); } env->set("*ARGV*", mal::list(args)); } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "defmacro!") { checkArgsIs("defmacro!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); malValuePtr body = EVAL(list->item(2), env); const malLambda* lambda = VALUE_CAST(malLambda, body); return env->set(id->value(), mal::macro(*lambda)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); continue; // TCO } if (special == "quote") { checkArgsIs("quote", 1, argCount); return list->item(1); } if (special == "try*") { malValuePtr tryBody = list->item(1); if (argCount == 1) { ast = tryBody; continue; // TCO } checkArgsIs("try*", 2, argCount); const malList* catchBlock = VALUE_CAST(malList, list->item(2)); checkArgsIs("catch*", 2, catchBlock->count() - 1); MAL_CHECK(VALUE_CAST(malSymbol, catchBlock->item(0))->value() == "catch*", "catch block must begin with catch*"); // We don't need excSym at this scope, but we want to check // that the catch block is valid always, not just in case of // an exception. const malSymbol* excSym = VALUE_CAST(malSymbol, catchBlock->item(1)); malValuePtr excVal; try { return EVAL(tryBody, env); } catch(String& s) { excVal = mal::string(s); } catch (malEmptyInputException&) { // Not an error, continue as if we got nil ast = mal::nilValue(); } catch(malValuePtr& o) { excVal = o; }; if (excVal) { // we got some exception env = malEnvPtr(new malEnv(env)); env->set(excSym->value(), excVal); ast = catchBlock->item(2); } continue; // TCO } } // Now we're left with the case of a regular list to be evaluated. malValuePtr op = EVAL(list->item(0), env); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { if (lambda->isMacro()) { ast = lambda->apply(list->begin()+1, list->end()); continue; // TCO } malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); ast = lambda->getBody(); env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); return APPLY(op, items->begin(), items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static bool isSymbol(malValuePtr obj, const String& text) { const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); return sym && (sym->value() == text); } // Return arg when ast matches ('sym, arg), else NULL. static malValuePtr starts_with(const malValuePtr ast, const char* sym) { 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) { if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); const malSequence* seq = DYNAMIC_CAST(malSequence, obj); if (!seq) return obj; 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[] = { "(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)))))))", "(def! not (fn* (cond) (if cond false true)))", "(def! load-file (fn* (filename) \ (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/stepA_mal.cpp ================================================ #include "MAL.h" #include "Environment.h" #include "ReadLine.h" #include "Types.h" #include #include malValuePtr READ(const String& input); String PRINT(malValuePtr ast); static void installFunctions(malEnvPtr env); // Installs functions, macros and constants implemented in MAL. static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); static ReadLine s_readLine("~/.mal-history"); static malEnvPtr replEnv(new malEnv); int main(int argc, char* argv[]) { String prompt = "user> "; String input; installCore(replEnv); installFunctions(replEnv); makeArgv(replEnv, argc - 2, argv + 2); if (argc > 1) { String filename = escape(argv[1]); safeRep(STRF("(load-file %s)", filename.c_str()), replEnv); return 0; } rep("(println (str \"Mal [\" *host-language* \"]\"))", replEnv); while (s_readLine.get(prompt, input)) { String out = safeRep(input, replEnv); if (out.length() > 0) std::cout << out << "\n"; } return 0; } static String safeRep(const String& input, malEnvPtr env) { try { return rep(input, env); } catch (malEmptyInputException&) { return String(); } catch (malValuePtr& mv) { return "Error: " + mv->print(true); } catch (String& s) { return "Error: " + s; }; } static void makeArgv(malEnvPtr env, int argc, char* argv[]) { malValueVec* args = new malValueVec(); for (int i = 0; i < argc; i++) { args->push_back(mal::string(argv[i])); } env->set("*ARGV*", mal::list(args)); } String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); } malValuePtr READ(const String& input) { return readStr(input); } malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { std::cout << "EVAL: " << PRINT(ast) << "\n"; } const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "defmacro!") { checkArgsIs("defmacro!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); malValuePtr body = EVAL(list->item(2), env); const malLambda* lambda = VALUE_CAST(malLambda, body); return env->set(id->value(), mal::macro(*lambda)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); continue; // TCO } if (special == "quote") { checkArgsIs("quote", 1, argCount); return list->item(1); } if (special == "try*") { malValuePtr tryBody = list->item(1); if (argCount == 1) { ast = tryBody; continue; // TCO } checkArgsIs("try*", 2, argCount); const malList* catchBlock = VALUE_CAST(malList, list->item(2)); checkArgsIs("catch*", 2, catchBlock->count() - 1); MAL_CHECK(VALUE_CAST(malSymbol, catchBlock->item(0))->value() == "catch*", "catch block must begin with catch*"); // We don't need excSym at this scope, but we want to check // that the catch block is valid always, not just in case of // an exception. const malSymbol* excSym = VALUE_CAST(malSymbol, catchBlock->item(1)); malValuePtr excVal; try { return EVAL(tryBody, env); } catch(String& s) { excVal = mal::string(s); } catch (malEmptyInputException&) { // Not an error, continue as if we got nil ast = mal::nilValue(); } catch(malValuePtr& o) { excVal = o; }; if (excVal) { // we got some exception env = malEnvPtr(new malEnv(env)); env->set(excSym->value(), excVal); ast = catchBlock->item(2); } continue; // TCO } } // Now we're left with the case of a regular list to be evaluated. malValuePtr op = EVAL(list->item(0), env); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { if (lambda->isMacro()) { ast = lambda->apply(list->begin()+1, list->end()); continue; // TCO } malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); ast = lambda->getBody(); env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); return APPLY(op, items->begin(), items->end()); } } } String PRINT(malValuePtr ast) { return ast->print(true); } malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd) { const malApplicable* handler = DYNAMIC_CAST(malApplicable, op); MAL_CHECK(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str()); return handler->apply(argsBegin, argsEnd); } static bool isSymbol(malValuePtr obj, const String& text) { const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj); return sym && (sym->value() == text); } // Return arg when ast matches ('sym, arg), else NULL. static malValuePtr starts_with(const malValuePtr ast, const char* sym) { 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) { if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); const malSequence* seq = DYNAMIC_CAST(malSequence, obj); if (!seq) return obj; 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[] = { "(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)))))))", "(def! not (fn* (cond) (if cond false true)))", "(def! load-file (fn* (filename) \ (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))", "(def! *host-language* \"C++\")", }; static void installFunctions(malEnvPtr env) { for (auto &function : malFunctionTable) { rep(function, env); } } // Added to keep the linker happy at step A malValuePtr readline(const String& prompt) { String input; if (s_readLine.get(prompt, input)) { return mal::string(input); } return mal::nilValue(); } ================================================ FILE: impls/cpp/tests/step5_tco.mal ================================================ ;; C++: skipping non-TCO recursion ;; Reason: completes at 10,000, segfaults at 20,000 ================================================ FILE: impls/crystal/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ ca-certificates crystal git libreadline-dev shards ================================================ FILE: impls/crystal/Makefile ================================================ STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote step8_macros \ step9_try stepA_mal all: $(STEPS) $(STEPS): shards build $@ --release clean: rm -rf .cache/crystal/ .cache/shards/ bin/ lib/ .PHONY: all clean $(STEPS) ================================================ FILE: impls/crystal/core.cr ================================================ require "time" require "readline" require "./types" require "./error" require "./printer" require "./reader" module Mal macro calc_op(op) -> (args : Array(Mal::Type)) { x, y = args[0].unwrap, args[1].unwrap eval_error "invalid arguments for binary operator {{op.id}}" unless x.is_a?(Int64) && y.is_a?(Int64) Mal::Type.new(x {{op.id}} y) } end def self.list(args) args.to_mal end def self.list?(args) args.first.unwrap.is_a? Mal::List end def self.empty?(args) a = args.first.unwrap a.is_a?(Array) ? a.empty? : false end def self.count(args) a = args.first.unwrap case a when Array a.size.to_i64 when Nil 0i64 else eval_error "invalid argument for function 'count'" end end def self.pr_str_(args) args.map { |a| pr_str(a) }.join(" ") end def self.str(args) args.map { |a| pr_str(a, false) }.join end def self.prn(args) puts self.pr_str_(args) nil end def self.println(args) puts args.map { |a| pr_str(a, false) }.join(" ") nil end def self.read_string(args) head = args.first.unwrap eval_error "argument of read-str must be string" unless head.is_a? String read_str head end def self.slurp(args) head = args.first.unwrap eval_error "argument of slurp must be string" unless head.is_a? String begin File.read head rescue nil end end def self.cons(args) head, tail = args[0].as(Mal::Type), args[1].unwrap eval_error "2nd arg of cons must be list" unless tail.is_a? Array ([head] + tail).to_mal end def self.concat(args) args.each_with_object(Mal::List.new) do |arg, list| a = arg.unwrap eval_error "arguments of concat must be list" unless a.is_a?(Array) a.each { |e| list << e } 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 eval_error "2nd argument of nth must be integer" unless a1.is_a? Int64 a0[a1] end def self.first(args) a0 = args[0].unwrap return nil if a0.nil? eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array a0.empty? ? nil : a0.first end def self.rest(args) a0 = args[0].unwrap return Mal::List.new if a0.nil? eval_error "1st argument of first must be list or vector or nil" unless a0.is_a? Array return Mal::List.new if a0.empty? a0[1..-1].to_mal end def self.apply(args) eval_error "apply must take at least 2 arguments" unless args.size >= 2 head = args.first.unwrap last = args.last.unwrap eval_error "last argument of apply must be list or vector" unless last.is_a? Array case head when Mal::Closure head.fn.call(args[1..-2] + last) when Mal::Func head.call(args[1..-2] + last) else eval_error "1st argument of apply must be function or closure" end end def self.map(args) func = args.first.unwrap list = args[1].unwrap eval_error "2nd argument of map must be list or vector" unless list.is_a? Array f = case func when Mal::Closure then func.fn when Mal::Func then func else eval_error "1st argument of map must be function" end list.each_with_object(Mal::List.new) do |elem, mapped| mapped << f.call([elem]) end end def self.nil_value?(args) args.first.unwrap.nil? end def self.true?(args) a = args.first.unwrap a.is_a?(Bool) && a end def self.false?(args) a = args.first.unwrap a.is_a?(Bool) && !a end def self.symbol?(args) args.first.unwrap.is_a?(Mal::Symbol) end def self.symbol(args) head = args.first.unwrap eval_error "1st argument of symbol function must be string" unless head.is_a? String Mal::Symbol.new head end def self.string?(args) head = args.first.unwrap head.is_a?(String) && (head.empty? || head[0] != '\u029e') end def self.keyword(args) head = args.first.unwrap eval_error "1st argument of symbol function must be string" unless head.is_a? String if ! head.empty? && head[0] == '\u029e' return head end "\u029e" + head end def self.keyword?(args) head = args.first.unwrap head.is_a?(String) && !head.empty? && head[0] == '\u029e' end def self.number?(args) args.first.unwrap.is_a?(Int64) end def self.fn?(args) return false if args.first.macro? head = args.first.unwrap head.is_a?(Mal::Func) || head.is_a?(Mal::Closure) end def self.macro?(args) args.first.macro? end def self.vector(args) args.to_mal(Mal::Vector) end def self.vector?(args) args.first.unwrap.is_a? Mal::Vector end def self.hash_map(args) eval_error "hash-map must take even number of arguments" unless args.size.even? map = Mal::HashMap.new args.each_slice(2) do |kv| k = kv[0].unwrap eval_error "key must be string" unless k.is_a? String map[k] = kv[1] end map end def self.map?(args) args.first.unwrap.is_a? Mal::HashMap end def self.assoc(args) head = args.first.unwrap eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap eval_error "assoc must take a list and even number of arguments" unless (args.size - 1).even? map = Mal::HashMap.new head.each { |k, v| map[k] = v } args[1..-1].each_slice(2) do |kv| k = kv[0].unwrap eval_error "key must be string" unless k.is_a? String map[k] = kv[1] end map end def self.dissoc(args) head = args.first.unwrap eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap map = Mal::HashMap.new head.each { |k, v| map[k] = v } args[1..-1].each do |arg| key = arg.unwrap eval_error "key must be string" unless key.is_a? String map.delete key end map end def self.get(args) a0, a1 = args[0].unwrap, args[1].unwrap return nil unless a0.is_a? Mal::HashMap eval_error "2nd argument of get must be string" unless a1.is_a? String # a0[a1]? isn't available because type ofa0[a1] is infered NoReturn a0.has_key?(a1) ? a0[a1] : nil end def self.contains?(args) a0, a1 = args[0].unwrap, args[1].unwrap eval_error "1st argument of get must be hashmap" unless a0.is_a? Mal::HashMap eval_error "2nd argument of get must be string" unless a1.is_a? String a0.has_key? a1 end def self.keys(args) head = args.first.unwrap eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap head.keys.each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } end def self.vals(args) head = args.first.unwrap eval_error "1st argument of assoc must be hashmap" unless head.is_a? Mal::HashMap head.values.to_mal end def self.sequential?(args) args.first.unwrap.is_a? Array end def self.readline(args) head = args.first.unwrap eval_error "1st argument of readline must be string" unless head.is_a? String Readline.readline(head, true) end def self.meta(args) m = args.first.meta m.nil? ? nil : m end def self.with_meta(args) t = args.first.dup t.meta = args[1] t end def self.atom(args) Mal::Atom.new args.first end def self.atom?(args) args.first.unwrap.is_a? Mal::Atom end def self.deref(args) head = args.first.unwrap eval_error "1st argument of deref must be atom" unless head.is_a? Mal::Atom head.val end def self.reset!(args) head = args.first.unwrap eval_error "1st argument of reset! must be atom" unless head.is_a? Mal::Atom head.val = args[1] end def self.swap!(args) atom = args.first.unwrap eval_error "1st argument of swap! must be atom" unless atom.is_a? Mal::Atom a = [atom.val] + args[2..-1] func = args[1].unwrap case func when Mal::Func atom.val = func.call a when Mal::Closure atom.val = func.fn.call a else eval_error "2nd argumetn of swap! must be function" end end def self.conj(args) seq = args.first.unwrap case seq when Mal::List (args[1..-1].reverse + seq).to_mal when Mal::Vector (seq + args[1..-1]).to_mal(Mal::Vector) else eval_error "1st argument of conj must be list or vector" end end def self.seq(args) obj = args.first.unwrap case obj when nil nil when Mal::List return nil if obj.empty? obj when Mal::Vector return nil if obj.empty? obj.to_mal when String return nil if obj.empty? obj.split("").each_with_object(Mal::List.new) { |e, l| l << Mal::Type.new(e) } else eval_error "argument of seq must be list or vector or string or nil" end end def self.time_ms(args) Time.utc.to_unix_ms end # Note: # Simply using ->self.some_func doesn't work macro func(name) -> (args : Array(Mal::Type)) { Mal::Type.new self.{{name.id}}(args) } end macro rel_op(op) -> (args : Array(Mal::Type)) { Mal::Type.new (args[0] {{op.id}} args[1]) } end NS = { "+" => calc_op(:+), "-" => calc_op(:-), "*" => calc_op(:*), "/" => calc_op(://), "list" => func(:list), "list?" => func(:list?), "empty?" => func(:empty?), "count" => func(:count), "=" => rel_op(:==), "<" => rel_op(:<), ">" => rel_op(:>), "<=" => rel_op(:<=), ">=" => rel_op(:>=), "pr-str" => func(:pr_str_), "str" => func(:str), "prn" => func(:prn), "println" => func(:println), "read-string" => func(:read_string), "slurp" => func(:slurp), "cons" => func(:cons), "concat" => func(:concat), "vec" => func(:vec), "nth" => func(:nth), "first" => func(:first), "rest" => func(:rest), "throw" => ->(args : Array(Mal::Type)) { raise Mal::RuntimeException.new args[0] }, "apply" => func(:apply), "map" => func(:map), "nil?" => func(:nil_value?), "true?" => func(:true?), "false?" => func(:false?), "symbol?" => func(:symbol?), "symbol" => func(:symbol), "string?" => func(:string?), "keyword" => func(:keyword), "keyword?" => func(:keyword?), "number?" => func(:number?), "fn?" => func(:fn?), "macro?" => func(:macro?), "vector" => func(:vector), "vector?" => func(:vector?), "hash-map" => func(:hash_map), "map?" => func(:map?), "assoc" => func(:assoc), "dissoc" => func(:dissoc), "get" => func(:get), "contains?" => func(:contains?), "keys" => func(:keys), "vals" => func(:vals), "sequential?" => func(:sequential?), "readline" => func(:readline), "meta" => func(:meta), "with-meta" => func(:with_meta), "atom" => func(:atom), "atom?" => func(:atom?), "deref" => func(:deref), "deref" => func(:deref), "reset!" => func(:reset!), "swap!" => func(:swap!), "conj" => func(:conj), "seq" => func(:seq), "time-ms" => func(:time_ms), } of String => Mal::Func end ================================================ FILE: impls/crystal/env.cr ================================================ require "./types" require "./error" module Mal class Env property data def initialize(@outer : Env?) @data = {} of String => Mal::Type end def initialize(@outer : Env, binds, exprs : Array(Mal::Type)) @data = {} of String => Mal::Type eval_error "binds must be list or vector" unless binds.is_a? Array # Note: # Array#zip() can't be used because overload resolution failed (0...binds.size).each do |idx| sym = binds[idx].unwrap eval_error "bind name must be symbol" unless sym.is_a? Mal::Symbol if sym.str == "&" eval_error "missing variable parameter name" if binds.size == idx next_param = binds[idx + 1].unwrap eval_error "bind name must be symbol" unless next_param.is_a? Mal::Symbol var_args = Mal::List.new exprs[idx..-1].each { |e| var_args << e } if idx < exprs.size @data[next_param.str] = Mal::Type.new var_args break end @data[sym.str] = exprs[idx] end end def dump puts "ENV BEGIN".colorize.red @data.each do |k, v| puts " #{k} -> #{print(v)}".colorize.red end puts "ENV END".colorize.red end def set(key, value) @data[key] = value end def get(key) return @data[key] if @data.has_key? key o = @outer if o o.get key else nil end end end end ================================================ FILE: impls/crystal/error.cr ================================================ require "./types" module Mal class ParseException < Exception end class EvalException < Exception end class RuntimeException < Exception getter :thrown def initialize(@thrown : Type) super() end end end def eval_error(msg) raise Mal::EvalException.new msg end def parse_error(msg) raise Mal::ParseException.new msg end ================================================ FILE: impls/crystal/printer.cr ================================================ require "./types" def pr_str(value, print_readably = true) case value when Nil then "nil" when Bool then value.to_s when Int64 then value.to_s when Mal::List then "(#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")})" when Mal::Vector then "[#{value.map { |v| pr_str(v, print_readably).as(String) }.join(" ")}]" when Mal::Symbol then value.str.to_s when Mal::Func then "" when Mal::Closure then "" when Mal::HashMap # step1_read_print.cr requires specifying type "{#{value.map { |k, v| "#{pr_str(k, print_readably)} #{pr_str(v, print_readably)}".as(String) }.join(" ")}}" when String case when value.empty? print_readably ? value.inspect : value when value[0] == '\u029e' ":#{value[1..-1]}" else print_readably ? value.inspect : value end when Mal::Atom "(atom #{pr_str(value.val, print_readably)})" else raise "invalid MalType: #{value.to_s}" end end def pr_str(t : Mal::Type, print_readably = true) pr_str(t.unwrap, print_readably) + (t.macro? ? " (macro)" : "") end ================================================ FILE: impls/crystal/reader.cr ================================================ require "./types" require "./error" class Reader def initialize(@tokens : Array(String)) @pos = 0 end def current_token @tokens[@pos] rescue nil end def peek t = current_token if t && t[0] == ';' @pos += 1 peek else t end end def next peek ensure @pos += 1 end def read_sequence(init, open, close) token = self.next parse_error "expected '#{open}', got EOF" unless token parse_error "expected '#{open}', got #{token}" unless token[0] == open loop do token = peek parse_error "expected '#{close}', got EOF" unless token break if token[0] == close init << read_form peek end self.next init end def read_list Mal::Type.new read_sequence(Mal::List.new, '(', ')') end def read_vector Mal::Type.new read_sequence(Mal::Vector.new, '[', ']') end def read_hashmap types = read_sequence([] of Mal::Type, '{', '}') parse_error "odd number of elements for hash-map: #{types.size}" if types.size.odd? map = Mal::HashMap.new types.each_slice(2) do |kv| k, v = kv[0].unwrap, kv[1] case k when String map[k] = v else parse_error("key of hash-map must be string or keyword") end end Mal::Type.new map end def read_atom token = self.next parse_error "expected Atom but got EOF" unless token Mal::Type.new case when token =~ /^-?\d+$/ then token.to_i64 when token == "true" then true when token == "false" then false when token == "nil" then nil when token =~ /^"(?:\\.|[^\\"])*"$/ token[1..-2].gsub(/\\(.)/, {"\\\"" => "\"", "\\n" => "\n", "\\\\" => "\\"}) when token[0] == '"' then parse_error "expected '\"', got EOF" when token[0] == ':' then "\u029e#{token[1..-1]}" else Mal::Symbol.new token end end def list_of(symname) Mal::List.new << gen_type(Mal::Symbol, symname) << read_form end def read_form token = peek parse_error "unexpected EOF" unless token parse_error "unexpected comment" if token[0] == ';' Mal::Type.new case token when "(" then read_list when ")" then parse_error "unexpected ')'" when "[" then read_vector when "]" then parse_error "unexpected ']'" when "{" then read_hashmap when "}" then parse_error "unexpected '}'" when "'" then self.next; list_of("quote") when "`" then self.next; list_of("quasiquote") when "~" then self.next; list_of("unquote") when "~@" then self.next; list_of("splice-unquote") when "@" then self.next; list_of("deref") when "^" self.next meta = read_form list_of("with-meta") << meta else read_atom end end end def tokenize(str) regex = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ str.scan(regex).map { |m| m[1] }.reject(&.empty?) end def read_str(str) r = Reader.new(tokenize(str)) begin r.read_form ensure unless r.peek.nil? raise Mal::ParseException.new "expected EOF, got #{r.peek.to_s}" end end end ================================================ FILE: impls/crystal/run ================================================ #!/bin/sh exec $(dirname $0)/bin/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/crystal/shard.yml ================================================ name: make-a-lisp version: 0.1.0 targets: step0_repl: main: step0_repl.cr step1_read_print: main: step1_read_print.cr step2_eval: main: step2_eval.cr step3_env: main: step3_env.cr step4_if_fn_do: main: step4_if_fn_do.cr step5_tco: main: step5_tco.cr step6_file: main: step6_file.cr step7_quote: main: step7_quote.cr step8_macros: main: step8_macros.cr step9_try: main: step9_try.cr stepA_mal: main: stepA_mal.cr dependencies: readline: github: crystal-lang/crystal-readline ================================================ FILE: impls/crystal/step0_repl.cr ================================================ #! /usr/bin/env crystal run require "readline" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods def read(x) x end def eval(x) x end def print(x) x end def rep(x) read(eval(print(x))) end while line = Readline.readline("user> ") puts rep(line) end ================================================ FILE: impls/crystal/step1_read_print.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def read(str) read_str str end def eval(x) x end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str))) end end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step2_eval.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods def eval_error(msg) raise Mal::EvalException.new msg end def num_func(func) ->(args : Array(Mal::Type)) { x, y = args[0].unwrap, args[1].unwrap eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) Mal::Type.new func.call(x, y) } end REPL_ENV = { "+" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x + y })), "-" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x - y })), "*" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x * y })), "/" => Mal::Type.new(num_func(->(x : Int64, y : Int64) { x // y })), } of String => Mal::Type module Mal extend self def read(str) read_str str end def eval(ast, env) # puts "EVAL: #{print(ast)}" val = ast.unwrap case val when Mal::Symbol eval_error "'#{val.str}' not found" unless env.has_key? val.str return env[val.str] when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? f = eval(list.first, env).unwrap case f when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end else return Mal::Type.new val end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step3_env.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods def eval_error(msg) raise Mal::EvalException.new msg end def num_func(func) ->(args : Array(Mal::Type)) { x, y = args[0].unwrap, args[1].unwrap eval_error "invalid arguments" unless x.is_a?(Int64) && y.is_a?(Int64) Mal::Type.new func.call(x, y) } end REPL_ENV = Mal::Env.new nil REPL_ENV.set("+", Mal::Type.new num_func(->(x : Int64, y : Int64) { x + y })) REPL_ENV.set("-", Mal::Type.new num_func(->(x : Int64, y : Int64) { x - y })) REPL_ENV.set("*", Mal::Type.new num_func(->(x : Int64, y : Int64) { x * y })) REPL_ENV.set("/", Mal::Type.new num_func(->(x : Int64, y : Int64) { x // y })) module Mal extend self def read(str) read_str str end def eval(ast, env) puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end return eval(list[2], new_env) else f = eval(list.first, env).unwrap case f when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step4_if_fn_do.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end def eval(ast, env) puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end return eval(list[2], new_env) when "do" if list.empty? return Mal::Type.new(nil) end return list[1..-1].map { |n| eval(n, env) }.last when "if" if eval(list[1], env).unwrap return eval(list[2], env) elsif list.size >= 4 return eval(list[3], env) else return Mal::Type.new(nil) end when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) else f = eval(list.first, env).unwrap case f when Mal::Closure args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return eval(f.ast, Mal::Env.new(f.env, f.params, args)) when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } Mal.rep "(def! not (fn* (a) (if a false true)))" while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step5_tco.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) else f = eval(list.first, env).unwrap case f when Mal::Closure args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } Mal.rep "(def! not (fn* (a) (if a false true)))" while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step6_file.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) else f = eval(list.first, env).unwrap case f when Mal::Closure args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) Mal.rep "(def! not (fn* (a) (if a false true)))" Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" argv = Mal::List.new REPL_ENV.set("*ARGV*", Mal::Type.new argv) unless ARGV.empty? if ARGV.size > 1 ARGV[1..-1].each do |a| argv << Mal::Type.new(a) end end begin Mal.rep "(load-file \"#{ARGV[0]}\")" rescue e STDERR.puts e end exit end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step7_quote.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end 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) 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 ) else ast end end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" return Mal::Type.new list[1] when "quasiquote" ast = quasiquote list[1] next # TCO else f = eval(list.first, env).unwrap case f when Mal::Closure args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) Mal.rep "(def! not (fn* (a) (if a false true)))" Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" argv = Mal::List.new REPL_ENV.set("*ARGV*", Mal::Type.new argv) unless ARGV.empty? if ARGV.size > 1 ARGV[1..-1].each do |a| argv << Mal::Type.new(a) end end begin Mal.rep "(load-file \"#{ARGV[0]}\")" rescue e STDERR.puts e end exit end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step8_macros.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end 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) 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 ) else ast end end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" return Mal::Type.new list[1] when "quasiquote" ast = quasiquote list[1] next # TCO when "defmacro!" eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol mac = eval(list[2], env).dup mac.is_macro = true return Mal::Type.new env.set(a1.str, mac) else evaluated_first = eval(list.first, env) f = evaluated_first.unwrap case f when Mal::Closure if evaluated_first.macro? ast = f.fn.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func if evaluated_first.macro? ast = f.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) Mal.rep "(def! not (fn* (a) (if a false true)))" Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" Mal.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)))))))" argv = Mal::List.new REPL_ENV.set("*ARGV*", Mal::Type.new argv) unless ARGV.empty? if ARGV.size > 1 ARGV[1..-1].each do |a| argv << Mal::Type.new(a) end end begin Mal.rep "(load-file \"#{ARGV[0]}\")" rescue e STDERR.puts e end exit end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/step9_try.cr ================================================ #! /usr/bin/env crystal run require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end 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) 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 ) else ast end end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" return Mal::Type.new list[1] when "quasiquote" ast = quasiquote list[1] next # TCO when "defmacro!" eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol mac = eval(list[2], env).dup mac.is_macro = true return Mal::Type.new env.set(a1.str, mac) when "try*" catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) return eval(list[1], env) unless catch_list.is_a? Mal::List catch_head = catch_list.first.unwrap return eval(list[1], env) unless catch_head.is_a? Mal::Symbol return eval(list[1], env) unless catch_head.str == "catch*" begin return eval(list[1], env) rescue e : Mal::RuntimeException new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) return Mal::Type.new eval(catch_list[2], new_env) rescue e new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) return Mal::Type.new eval(catch_list[2], new_env) end else evaluated_first = eval(list.first, env) f = evaluated_first.unwrap case f when Mal::Closure if evaluated_first.macro? ast = f.fn.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func if evaluated_first.macro? ast = f.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) Mal.rep "(def! not (fn* (a) (if a false true)))" Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" Mal.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)))))))" argv = Mal::List.new REPL_ENV.set("*ARGV*", Mal::Type.new argv) unless ARGV.empty? if ARGV.size > 1 ARGV[1..-1].each do |a| argv << Mal::Type.new(a) end end begin Mal.rep "(load-file \"#{ARGV[0]}\")" rescue e STDERR.puts e end exit end while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/stepA_mal.cr ================================================ #! /usr/bin/env crystal run require "colorize" require "readline" require "./reader" require "./printer" require "./types" require "./env" require "./core" require "./error" # Note: # Employed downcase names because Crystal prohibits uppercase names for methods module Mal extend self def func_of(env, binds, body) ->(args : Array(Mal::Type)) { new_env = Mal::Env.new(env, binds, args) eval(body, new_env) }.as(Mal::Func) end def read(str) read_str str end 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) 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 ) else ast end end def debug(ast) puts print(ast).colorize.red end def eval(ast, env) while true puts "EVAL: #{print(ast)}" if env.get("DEBUG-EVAL") val = ast.unwrap case val when Mal::Symbol e = env.get(val.str) eval_error "'#{val.str}' not found" unless e return e when Mal::Vector new_vec = val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } return Mal::Type.new new_vec when Mal::HashMap new_map = Mal::HashMap.new val.each { |k, v| new_map[k] = eval(v, env) } return Mal::Type.new new_map when Mal::List list = val return ast if list.empty? head = list.first.unwrap if head.is_a? Mal::Symbol a0sym = head.str else a0sym = "" end case a0sym when "def!" eval_error "wrong number of argument for 'def!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol return Mal::Type.new env.set(a1.str, eval(list[2], env)) when "let*" eval_error "wrong number of argument for 'def!'" unless list.size == 3 bindings = list[1].unwrap eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array eval_error "size of binding list must be even" unless bindings.size.even? new_env = Mal::Env.new env bindings.each_slice(2) do |binding| key, value = binding name = key.unwrap eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol new_env.set(name.str, eval(value, new_env)) end ast, env = list[2], new_env next # TCO when "do" if list.empty? ast = Mal::Type.new nil next end list[1..-2].map { |n| eval(n, env) } ast = list.last next # TCO when "if" ast = unless eval(list[1], env).unwrap list.size >= 4 ? list[3] : Mal::Type.new(nil) else list[2] end next # TCO when "fn*" params = list[1].unwrap unless params.is_a? Array eval_error "'fn*' parameters must be list or vector: #{params}" end return Mal::Type.new Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" return Mal::Type.new list[1] when "quasiquote" ast = quasiquote list[1] next # TCO when "defmacro!" eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 a1 = list[1].unwrap eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol mac = eval(list[2], env).dup mac.is_macro = true return Mal::Type.new env.set(a1.str, mac) when "try*" catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) return eval(list[1], env) unless catch_list.is_a? Mal::List catch_head = catch_list.first.unwrap return eval(list[1], env) unless catch_head.is_a? Mal::Symbol return eval(list[1], env) unless catch_head.str == "catch*" begin return eval(list[1], env) rescue e : Mal::RuntimeException new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) return Mal::Type.new eval(catch_list[2], new_env) rescue e new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) return Mal::Type.new eval(catch_list[2], new_env) end else evaluated_first = eval(list.first, env) f = evaluated_first.unwrap case f when Mal::Closure if evaluated_first.macro? ast = f.fn.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } ast = f.ast env = Mal::Env.new(f.env, f.params, args) next # TCO when Mal::Func if evaluated_first.macro? ast = f.call(list[1..-1]) next # TCO end args = list[1..-1].map { |n| eval(n, env).as(Mal::Type) } return f.call args else eval_error "expected function as the first argument: #{f}" end end else return Mal::Type.new val end end end def print(result) pr_str(result, true) end def rep(str) print(eval(read(str), REPL_ENV)) end end REPL_ENV = Mal::Env.new nil Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) Mal.rep "(def! not (fn* (a) (if a false true)))" Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" Mal.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)))))))" Mal.rep("(def! *host-language* \"crystal\")") argv = Mal::List.new REPL_ENV.set("*ARGV*", Mal::Type.new argv) unless ARGV.empty? if ARGV.size > 1 ARGV[1..-1].each do |a| argv << Mal::Type.new(a) end end begin Mal.rep "(load-file \"#{ARGV[0]}\")" rescue e STDERR.puts e end exit end Mal.rep("(println (str \"Mal [\" *host-language* \"]\"))") while line = Readline.readline("user> ", true) begin puts Mal.rep(line) rescue e : Mal::RuntimeException STDERR.puts "Error: #{pr_str(e.thrown, true)}" rescue e STDERR.puts "Error: #{e}" end end ================================================ FILE: impls/crystal/tests/step5_tco.mal ================================================ ;; Crystal: skipping non-TCO recursion ;; Reason: completes at 1,000,000 ================================================ FILE: impls/crystal/types.cr ================================================ require "./printer" module Mal class Type alias Func = (Array(Type) -> Type) # It is (now) probably possible to only store is_macro for Closures. property :is_macro, :meta def initialize(@val : ValueType) @is_macro = false @meta = nil.as(Type | Nil) end def initialize(other : Type) @val = other.unwrap @is_macro = other.is_macro @meta = other.meta end def unwrap @val end def macro? @is_macro end def to_s pr_str(self) end def dup Type.new(@val).tap do |t| t.is_macro = @is_macro t.meta = @meta end end def ==(other : Type) @val == other.unwrap end macro rel_op(*ops) {% for op in ops %} def {{op.id}}(other : Mal::Type) l, r = @val, other.unwrap {% for t in [Int64, String] %} if l.is_a?({{t}}) && r.is_a?({{t}}) return (l) {{op.id}} (r) end {% end %} if l.is_a?(Symbol) && r.is_a?(Symbol) return l.str {{op.id}} r.str end false end {% end %} end rel_op :<, :>, :<=, :>= end class Symbol property :str def initialize(@str : String) end def ==(other : Symbol) @str == other.str end end class List < Array(Type) end class Vector < Array(Type) end class HashMap < Hash(String, Type) end class Atom property :val def initialize(@val : Type) end def ==(rhs : Atom) @val == rhs.val end end class Closure property :ast, :params, :env, :fn def initialize(@ast : Type, @params : Array(Mal::Type) | List | Vector, @env : Env, @fn : Func) end end alias Type::ValueType = Nil | Bool | Int64 | String | Symbol | List | Vector | HashMap | Func | Closure | Atom alias Func = Type::Func end macro gen_type(t, *args) Mal::Type.new {{t.id}}.new({{*args}}) end class Array def to_mal(t = Mal::List) each_with_object(t.new) { |e, l| l << e } end end ================================================ FILE: impls/cs/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Deps for Mono-based languages (C#, VB.Net) RUN apt-get -y install tzdata mono-runtime mono-mcs mono-vbnc mono-devel ================================================ FILE: impls/cs/Makefile ================================================ ##################### DEBUG = SOURCES_BASE = readline.cs types.cs reader.cs printer.cs SOURCES_LISP = env.cs core.cs stepA_mal.cs SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) OTHER_SOURCES = getline.cs ##################### SRCS = step0_repl.cs step1_read_print.cs step2_eval.cs step3_env.cs \ step4_if_fn_do.cs step5_tco.cs step6_file.cs step7_quote.cs \ step8_macros.cs step9_try.cs stepA_mal.cs LIB_SRCS = $(filter-out step%,$(OTHER_SOURCES) $(SOURCES)) FLAGS = $(if $(strip $(DEBUG)),-debug+,) ##################### all: $(patsubst %.cs,%.exe,$(SRCS)) dist: mal.exe mal mal.exe: $(patsubst %.cs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) cp $< $@ # NOTE/WARNING: static linking triggers mono libraries LGPL # distribution requirements. # http://www.mono-project.com/archived/guiderunning_mono_applications/ mal: $(patsubst %.cs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) mal.dll mkbundle --static -o $@ $+ --deps mal.dll: $(LIB_SRCS) mcs $(FLAGS) -target:library $+ -out:$@ %.exe: %.cs mal.dll mcs $(FLAGS) -r:mal.dll $< clean: rm -f mal *.dll *.exe *.mdb ================================================ FILE: impls/cs/core.cs ================================================ using System; using System.IO; using System.Collections.Generic; using MalVal = Mal.types.MalVal; using MalConstant = Mal.types.MalConstant; using MalInt = Mal.types.MalInt; using MalSymbol = Mal.types.MalSymbol; using MalString = Mal.types.MalString; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalAtom = Mal.types.MalAtom; using MalFunc = Mal.types.MalFunc; namespace Mal { public class core { static MalConstant Nil = Mal.types.Nil; static MalConstant True = Mal.types.True; static MalConstant False = Mal.types.False; // Errors/Exceptions static public MalFunc mal_throw = new MalFunc( a => { throw new Mal.types.MalException(a[0]); }); // Scalar functions static MalFunc nil_Q = new MalFunc( a => a[0] == Nil ? True : False); static MalFunc true_Q = new MalFunc( a => a[0] == True ? True : False); static MalFunc false_Q = new MalFunc( a => a[0] == False ? True : False); static MalFunc symbol_Q = new MalFunc( a => a[0] is MalSymbol ? True : False); static MalFunc string_Q = new MalFunc( a => { if (a[0] is MalString) { var s = ((MalString)a[0]).getValue(); return (s.Length == 0 || s[0] != '\u029e') ? True : False; } else { return False; } } ); static MalFunc keyword = new MalFunc( a => { if (a[0] is MalString && ((MalString)a[0]).getValue()[0] == '\u029e') { return a[0]; } else { return new MalString("\u029e" + ((MalString)a[0]).getValue()); } } ); static MalFunc keyword_Q = new MalFunc( a => { if (a[0] is MalString) { var s = ((MalString)a[0]).getValue(); return (s.Length > 0 && s[0] == '\u029e') ? True : False; } else { return False; } } ); static MalFunc number_Q = new MalFunc( a => a[0] is MalInt ? True : False); static MalFunc function_Q = new MalFunc( a => a[0] is MalFunc && !((MalFunc)a[0]).isMacro() ? True : False); static MalFunc macro_Q = new MalFunc( a => a[0] is MalFunc && ((MalFunc)a[0]).isMacro() ? True : False); // Number functions static MalFunc time_ms = new MalFunc( a => new MalInt(DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond)); // String functions static public MalFunc pr_str = new MalFunc( a => new MalString(printer._pr_str_args(a, " ", true)) ); static public MalFunc str = new MalFunc( a => new MalString(printer._pr_str_args(a, "", false)) ); static public MalFunc prn = new MalFunc( a => { Console.WriteLine(printer._pr_str_args(a, " ", true)); return Nil; } ); static public MalFunc println = new MalFunc( a => { Console.WriteLine(printer._pr_str_args(a, " ", false)); return Nil; } ); static public MalFunc mal_readline = new MalFunc( a => { var line = readline.Readline(((MalString)a[0]).getValue()); if (line == null) { return types.Nil; } else { return new MalString(line); } } ); static public MalFunc read_string = new MalFunc( a => reader.read_str(((MalString)a[0]).getValue())); static public MalFunc slurp = new MalFunc( a => new MalString(File.ReadAllText( ((MalString)a[0]).getValue()))); // List/Vector functions static public MalFunc list_Q = new MalFunc( a => a[0].GetType() == typeof(MalList) ? True : False); static public MalFunc vector_Q = new MalFunc( a => a[0].GetType() == typeof(MalVector) ? True : False); // HashMap functions static public MalFunc hash_map_Q = new MalFunc( a => a[0].GetType() == typeof(MalHashMap) ? True : False); static MalFunc contains_Q = new MalFunc( a => { string key = ((MalString)a[1]).getValue(); var dict = ((MalHashMap)a[0]).getValue(); return dict.ContainsKey(key) ? True : False; }); static MalFunc assoc = new MalFunc( a => { var new_hm = ((MalHashMap)a[0]).copy(); return new_hm.assoc_BANG((MalList)a.slice(1)); }); static MalFunc dissoc = new MalFunc( a => { var new_hm = ((MalHashMap)a[0]).copy(); return new_hm.dissoc_BANG((MalList)a.slice(1)); }); static MalFunc get = new MalFunc( a => { string key = ((MalString)a[1]).getValue(); if (a[0] == Nil) { return Nil; } else { var dict = ((MalHashMap)a[0]).getValue(); return dict.ContainsKey(key) ? dict[key] : Nil; } }); static MalFunc keys = new MalFunc( a => { var dict = ((MalHashMap)a[0]).getValue(); MalList key_lst = new MalList(); foreach (var key in dict.Keys) { key_lst.conj_BANG(new MalString(key)); } return key_lst; }); static MalFunc vals = new MalFunc( a => { var dict = ((MalHashMap)a[0]).getValue(); MalList val_lst = new MalList(); foreach (var val in dict.Values) { val_lst.conj_BANG(val); } return val_lst; }); // Sequence functions static public MalFunc sequential_Q = new MalFunc( a => a[0] is MalList ? True : False); static MalFunc cons = new MalFunc( a => { var lst = new List(); lst.Add(a[0]); lst.AddRange(((MalList)a[1]).getValue()); return (MalVal)new MalList(lst); }); static MalFunc concat = new MalFunc( a => { if (a.size() == 0) { return new MalList(); } var lst = new List(); lst.AddRange(((MalList)a[0]).getValue()); for(int i=1; i { var idx = (int)((MalInt)a[1]).getValue(); if (idx < ((MalList)a[0]).size()) { return ((MalList)a[0])[idx]; } else { throw new Mal.types.MalException( "nth: index out of range"); } }); static MalFunc first = new MalFunc( a => a[0] == Nil ? Nil : ((MalList)a[0])[0]); static MalFunc rest = new MalFunc( a => a[0] == Nil ? new MalList() : ((MalList)a[0]).rest()); static MalFunc empty_Q = new MalFunc( a => ((MalList)a[0]).size() == 0 ? True : False); static MalFunc count = new MalFunc( a => { return (a[0] == Nil) ? new MalInt(0) :new MalInt(((MalList)a[0]).size()); }); static MalFunc conj = new MalFunc( a => { var src_lst = ((MalList)a[0]).getValue(); var new_lst = new List(); new_lst.AddRange(src_lst); if (a[0] is MalVector) { for(int i=1; i { if (a[0] == Nil) { return Nil; } else if (a[0] is MalVector) { return (((MalVector)a[0]).size() == 0) ? (MalVal)Nil : new MalList(((MalVector)a[0]).getValue()); } else if (a[0] is MalList) { return (((MalList)a[0]).size() == 0) ? Nil : a[0]; } else if (a[0] is MalString) { var s = ((MalString)a[0]).getValue(); if (s.Length == 0) { return Nil; } var chars_list = new List(); foreach (var c in s) { chars_list.Add(new MalString(c.ToString())); } return new MalList(chars_list); } return Nil; }); // General list related functions static MalFunc apply = new MalFunc( a => { var f = (MalFunc)a[0]; var lst = new List(); lst.AddRange(a.slice(1,a.size()-1).getValue()); lst.AddRange(((MalList)a[a.size()-1]).getValue()); return f.apply(new MalList(lst)); }); static MalFunc map = new MalFunc( a => { MalFunc f = (MalFunc) a[0]; var src_lst = ((MalList)a[1]).getValue(); var new_lst = new List(); for(int i=0; i a[0].getMeta()); static MalFunc with_meta = new MalFunc( a => ((MalVal)a[0]).copy().setMeta(a[1])); // Atom functions static MalFunc atom_Q = new MalFunc( a => a[0] is MalAtom ? True : False); static MalFunc deref = new MalFunc( a => ((MalAtom)a[0]).getValue()); static MalFunc reset_BANG = new MalFunc( a => ((MalAtom)a[0]).setValue(a[1])); static MalFunc swap_BANG = new MalFunc( a => { MalAtom atm = (MalAtom)a[0]; MalFunc f = (MalFunc)a[1]; var new_lst = new List(); new_lst.Add(atm.getValue()); new_lst.AddRange(((MalList)a.slice(2)).getValue()); return atm.setValue(f.apply(new MalList(new_lst))); }); static public Dictionary ns = new Dictionary { {"=", new MalFunc( a => Mal.types._equal_Q(a[0], a[1]) ? True : False)}, {"throw", mal_throw}, {"nil?", nil_Q}, {"true?", true_Q}, {"false?", false_Q}, {"symbol", new MalFunc(a => new MalSymbol((MalString)a[0]))}, {"symbol?", symbol_Q}, {"string?", string_Q}, {"keyword", keyword}, {"keyword?", keyword_Q}, {"number?", number_Q}, {"fn?", function_Q}, {"macro?", macro_Q}, {"pr-str", pr_str}, {"str", str}, {"prn", prn}, {"println", println}, {"readline", mal_readline}, {"read-string", read_string}, {"slurp", slurp}, {"<", new MalFunc(a => (MalInt)a[0] < (MalInt)a[1])}, {"<=", new MalFunc(a => (MalInt)a[0] <= (MalInt)a[1])}, {">", new MalFunc(a => (MalInt)a[0] > (MalInt)a[1])}, {">=", new MalFunc(a => (MalInt)a[0] >= (MalInt)a[1])}, {"+", new MalFunc(a => (MalInt)a[0] + (MalInt)a[1])}, {"-", new MalFunc(a => (MalInt)a[0] - (MalInt)a[1])}, {"*", new MalFunc(a => (MalInt)a[0] * (MalInt)a[1])}, {"/", new MalFunc(a => (MalInt)a[0] / (MalInt)a[1])}, {"time-ms", time_ms}, {"list", new MalFunc(a => new MalList(a.getValue()))}, {"list?", list_Q}, {"vector", new MalFunc(a => new MalVector(a.getValue()))}, {"vector?", vector_Q}, {"hash-map", new MalFunc(a => new MalHashMap(a))}, {"map?", hash_map_Q}, {"contains?", contains_Q}, {"assoc", assoc}, {"dissoc", dissoc}, {"get", get}, {"keys", keys}, {"vals", vals}, {"sequential?", sequential_Q}, {"cons", cons}, {"concat", concat}, {"vec", new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))}, {"nth", nth}, {"first", first}, {"rest", rest}, {"empty?", empty_Q}, {"count", count}, {"conj", conj}, {"seq", seq}, {"apply", apply}, {"map", map}, {"with-meta", with_meta}, {"meta", meta}, {"atom", new MalFunc(a => new MalAtom(a[0]))}, {"atom?", atom_Q}, {"deref", deref}, {"reset!", reset_BANG}, {"swap!", swap_BANG}, }; } } ================================================ FILE: impls/cs/env.cs ================================================ using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalList = Mal.types.MalList; namespace Mal { public class env { public class Env { Env outer = null; Dictionary data = new Dictionary(); public Env(Env outer) { this.outer = outer; } public Env(Env outer, MalList binds, MalList exprs) { this.outer = outer; for (int i=0; i /// Invoked when the user requests auto-completion using the tab character /// /// /// The result is null for no values found, an array with a single /// string, in that case the string should be the text to be inserted /// for example if the word at pos is "T", the result for a completion /// of "ToString" should be "oString", not "ToString". /// /// When there are multiple results, the result should be the full /// text /// public AutoCompleteHandler AutoCompleteEvent; static Handler [] handlers; public LineEditor (string name) : this (name, 10) { } public LineEditor (string name, int histsize) { handlers = new Handler [] { new Handler (ConsoleKey.Home, CmdHome), new Handler (ConsoleKey.End, CmdEnd), new Handler (ConsoleKey.LeftArrow, CmdLeft), new Handler (ConsoleKey.RightArrow, CmdRight), new Handler (ConsoleKey.UpArrow, CmdHistoryPrev), new Handler (ConsoleKey.DownArrow, CmdHistoryNext), new Handler (ConsoleKey.Enter, CmdDone), new Handler (ConsoleKey.Backspace, CmdBackspace), new Handler (ConsoleKey.Delete, CmdDeleteChar), new Handler (ConsoleKey.Tab, CmdTabOrComplete), // Emacs keys Handler.Control ('A', CmdHome), Handler.Control ('E', CmdEnd), Handler.Control ('B', CmdLeft), Handler.Control ('F', CmdRight), Handler.Control ('P', CmdHistoryPrev), Handler.Control ('N', CmdHistoryNext), Handler.Control ('K', CmdKillToEOF), Handler.Control ('Y', CmdYank), Handler.Control ('D', CmdDeleteChar), Handler.Control ('L', CmdRefresh), Handler.Control ('R', CmdReverseSearch), Handler.Control ('G', delegate {} ), Handler.Alt ('B', ConsoleKey.B, CmdBackwardWord), Handler.Alt ('F', ConsoleKey.F, CmdForwardWord), Handler.Alt ('D', ConsoleKey.D, CmdDeleteWord), Handler.Alt ((char) 8, ConsoleKey.Backspace, CmdDeleteBackword), // DEBUG //Handler.Control ('T', CmdDebug), // quote Handler.Control ('Q', delegate { HandleChar (Console.ReadKey (true).KeyChar); }) }; rendered_text = new StringBuilder (); text = new StringBuilder (); history = new History (name, histsize); //if (File.Exists ("log"))File.Delete ("log"); //log = File.CreateText ("log"); } void CmdDebug () { history.Dump (); Console.WriteLine (); Render (); } void Render () { Console.Write (shown_prompt); Console.Write (rendered_text); int max = System.Math.Max (rendered_text.Length + shown_prompt.Length, max_rendered); for (int i = rendered_text.Length + shown_prompt.Length; i < max_rendered; i++) Console.Write (' '); max_rendered = shown_prompt.Length + rendered_text.Length; // Write one more to ensure that we always wrap around properly if we are at the // end of a line. Console.Write (' '); UpdateHomeRow (max); } void UpdateHomeRow (int screenpos) { int lines = 1 + (screenpos / Console.WindowWidth); home_row = Console.CursorTop - (lines - 1); if (home_row < 0) home_row = 0; } void RenderFrom (int pos) { int rpos = TextToRenderPos (pos); int i; for (i = rpos; i < rendered_text.Length; i++) Console.Write (rendered_text [i]); if ((shown_prompt.Length + rendered_text.Length) > max_rendered) max_rendered = shown_prompt.Length + rendered_text.Length; else { int max_extra = max_rendered - shown_prompt.Length; for (; i < max_extra; i++) Console.Write (' '); } } void ComputeRendered () { rendered_text.Length = 0; for (int i = 0; i < text.Length; i++){ int c = (int) text [i]; if (c < 26){ if (c == '\t') rendered_text.Append (" "); else { rendered_text.Append ('^'); rendered_text.Append ((char) (c + (int) 'A' - 1)); } } else rendered_text.Append ((char)c); } } int TextToRenderPos (int pos) { int p = 0; for (int i = 0; i < pos; i++){ int c; c = (int) text [i]; if (c < 26){ if (c == 9) p += 4; else p += 2; } else p++; } return p; } int TextToScreenPos (int pos) { return shown_prompt.Length + TextToRenderPos (pos); } string Prompt { get { return prompt; } set { prompt = value; } } int LineCount { get { return (shown_prompt.Length + rendered_text.Length)/Console.WindowWidth; } } void ForceCursor (int newpos) { cursor = newpos; int actual_pos = shown_prompt.Length + TextToRenderPos (cursor); int row = home_row + (actual_pos/Console.WindowWidth); int col = actual_pos % Console.WindowWidth; if (row >= Console.BufferHeight) row = Console.BufferHeight-1; Console.SetCursorPosition (col, row); //log.WriteLine ("Going to cursor={0} row={1} col={2} actual={3} prompt={4} ttr={5} old={6}", newpos, row, col, actual_pos, prompt.Length, TextToRenderPos (cursor), cursor); //log.Flush (); } void UpdateCursor (int newpos) { if (cursor == newpos) return; ForceCursor (newpos); } void InsertChar (char c) { int prev_lines = LineCount; text = text.Insert (cursor, c); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); ForceCursor (++cursor); } else { RenderFrom (cursor); ForceCursor (++cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } // // Commands // void CmdDone () { done = true; } void CmdTabOrComplete () { bool complete = false; if (AutoCompleteEvent != null){ if (TabAtStartCompletes) complete = true; else { for (int i = 0; i < cursor; i++){ if (!Char.IsWhiteSpace (text [i])){ complete = true; break; } } } if (complete){ Completion completion = AutoCompleteEvent (text.ToString (), cursor); string [] completions = completion.Result; if (completions == null) return; int ncompletions = completions.Length; if (ncompletions == 0) return; if (completions.Length == 1){ InsertTextAtCursor (completions [0]); } else { int last = -1; for (int p = 0; p < completions [0].Length; p++){ char c = completions [0][p]; for (int i = 1; i < ncompletions; i++){ if (completions [i].Length < p) goto mismatch; if (completions [i][p] != c){ goto mismatch; } } last = p; } mismatch: if (last != -1){ InsertTextAtCursor (completions [0].Substring (0, last+1)); } Console.WriteLine (); foreach (string s in completions){ Console.Write (completion.Prefix); Console.Write (s); Console.Write (' '); } Console.WriteLine (); Render (); ForceCursor (cursor); } } else HandleChar ('\t'); } else HandleChar ('t'); } void CmdHome () { UpdateCursor (0); } void CmdEnd () { UpdateCursor (text.Length); } void CmdLeft () { if (cursor == 0) return; UpdateCursor (cursor-1); } void CmdBackwardWord () { int p = WordBackward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdForwardWord () { int p = WordForward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdRight () { if (cursor == text.Length) return; UpdateCursor (cursor+1); } void RenderAfter (int p) { ForceCursor (p); RenderFrom (p); ForceCursor (cursor); } void CmdBackspace () { if (cursor == 0) return; text.Remove (--cursor, 1); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteChar () { // If there is no input, this behaves like EOF if (text.Length == 0){ done = true; text = null; Console.WriteLine (); return; } if (cursor == text.Length) return; text.Remove (cursor, 1); ComputeRendered (); RenderAfter (cursor); } int WordForward (int p) { if (p >= text.Length) return -1; int i = p; if (Char.IsPunctuation (text [p]) || Char.IsSymbol (text [p]) || Char.IsWhiteSpace (text[p])){ for (; i < text.Length; i++){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } else { for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } if (i != p) return i; return -1; } int WordBackward (int p) { if (p == 0) return -1; int i = p-1; if (i == 0) return 0; if (Char.IsPunctuation (text [i]) || Char.IsSymbol (text [i]) || Char.IsWhiteSpace (text[i])){ for (; i >= 0; i--){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text[i])) break; } } else { for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text [i])) break; } } i++; if (i != p) return i; return -1; } void CmdDeleteWord () { int pos = WordForward (cursor); if (pos == -1) return; string k = text.ToString (cursor, pos-cursor); if (last_handler == CmdDeleteWord) kill_buffer = kill_buffer + k; else kill_buffer = k; text.Remove (cursor, pos-cursor); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteBackword () { int pos = WordBackward (cursor); if (pos == -1) return; string k = text.ToString (pos, cursor-pos); if (last_handler == CmdDeleteBackword) kill_buffer = k + kill_buffer; else kill_buffer = k; text.Remove (pos, cursor-pos); ComputeRendered (); RenderAfter (pos); } // // Adds the current line to the history if needed // void HistoryUpdateLine () { history.Update (text.ToString ()); } void CmdHistoryPrev () { if (!history.PreviousAvailable ()) return; HistoryUpdateLine (); SetText (history.Previous ()); } void CmdHistoryNext () { if (!history.NextAvailable()) return; history.Update (text.ToString ()); SetText (history.Next ()); } void CmdKillToEOF () { kill_buffer = text.ToString (cursor, text.Length-cursor); text.Length = cursor; ComputeRendered (); RenderAfter (cursor); } void CmdYank () { InsertTextAtCursor (kill_buffer); } void InsertTextAtCursor (string str) { int prev_lines = LineCount; text.Insert (cursor, str); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); cursor += str.Length; ForceCursor (cursor); } else { RenderFrom (cursor); cursor += str.Length; ForceCursor (cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } void SetSearchPrompt (string s) { SetPrompt ("(reverse-i-search)`" + s + "': "); } void ReverseSearch () { int p; if (cursor == text.Length){ // The cursor is at the end of the string p = text.ToString ().LastIndexOf (search); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } else { // The cursor is somewhere in the middle of the string int start = (cursor == match_at) ? cursor - 1 : cursor; if (start != -1){ p = text.ToString ().LastIndexOf (search, start); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } } // Need to search backwards in history HistoryUpdateLine (); string s = history.SearchBackward (search); if (s != null){ match_at = -1; SetText (s); ReverseSearch (); } } void CmdReverseSearch () { if (searching == 0){ match_at = -1; last_search = search; searching = -1; search = ""; SetSearchPrompt (""); } else { if (search == ""){ if (last_search != "" && last_search != null){ search = last_search; SetSearchPrompt (search); ReverseSearch (); } return; } ReverseSearch (); } } void SearchAppend (char c) { search = search + c; SetSearchPrompt (search); // // If the new typed data still matches the current text, stay here // if (cursor < text.Length){ string r = text.ToString (cursor, text.Length - cursor); if (r.StartsWith (search)) return; } ReverseSearch (); } void CmdRefresh () { Console.Clear (); max_rendered = 0; Render (); ForceCursor (cursor); } void InterruptEdit (object sender, ConsoleCancelEventArgs a) { // Do not abort our program: a.Cancel = true; // Interrupt the editor edit_thread.Abort(); } void HandleChar (char c) { if (searching != 0) SearchAppend (c); else InsertChar (c); } void EditLoop () { ConsoleKeyInfo cki; while (!done){ ConsoleModifiers mod; cki = Console.ReadKey (true); if (cki.Key == ConsoleKey.Escape){ cki = Console.ReadKey (true); mod = ConsoleModifiers.Alt; } else mod = cki.Modifiers; bool handled = false; foreach (Handler handler in handlers){ ConsoleKeyInfo t = handler.CKI; if (t.Key == cki.Key && t.Modifiers == mod){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } else if (t.KeyChar == cki.KeyChar && t.Key == ConsoleKey.Zoom){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } } if (handled){ if (searching != 0){ if (last_handler != CmdReverseSearch){ searching = 0; SetPrompt (prompt); } } continue; } if (cki.KeyChar != (char) 0) HandleChar (cki.KeyChar); } } void InitText (string initial) { text = new StringBuilder (initial); ComputeRendered (); cursor = text.Length; Render (); ForceCursor (cursor); } void SetText (string newtext) { Console.SetCursorPosition (0, home_row); InitText (newtext); } void SetPrompt (string newprompt) { shown_prompt = newprompt; Console.SetCursorPosition (0, home_row); Render (); ForceCursor (cursor); } public string Edit (string prompt, string initial) { edit_thread = Thread.CurrentThread; searching = 0; Console.CancelKeyPress += InterruptEdit; done = false; history.CursorToEnd (); max_rendered = 0; Prompt = prompt; shown_prompt = prompt; InitText (initial); history.Append (initial); do { try { EditLoop (); } catch (ThreadAbortException){ searching = 0; Thread.ResetAbort (); Console.WriteLine (); SetPrompt (prompt); SetText (""); } } while (!done); Console.WriteLine (); Console.CancelKeyPress -= InterruptEdit; if (text == null){ history.Close (); return null; } string result = text.ToString (); if (result != "") history.Accept (result); else history.RemoveLast (); return result; } public void SaveHistory () { if (history != null) { history.Close (); } } public bool TabAtStartCompletes { get; set; } // // Emulates the bash-like behavior, where edits done to the // history are recorded // class History { string [] history; int head, tail; int cursor, count; string histfile; public History (string app, int size) { if (size < 1) throw new ArgumentException ("size"); if (app != null){ string dir = Environment.GetFolderPath (Environment.SpecialFolder.Personal); //Console.WriteLine (dir); // if (!Directory.Exists (dir)){ // try { // Directory.CreateDirectory (dir); // } catch { // app = null; // } // } // if (app != null) // histfile = Path.Combine (dir, app) + ".history"; histfile = Path.Combine (dir, ".mal-history"); } history = new string [size]; head = tail = cursor = 0; if (File.Exists (histfile)){ using (StreamReader sr = File.OpenText (histfile)){ string line; while ((line = sr.ReadLine ()) != null){ if (line != "") Append (line); } } } } public void Close () { if (histfile == null) return; try { using (StreamWriter sw = File.CreateText (histfile)){ int start = (count == history.Length) ? head : tail; for (int i = start; i < start+count; i++){ int p = i % history.Length; sw.WriteLine (history [p]); } } } catch { // ignore } } // // Appends a value to the history // public void Append (string s) { //Console.WriteLine ("APPENDING {0} head={1} tail={2}", s, head, tail); history [head] = s; head = (head+1) % history.Length; if (head == tail) tail = (tail+1 % history.Length); if (count != history.Length) count++; //Console.WriteLine ("DONE: head={1} tail={2}", s, head, tail); } // // Updates the current cursor location with the string, // to support editing of history items. For the current // line to participate, an Append must be done before. // public void Update (string s) { history [cursor] = s; } public void RemoveLast () { head = head-1; if (head < 0) head = history.Length-1; } public void Accept (string s) { int t = head-1; if (t < 0) t = history.Length-1; history [t] = s; } public bool PreviousAvailable () { //Console.WriteLine ("h={0} t={1} cursor={2}", head, tail, cursor); if (count == 0) return false; int next = cursor-1; if (next < 0) next = count-1; if (next == head) return false; return true; } public bool NextAvailable () { if (count == 0) return false; int next = (cursor + 1) % history.Length; if (next == head) return false; return true; } // // Returns: a string with the previous line contents, or // nul if there is no data in the history to move to. // public string Previous () { if (!PreviousAvailable ()) return null; cursor--; if (cursor < 0) cursor = history.Length - 1; return history [cursor]; } public string Next () { if (!NextAvailable ()) return null; cursor = (cursor + 1) % history.Length; return history [cursor]; } public void CursorToEnd () { if (head == tail) return; cursor = head; } public void Dump () { Console.WriteLine ("Head={0} Tail={1} Cursor={2} count={3}", head, tail, cursor, count); for (int i = 0; i < history.Length;i++){ Console.WriteLine (" {0} {1}: {2}", i == cursor ? "==>" : " ", i, history[i]); } //log.Flush (); } public string SearchBackward (string term) { for (int i = 0; i < count; i++){ int slot = cursor-i-1; if (slot < 0) slot = history.Length+slot; if (slot >= history.Length) slot = 0; if (history [slot] != null && history [slot].IndexOf (term) != -1){ cursor = slot; return history [slot]; } } return null; } } } #if DEMO class Demo { static void Main () { LineEditor le = new LineEditor ("foo"); string s; while ((s = le.Edit ("shell> ", "")) != null){ Console.WriteLine ("----> [{0}]", s); } } } #endif } ================================================ FILE: impls/cs/interop.cs ================================================ using System; using System.CodeDom.Compiler; using System.Collections.Generic; using System.Linq; using System.Text; using Microsoft.CSharp; public static class EvalProvider { public static Func CreateEvalMethod(string code, string[] usingStatements = null, string[] assemblies = null) { Type returnType = typeof(TResult); Type inputType = typeof(T); var includeUsings = new HashSet(new[] { "System" }); includeUsings.Add(returnType.Namespace); includeUsings.Add(inputType.Namespace); if (usingStatements != null) foreach (var usingStatement in usingStatements) includeUsings.Add(usingStatement); using (CSharpCodeProvider compiler = new CSharpCodeProvider()) { var name = "F" + Guid.NewGuid().ToString().Replace("-", string.Empty); var includeAssemblies = new HashSet(new[] { "system.dll" }); if (assemblies != null) foreach (var assembly in assemblies) includeAssemblies.Add(assembly); var parameters = new CompilerParameters(includeAssemblies.ToArray()) { GenerateInMemory = true }; string source = string.Format(@" {0} namespace {1} {{ public static class EvalClass {{ public static {2} Eval({3} arg) {{ {4} }} }} }}", GetUsing(includeUsings), name, returnType.Name, inputType.Name, code); var compilerResult = compiler.CompileAssemblyFromSource(parameters, source); var compiledAssembly = compilerResult.CompiledAssembly; var type = compiledAssembly.GetType(string.Format("{0}.EvalClass", name)); var method = type.GetMethod("Eval"); return (Func)Delegate.CreateDelegate(typeof(Func), method); } } private static string GetUsing(HashSet usingStatements) { StringBuilder result = new StringBuilder(); foreach (string usingStatement in usingStatements) { result.AppendLine(string.Format("using {0};", usingStatement)); } return result.ToString(); } } ================================================ FILE: impls/cs/printer.cs ================================================ using System; using System.Collections.Generic; using System.Text.RegularExpressions; using Mal; using MalVal = Mal.types.MalVal; using MalList = Mal.types.MalList; namespace Mal { public class printer { public static string join(List value, string delim, bool print_readably) { List strs = new List(); foreach (MalVal mv in value) { strs.Add(mv.ToString(print_readably)); } return String.Join(delim, strs.ToArray()); } public static string join(Dictionary value, string delim, bool print_readably) { List strs = new List(); foreach (KeyValuePair entry in value) { if (entry.Key.Length > 0 && entry.Key[0] == '\u029e') { strs.Add(":" + entry.Key.Substring(1)); } else if (print_readably) { strs.Add("\"" + entry.Key.ToString() + "\""); } else { strs.Add(entry.Key.ToString()); } strs.Add(entry.Value.ToString(print_readably)); } return String.Join(delim, strs.ToArray()); } public static string _pr_str(MalVal mv, bool print_readably) { return mv.ToString(print_readably); } public static string _pr_str_args(MalList args, String sep, bool print_readably) { return join(args.getValue(), sep, print_readably); } public static string escapeString(string str) { return Regex.Escape(str); } } } ================================================ FILE: impls/cs/reader.cs ================================================ using System; using System.Collections; using System.Collections.Generic; using System.Text.RegularExpressions; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalThrowable = Mal.types.MalThrowable; using MalContinue = Mal.types.MalContinue; namespace Mal { public class reader { public class ParseError : MalThrowable { public ParseError(string msg) : base(msg) { } } public class Reader { List tokens; int position; public Reader(List t) { tokens = t; position = 0; } public string peek() { if (position >= tokens.Count) { return null; } else { return tokens[position]; } } public string next() { return tokens[position++]; } } public static List tokenize(string str) { List tokens = new List(); string pattern = @"[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""?|;.*|[^\s \[\]{}()'""`~@,;]*)"; Regex regex = new Regex(pattern); foreach (Match match in regex.Matches(str)) { string token = match.Groups[1].Value; if ((token != null) && !(token == "") && !(token[0] == ';')) { //Console.WriteLine("match: ^" + match.Groups[1] + "$"); tokens.Add(token); } } return tokens; } public static MalVal read_atom(Reader rdr) { string token = rdr.next(); string pattern = @"(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|(^""(?:[\\].|[^\\""])*""$)|(^"".*$)|:(.*)|(^[^""]*$)"; Regex regex = new Regex(pattern); Match match = regex.Match(token); //Console.WriteLine("token: ^" + token + "$"); if (!match.Success) { throw new ParseError("unrecognized token '" + token + "'"); } if (match.Groups[1].Value != String.Empty) { return new Mal.types.MalInt(int.Parse(match.Groups[1].Value)); } else if (match.Groups[3].Value != String.Empty) { return Mal.types.Nil; } else if (match.Groups[4].Value != String.Empty) { return Mal.types.True; } else if (match.Groups[5].Value != String.Empty) { return Mal.types.False; } else if (match.Groups[6].Value != String.Empty) { string str = match.Groups[6].Value; str = str.Substring(1, str.Length-2) .Replace("\\\\", "\u029e") .Replace("\\\"", "\"") .Replace("\\n", "\n") .Replace("\u029e", "\\"); return new Mal.types.MalString(str); } else if (match.Groups[7].Value != String.Empty) { throw new ParseError("expected '\"', got EOF"); } else if (match.Groups[8].Value != String.Empty) { return new Mal.types.MalString("\u029e" + match.Groups[8].Value); } else if (match.Groups[9].Value != String.Empty) { return new Mal.types.MalSymbol(match.Groups[9].Value); } else { throw new ParseError("unrecognized '" + match.Groups[0] + "'"); } } public static MalVal read_list(Reader rdr, MalList lst, char start, char end) { string token = rdr.next(); if (token[0] != start) { throw new ParseError("expected '" + start + "'"); } while ((token = rdr.peek()) != null && token[0] != end) { lst.conj_BANG(read_form(rdr)); } if (token == null) { throw new ParseError("expected '" + end + "', got EOF"); } rdr.next(); return lst; } public static MalVal read_hash_map(Reader rdr) { MalList lst = (MalList)read_list(rdr, new MalList(), '{', '}'); return new MalHashMap(lst); } public static MalVal read_form(Reader rdr) { string token = rdr.peek(); if (token == null) { throw new MalContinue(); } MalVal form = null; switch (token) { case "'": rdr.next(); return new MalList(new MalSymbol("quote"), read_form(rdr)); case "`": rdr.next(); return new MalList(new MalSymbol("quasiquote"), read_form(rdr)); case "~": rdr.next(); return new MalList(new MalSymbol("unquote"), read_form(rdr)); case "~@": rdr.next(); return new MalList(new MalSymbol("splice-unquote"), read_form(rdr)); case "^": rdr.next(); MalVal meta = read_form(rdr); return new MalList(new MalSymbol("with-meta"), read_form(rdr), meta); case "@": rdr.next(); return new MalList(new MalSymbol("deref"), read_form(rdr)); case "(": form = read_list(rdr, new MalList(), '(' , ')'); break; case ")": throw new ParseError("unexpected ')'"); case "[": form = read_list(rdr, new MalVector(), '[' , ']'); break; case "]": throw new ParseError("unexpected ']'"); case "{": form = read_hash_map(rdr); break; case "}": throw new ParseError("unexpected '}'"); default: form = read_atom(rdr); break; } return form; } public static MalVal read_str(string str) { return read_form(new Reader(tokenize(str))); } } } ================================================ FILE: impls/cs/readline.cs ================================================ using System; using Mono.Terminal; // LineEditor (getline.cs) namespace Mal { public class readline { public enum Mode { Terminal, Raw }; public static Mode mode = Mode.Terminal; static LineEditor lineedit = null; public static string Readline(string prompt) { if (mode == Mode.Terminal) { if (lineedit == null) { lineedit = new LineEditor("Mal"); } return lineedit.Edit(prompt, ""); } else { Console.Write(prompt); Console.Out.Flush(); return Console.ReadLine(); } } } } ================================================ FILE: impls/cs/run ================================================ #!/usr/bin/env bash exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" ================================================ FILE: impls/cs/step0_repl.cs ================================================ using System; using System.IO; using Mal; namespace Mal { class step0_repl { // read static string READ(string str) { return str; } // eval static string EVAL(string ast, string env) { return ast; } // print static string PRINT(string exp) { return exp; } // repl static string RE(string env, string str) { return EVAL(READ(str), env); } static void Main(string[] args) { if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } Console.WriteLine(PRINT(RE(null, line))); } } } } ================================================ FILE: impls/cs/step1_read_print.cs ================================================ using System; using System.IO; using Mal; using MalVal = Mal.types.MalVal; namespace Mal { class step1_read_print { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal ast, string env) { return ast; } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { Func RE = (string str) => EVAL(READ(str), ""); if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step2_eval.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; namespace Mal { class step2_eval { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal orig_ast, Dictionary env) { MalVal a0; // Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { MalSymbol sym = (MalSymbol)orig_ast; return (MalVal)env[sym.getName()]; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; if (!(a0 is MalSymbol)) { throw new Mal.types.MalError("attempt to apply on non-symbol '" + Mal.printer._pr_str(a0,true) + "'"); } MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } return f.apply(arguments); } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Dictionary { {"+", new MalFunc(a => (MalInt)a[0] + (MalInt)a[1]) }, {"-", new MalFunc(a => (MalInt)a[0] - (MalInt)a[1]) }, {"*", new MalFunc(a => (MalInt)a[0] * (MalInt)a[1]) }, {"/", new MalFunc(a => (MalInt)a[0] / (MalInt)a[1]) }, }; Func RE = (string str) => EVAL(READ(str), repl_env); if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step3_env.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step3_env { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; if (!(a0 is MalSymbol)) { throw new Mal.types.MalError("attempt to apply on non-symbol '" + Mal.printer._pr_str(a0,true) + "'"); } switch (((MalSymbol)a0).getName()) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } return EVAL(a2, let_env); default: MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } return f.apply(arguments); } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); repl_env.set(new MalSymbol("+"), new MalFunc( a => (MalInt)a[0] + (MalInt)a[1]) ); repl_env.set(new MalSymbol("-"), new MalFunc( a => (MalInt)a[0] - (MalInt)a[1]) ); repl_env.set(new MalSymbol("*"), new MalFunc( a => (MalInt)a[0] * (MalInt)a[1]) ); repl_env.set(new MalSymbol("/"), new MalFunc( a => (MalInt)a[0] / (MalInt)a[1]) ); if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step4_if_fn_do.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step4_if_fn_do { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } return EVAL(a2, let_env); case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } return EVAL(ast[ast.size()-1], env); case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { return EVAL(ast[3], env); } else { return Mal.types.Nil; } } else { // eval true slot form a2 = ast[2]; return EVAL(a2, env); } case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc( args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } return f.apply(arguments); } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step5_tco.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step5_tco { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step6_file.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalString = Mal.types.MalString; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step6_file { // read static MalVal READ(string str) { return reader.read_str(str); } // eval static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; fileIdx = 1; } MalList _argv = new MalList(); for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step7_quote.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalString = Mal.types.MalString; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step7_quote { // read static MalVal READ(string str) { return reader.read_str(str); } // eval 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) { // 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 { return ast; } } static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast[1]; case "quasiquote": orig_ast = quasiquote(ast[1]); break; case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; fileIdx = 1; } MalList _argv = new MalList(); for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step8_macros.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalString = Mal.types.MalString; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step8_macros { // read static MalVal READ(string str) { return reader.read_str(str); } // eval 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) { // 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 { return ast; } } static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast[1]; case "quasiquote": orig_ast = quasiquote(ast[1]); break; case "defmacro!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); res = res.copy(); ((MalFunc)res).setMacro(); env.set(((MalSymbol)a1), res); return res; case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); break; } MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; fileIdx = 1; } MalList _argv = new MalList(); for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/step9_try.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalString = Mal.types.MalString; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class step9_try { // read static MalVal READ(string str) { return reader.read_str(str); } // eval 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) { // 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 { return ast; } } static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast[1]; case "quasiquote": orig_ast = quasiquote(ast[1]); break; case "defmacro!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); res = res.copy(); ((MalFunc)res).setMacro(); env.set(((MalSymbol)a1), res); return res; case "try*": try { return EVAL(ast[1], env); } catch (Exception e) { if (ast.size() > 2) { MalVal exc; a2 = ast[2]; MalVal a20 = ((MalList)a2)[0]; if (((MalSymbol)a20).getName() == "catch*") { if (e is Mal.types.MalException) { exc = ((Mal.types.MalException)e).getValue(); } else { exc = new MalString(e.Message); } return EVAL(((MalList)a2)[2], new Env(env, ((MalList)a2).slice(1,2), new MalList(exc))); } } throw e; } case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); break; } MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; fileIdx = 1; } MalList _argv = new MalList(); for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))"); RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Mal.types.MalException e) { Console.WriteLine("Error: " + printer._pr_str(e.getValue(), false)); continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/stepA_mal.cs ================================================ using System; using System.IO; using System.Collections; using System.Collections.Generic; using Mal; using MalVal = Mal.types.MalVal; using MalString = Mal.types.MalString; using MalSymbol = Mal.types.MalSymbol; using MalInt = Mal.types.MalInt; using MalList = Mal.types.MalList; using MalVector = Mal.types.MalVector; using MalHashMap = Mal.types.MalHashMap; using MalFunc = Mal.types.MalFunc; using Env = Mal.env.Env; namespace Mal { class stepA_mal { // read static MalVal READ(string str) { return reader.read_str(str); } // eval 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) { // 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 { return ast; } } static MalVal EVAL(MalVal orig_ast, Env env) { MalVal a0, a1, a2, res; while (true) { MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != Mal.types.Nil && dbgeval != Mal.types.False) Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast is MalSymbol) { string key = ((MalSymbol)orig_ast).getName(); res = env.get(key); if (res == null) throw new Mal.types.MalException("'" + key + "' not found"); return res; } else if (orig_ast is MalVector) { MalVector old_lst = (MalVector)orig_ast; MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); } else if (!(orig_ast is MalList)) { return orig_ast; } // apply list MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); env.set((MalSymbol)a1, res); return res; case "let*": a1 = ast[1]; a2 = ast[2]; MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1)[i]; val = ((MalList)a1)[i+1]; let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast[1]; case "quasiquote": orig_ast = quasiquote(ast[1]); break; case "defmacro!": a1 = ast[1]; a2 = ast[2]; res = EVAL(a2, env); res = res.copy(); ((MalFunc)res).setMacro(); env.set(((MalSymbol)a1), res); return res; case "try*": try { return EVAL(ast[1], env); } catch (Exception e) { if (ast.size() > 2) { MalVal exc; a2 = ast[2]; MalVal a20 = ((MalList)a2)[0]; if (((MalSymbol)a20).getName() == "catch*") { if (e is Mal.types.MalException) { exc = ((Mal.types.MalException)e).getValue(); } else { exc = new MalString(e.Message); } return EVAL(((MalList)a2)[2], new Env(env, ((MalList)a2).slice(1,2), new MalList(exc))); } } throw e; } case "do": foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { EVAL(mv, env); } orig_ast = ast[ast.size()-1]; break; case "if": a1 = ast[1]; MalVal cond = EVAL(a1, env); if (cond == Mal.types.Nil || cond == Mal.types.False) { // eval false slot form if (ast.size() > 3) { orig_ast = ast[3]; } else { return Mal.types.Nil; } } else { // eval true slot form orig_ast = ast[2]; } break; case "fn*": MalList a1f = (MalList)ast[1]; MalVal a2f = ast[2]; Env cur_env = env; return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: MalFunc f = (MalFunc)EVAL(ast[0], env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); break; } MalList arguments = new MalList(); foreach (MalVal mv in ast.rest().getValue()) { arguments.conj_BANG(EVAL(mv, env)); } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; env = f.genEnv(arguments); } else { return f.apply(arguments); } break; } } } // print static string PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl static void Main(string[] args) { var repl_env = new Mal.env.Env(null); Func RE = (string str) => EVAL(READ(str), repl_env); // core.cs: defined using C# foreach (var entry in core.ns) { repl_env.set(new MalSymbol(entry.Key), entry.Value); } repl_env.set(new MalSymbol("eval"), new MalFunc( a => EVAL(a[0], repl_env))); int fileIdx = 0; if (args.Length > 0 && args[0] == "--raw") { Mal.readline.mode = Mal.readline.Mode.Raw; fileIdx = 1; } MalList _argv = new MalList(); for (int i=fileIdx+1; i < args.Length; i++) { _argv.conj_BANG(new MalString(args[i])); } repl_env.set(new MalSymbol("*ARGV*"), _argv); // core.mal: defined using the language itself RE("(def! *host-language* \"c#\")"); RE("(def! not (fn* (a) (if a false true)))"); RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (args.Length > fileIdx) { RE("(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop RE("(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { string line; try { line = Mal.readline.Readline("user> "); if (line == null) { break; } if (line == "") { continue; } } catch (IOException e) { Console.WriteLine("IOException: " + e.Message); break; } try { Console.WriteLine(PRINT(RE(line))); } catch (Mal.types.MalContinue) { continue; } catch (Mal.types.MalException e) { Console.WriteLine("Error: " + printer._pr_str(e.getValue(), false)); continue; } catch (Exception e) { Console.WriteLine("Error: " + e.Message); Console.WriteLine(e.StackTrace); continue; } } } } } ================================================ FILE: impls/cs/tests/step5_tco.mal ================================================ ;; C#: skipping non-TCO recursion ;; Reason: unrecoverable stack overflow at 10,000 ================================================ FILE: impls/cs/types.cs ================================================ using System; using System.Collections.Generic; using Mal; namespace Mal { public class types { // // Exceptions/Errors // public class MalThrowable : Exception { public MalThrowable() : base() { } public MalThrowable(string msg) : base(msg) { } } public class MalError : MalThrowable { public MalError(string msg) :base(msg) { } } public class MalContinue : MalThrowable { } // Thrown by throw function public class MalException : MalThrowable { MalVal value; //string Message; public MalException(MalVal value) { this.value = value; } public MalException(string value) :base(value) { this.value = new MalString(value); } public MalVal getValue() { return value; } } // // General functions // public static bool _equal_Q(MalVal a, MalVal b) { Type ota = a.GetType(), otb = b.GetType(); if (!((ota == otb) || (a is MalList && b is MalList))) { return false; } else { if (a is MalInt) { return ((MalInt)a).getValue() == ((MalInt)b).getValue(); } else if (a is MalSymbol) { return ((MalSymbol)a).getName() == ((MalSymbol)b).getName(); } else if (a is MalString) { return ((MalString)a).getValue() == ((MalString)b).getValue(); } else if (a is MalList) { if (((MalList)a).size() != ((MalList)b).size()) { return false; } for (int i=0; i<((MalList)a).size(); i++) { if (! _equal_Q(((MalList)a)[i], ((MalList)b)[i])) { return false; } } return true; } else if (a is MalHashMap) { var akeys = ((MalHashMap)a).getValue().Keys; var bkeys = ((MalHashMap)b).getValue().Keys; if (akeys.Count != bkeys.Count) { return false; } foreach (var k in akeys) { if (!_equal_Q(((MalHashMap)a).getValue()[k], ((MalHashMap)b).getValue()[k])) { return false; } } return true; } else { return a == b; } } } public abstract class MalVal { MalVal meta = Nil; public virtual MalVal copy() { return (MalVal)this.MemberwiseClone(); } // Default is just to call regular toString() public virtual string ToString(bool print_readably) { return this.ToString(); } public MalVal getMeta() { return meta; } public MalVal setMeta(MalVal m) { meta = m; return this; } public virtual bool list_Q() { return false; } } public class MalConstant : MalVal { string value; public MalConstant(string name) { value = name; } public new MalConstant copy() { return this; } public override string ToString() { return value; } public override string ToString(bool print_readably) { return value; } } static public MalConstant Nil = new MalConstant("nil"); static public MalConstant True = new MalConstant("true"); static public MalConstant False = new MalConstant("false"); public class MalInt : MalVal { Int64 value; public MalInt(Int64 v) { value = v; } public new MalInt copy() { return this; } public Int64 getValue() { return value; } public override string ToString() { return value.ToString(); } public override string ToString(bool print_readably) { return value.ToString(); } public static MalConstant operator <(MalInt a, MalInt b) { return a.getValue() < b.getValue() ? True : False; } public static MalConstant operator <=(MalInt a, MalInt b) { return a.getValue() <= b.getValue() ? True : False; } public static MalConstant operator >(MalInt a, MalInt b) { return a.getValue() > b.getValue() ? True : False; } public static MalConstant operator >=(MalInt a, MalInt b) { return a.getValue() >= b.getValue() ? True : False; } public static MalInt operator +(MalInt a, MalInt b) { return new MalInt(a.getValue() + b.getValue()); } public static MalInt operator -(MalInt a, MalInt b) { return new MalInt(a.getValue() - b.getValue()); } public static MalInt operator *(MalInt a, MalInt b) { return new MalInt(a.getValue() * b.getValue()); } public static MalInt operator /(MalInt a, MalInt b) { return new MalInt(a.getValue() / b.getValue()); } } public class MalSymbol : MalVal { string value; public MalSymbol(string v) { value = v; } public MalSymbol(MalString v) { value = v.getValue(); } public new MalSymbol copy() { return this; } public string getName() { return value; } public override string ToString() { return value; } public override string ToString(bool print_readably) { return value; } } public class MalString : MalVal { string value; public MalString(string v) { value = v; } public new MalString copy() { return this; } public string getValue() { return value; } public override string ToString() { return "\"" + value + "\""; } public override string ToString(bool print_readably) { if (value.Length > 0 && value[0] == '\u029e') { return ":" + value.Substring(1); } else if (print_readably) { return "\"" + value.Replace("\\", "\\\\") .Replace("\"", "\\\"") .Replace("\n", "\\n") + "\""; } else { return value; } } } public class MalList : MalVal { public string start = "(", end = ")"; List value; public MalList() { value = new List(); } public MalList(List val) { value = val; } public MalList(params MalVal[] mvs) { value = new List(); conj_BANG(mvs); } public List getValue() { return value; } public override bool list_Q() { return true; } public override string ToString() { return start + printer.join(value, " ", true) + end; } public override string ToString(bool print_readably) { return start + printer.join(value, " ", print_readably) + end; } public MalList conj_BANG(params MalVal[] mvs) { for (int i = 0; i < mvs.Length; i++) { value.Add(mvs[i]); } return this; } public int size() { return value.Count; } public MalVal nth(int idx) { return value.Count > idx ? value[idx] : Nil; } public MalVal this[int idx] { get { return value.Count > idx ? value[idx] : Nil; } } public MalList rest() { if (size() > 0) { return new MalList(value.GetRange(1, value.Count-1)); } else { return new MalList(); } } public virtual MalList slice(int start) { return new MalList(value.GetRange(start, value.Count-start)); } public virtual MalList slice(int start, int end) { return new MalList(value.GetRange(start, end-start)); } } public class MalVector : MalList { // Same implementation except for instantiation methods public MalVector() :base() { start = "["; end = "]"; } public MalVector(List val) :base(val) { start = "["; end = "]"; } public override bool list_Q() { return false; } public override MalList slice(int start, int end) { var val = this.getValue(); return new MalVector(val.GetRange(start, val.Count-start)); } } public class MalHashMap : MalVal { Dictionary value; public MalHashMap(Dictionary val) { value = val; } public MalHashMap(MalList lst) { value = new Dictionary(); assoc_BANG(lst); } public new MalHashMap copy() { var new_self = (MalHashMap)this.MemberwiseClone(); new_self.value = new Dictionary(value); return new_self; } public Dictionary getValue() { return value; } public override string ToString() { return "{" + printer.join(value, " ", true) + "}"; } public override string ToString(bool print_readably) { return "{" + printer.join(value, " ", print_readably) + "}"; } public MalHashMap assoc_BANG(MalList lst) { for (int i=0; i fn = null; MalVal ast = null; Mal.env.Env env = null; MalList fparams; bool macro = false; public MalFunc(Func fn) { this.fn = fn; } public MalFunc(MalVal ast, Mal.env.Env env, MalList fparams, Func fn) { this.fn = fn; this.ast = ast; this.env = env; this.fparams = fparams; } public override string ToString() { if (ast != null) { return ""; } else { return ""; } } public MalVal apply(MalList args) { return fn(args); } public MalVal getAst() { return ast; } public Mal.env.Env getEnv() { return env; } public MalList getFParams() { return fparams; } public Mal.env.Env genEnv(MalList args) { return new Mal.env.Env(env, fparams, args); } public bool isMacro() { return macro; } public void setMacro() { macro = true; } } } } ================================================ FILE: impls/d/Dockerfile ================================================ FROM ubuntu:bionic MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install gcc gdc ldc gpg wget RUN wget https://dlang.org/install.sh -q -O install.sh && \ bash install.sh -p /usr/local/dlang && \ chmod 755 /usr/local/dlang/dmd* && \ ln -sf /usr/local/dlang/dmd-*/linux/bin64/dmd /usr/bin/dmd ENV HOME /mal ================================================ FILE: impls/d/Makefile ================================================ d_MODE ?= gdc D ?= $(d_MODE) ifeq ($(D),gdc) CFLAGS += -g -O2 -Wall LDFLAGS += -lreadline OF = -o $@ else ifeq ($(D),ldc2) CFLAGS += -g -O2 LDFLAGS += -L-lreadline OF = -of $@ else ifeq ($(D),dmd) CFLAGS += -g -O LDFLAGS += -L-lreadline OF = -of=$@ else @echo "Unsupported D implementation $(D)" @exit 1 endif ##################### EARLY_SRCS = step0_repl.d step1_read_print.d step2_eval.d LATE_SRCS = step3_env.d step4_if_fn_do.d step5_tco.d step6_file.d \ step7_quote.d step8_macros.d step9_try.d stepA_mal.d SRCS = $(EARLY_SRCS) $(LATE_SRCS) OBJS = $(SRCS:%.d=%.o) BINS = $(OBJS:%.o=%) EARLY_OBJS = types.o readline.o reader.o printer.o env.o OTHER_OBJS = $(EARLY_OBJS) mal_core.o EARLY_STEPS_BINS = $(EARLY_SRCS:%.d=%) LATE_STEPS_BINS = $(LATE_SRCS:%.d=%) ##################### all: $(BINS) dist: mal mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ $(OBJS) $(OTHER_OBJS): %.o: %.d $(D) $(CFLAGS) -c $(@:%.o=%.d) $(OF) $(EARLY_STEPS_BINS): $(EARLY_OBJS) $(LATE_STEPS_BINS): $(OTHER_OBJS) $(BINS): %: %.o $(D) $+ $(OF) $(LDFLAGS) clean: rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal ================================================ FILE: impls/d/env.d ================================================ import types; class Env { Env outer; MalType[string] data; this(Env outer_v, MalType[] binds = [], MalType[] exprs = []) { outer = outer_v; foreach (i, MalType b; binds) { auto arg_name = verify_cast!MalSymbol(b); if (arg_name.name == "&") { auto rest_arg_name = verify_cast!MalSymbol(binds[i + 1]); auto rest_exprs = new MalList(exprs[i..$]); set(rest_arg_name.name, rest_exprs); break; } else { set(arg_name.name, exprs[i]); } } } MalType set(string key, MalType val) { data[key] = val; return val; } MalType get(string key) { auto val = (key in data); if (val !is null) { return data[key]; } else if (outer is null) { return null; } else { return outer.get(key); } } } ================================================ FILE: impls/d/main.di ================================================ import types : MalType; import env : Env; MalType EVAL(MalType ast, Env env); ================================================ FILE: impls/d/mal_core.d ================================================ import core.time; import std.algorithm; import std.array; import std.datetime; import std.file; import std.stdio; import env; import main; import reader; import readline; import types; import printer; static MalType mal_equal(MalType[] a ...) { verify_args_count(a, 2); return bool_to_mal(a[0] == a[1]); } static MalType mal_throw(MalType[] a ...) { verify_args_count(a, 1); throw new MalException(a[0]); } static MalType mal_symbol(MalType[] a ...) { verify_args_count(a, 1); auto s = verify_cast!MalString(a[0]); return new MalSymbol(s.val); } static MalType mal_string_q(MalType[] a ...) { verify_args_count(a, 1); auto s = cast(MalString) a[0]; if (s is null) return mal_false; return bool_to_mal(!s.is_keyword()); } static MalType mal_keyword(MalType[] a ...) { verify_args_count(a, 1); auto s = verify_cast!MalString(a[0]); if (s.is_keyword()) return s; return new MalString("\u029e" ~ s.val); } static MalType mal_keyword_q(MalType[] a ...) { verify_args_count(a, 1); auto s = cast(MalString) a[0]; if (s is null) return mal_false; return bool_to_mal(s.is_keyword()); } static MalType mal_fn_q(MalType[] a ...) { verify_args_count(a, 1); auto builtinfn = cast(MalBuiltinFunc) a[0]; if (builtinfn !is null) return mal_true; auto malfunc = cast(MalFunc) a[0]; if (malfunc !is null) return bool_to_mal(!malfunc.is_macro); return mal_false; } static MalType mal_macro_q(MalType[] a ...) { verify_args_count(a, 1); auto malfunc = cast(MalFunc) a[0]; if (malfunc !is null) return bool_to_mal(malfunc.is_macro); return mal_false; } static MalType mal_pr_str(MalType[] a ...) { auto items_strs = a.map!(e => pr_str(e, true)); return new MalString(array(items_strs).join(" ")); } static MalType mal_str(MalType[] a ...) { auto items_strs = a.map!(e => pr_str(e, false)); return new MalString(array(items_strs).join("")); } static MalType mal_prn(MalType[] a ...) { auto items_strs = a.map!(e => pr_str(e, true)); writeln(array(items_strs).join(" ")); return mal_nil; } static MalType mal_println(MalType[] a ...) { auto items_strs = a.map!(e => pr_str(e, false)); writeln(array(items_strs).join(" ")); return mal_nil; } static MalType mal_read_string(MalType[] a ...) { verify_args_count(a, 1); auto s = verify_cast!MalString(a[0]); return read_str(s.val); } static MalType mal_readline(MalType[] a ...) { verify_args_count(a, 1); auto s = verify_cast!MalString(a[0]); auto line = _readline(s.val); return line is null ? mal_nil : new MalString(line); } static MalType mal_slurp(MalType[] a ...) { verify_args_count(a, 1); auto filename = verify_cast!MalString(a[0]).val; auto content = cast(string) std.file.read(filename); return new MalString(content); } alias TwoIntFunc = MalType function(long x, long y); MalType binary_int_op(TwoIntFunc f, MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return f(i0.val, i1.val); } static MalType mal_time_ms(MalType[] a ...) { immutable epoch = SysTime(unixTimeToStdTime(0)); immutable hnsecs_since_epoch = Clock.currTime(UTC()) - epoch; immutable ms = hnsecs_since_epoch.total!"msecs"(); return new MalInteger(ms); } static bool is_nil(MalType v) { return cast(MalNil)(v) !is null; } static MalType mal_assoc(MalType[] a ...) { verify_min_args_count(a, 1); auto hm = verify_cast!MalHashmap(a[0]); auto new_hm = new MalHashmap(hm.data.dup); new_hm.put_kv_list(a[1..$]); return new_hm; } static MalType mal_dissoc(MalType[] a ...) { verify_min_args_count(a, 1); auto hm = verify_cast!MalHashmap(a[0]); auto new_hm = new MalHashmap(hm.data.dup); foreach (k; a[1..$]) { new_hm.remove(k); } return new_hm; } static MalType mal_get(MalType[] a ...) { verify_args_count(a, 2); if (is_nil(a[0])) return mal_nil; auto hm = verify_cast!MalHashmap(a[0]); return hm.get(a[1]); } static MalType mal_contains_q(MalType[] a ...) { verify_args_count(a, 2); if (is_nil(a[0])) return mal_false; auto hm = verify_cast!MalHashmap(a[0]); return bool_to_mal(hm.contains(a[1])); } static MalType mal_keys(MalType[] a ...) { verify_args_count(a, 1); auto hm = verify_cast!MalHashmap(a[0]); auto keys = hm.data.keys.map!(s => cast(MalType)(new MalString(s))); return new MalList(array(keys)); } static MalType mal_vals(MalType[] a ...) { verify_args_count(a, 1); auto hm = verify_cast!MalHashmap(a[0]); return new MalList(hm.data.values); } static MalType mal_cons(MalType[] a ...) { verify_args_count(a, 2); auto lst = verify_cast!MalSequential(a[1]); return new MalList([a[0]] ~ lst.elements); } static MalType mal_concat(MalType[] a ...) { MalType[] res; foreach (e; a) { auto lst = verify_cast!MalSequential(e); res ~= lst.elements; } 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); if (is_nil(a[0])) { throw new Exception("nth: index out of range"); } auto seq = verify_cast!MalSequential(a[0]); auto index = verify_cast!MalInteger(a[1]).val; if (index >= seq.elements.length) { throw new Exception("nth: index out of range"); } return seq.elements[index]; } static MalType mal_first(MalType[] a ...) { verify_args_count(a, 1); if (is_nil(a[0])) return mal_nil; auto seq = verify_cast!MalSequential(a[0]); if (seq.elements.length == 0) return mal_nil; return seq.elements[0]; } static MalType mal_rest(MalType[] a ...) { verify_args_count(a, 1); if (is_nil(a[0])) return new MalList([]); auto seq = verify_cast!MalSequential(a[0]); if (seq.elements.length == 0) return new MalList([]); return new MalList(seq.elements[1..$]); } static MalType mal_empty_q(MalType[] a ...) { verify_args_count(a, 1); if (is_nil(a[0])) { return mal_true; } auto s = verify_cast!MalSequential(a[0]); return bool_to_mal(s.elements.length == 0); } static MalType mal_count(MalType[] a ...) { verify_args_count(a, 1); if (is_nil(a[0])) { return new MalInteger(0); } auto s = verify_cast!MalSequential(a[0]); return new MalInteger(cast(int)(s.elements.length)); } static MalType mal_apply(MalType[] a ...) { verify_min_args_count(a, 2); auto last_seq_elems = verify_cast!MalSequential(a[$-1]).elements; auto funcargs = a.length == 2 ? last_seq_elems : (a[1..$-1] ~ last_seq_elems); auto builtinfn = cast(MalBuiltinFunc) a[0]; if (builtinfn !is null) { return builtinfn.fn(funcargs); } auto malfunc = verify_cast!MalFunc(a[0]); auto callenv = new Env(malfunc.def_env, malfunc.arg_names, funcargs); return EVAL(malfunc.func_body, callenv); } static MalType mal_map(MalType[] a ...) { verify_args_count(a, 2); auto seq = verify_cast!MalSequential(a[1]); auto mapped_items = seq.elements.map!(e => mal_apply(a[0], new MalList([e]))); return new MalList(array(mapped_items)); } static MalType mal_conj(MalType[] a ...) { verify_min_args_count(a, 1); auto seq = verify_cast!MalSequential(a[0]); return reduce!((s,e) => s.conj(e))(seq, a[1..$]); } static MalType mal_seq(MalType[] a ...) { verify_args_count(a, 1); auto seqobj = cast(HasSeq) a[0]; if (seqobj is null) return mal_nil; return seqobj.seq(); } static MalType mal_meta(MalType[] a ...) { verify_args_count(a, 1); auto metaobj = cast(MalMeta) a[0]; if (metaobj is null) return mal_nil; return metaobj.meta(); } static MalType mal_with_meta(return MalType[] a ...) { verify_args_count(a, 2); if (auto metaobj = cast(MalMeta) a[0]) return metaobj.with_meta(a[1]); return a[0]; } static MalType mal_reset_bang(return MalType[] a ...) { verify_args_count(a, 2); verify_cast!MalAtom(a[0]).val = a[1]; return a[1]; } static MalType mal_swap_bang(MalType[] a ...) { verify_min_args_count(a, 2); auto atom = verify_cast!MalAtom(a[0]); auto args = [atom.val] ~ a[2..$]; auto newval = mal_apply([a[1], new MalList(args)]); return mal_reset_bang([atom, newval]); } BuiltinStaticFuncType[string] core_ns; static this() { core_ns = [ "=": &mal_equal, "throw": &mal_throw, "nil?": (a ...) => mal_type_q!MalNil(a), "true?": (a ...) => mal_type_q!MalTrue(a), "false?": (a ...) => mal_type_q!MalFalse(a), "symbol": &mal_symbol, "symbol?": (a ...) => mal_type_q!MalSymbol(a), "string?": &mal_string_q, "keyword": &mal_keyword, "keyword?": &mal_keyword_q, "number?": (a ...) => mal_type_q!MalInteger(a), "fn?": &mal_fn_q, "macro?": &mal_macro_q, "pr-str": &mal_pr_str, "str": &mal_str, "prn": &mal_prn, "println": &mal_println, "read-string": &mal_read_string, "readline": &mal_readline, "slurp": &mal_slurp, "<": (a ...) => binary_int_op((x,y) => bool_to_mal(x < y), a), "<=": (a ...) => binary_int_op((x,y) => bool_to_mal(x <= y), a), ">": (a ...) => binary_int_op((x,y) => bool_to_mal(x > y), a), ">=": (a ...) => binary_int_op((x,y) => bool_to_mal(x >= y), a), "+": (a ...) => binary_int_op((x,y) => new MalInteger(x + y), a), "-": (a ...) => binary_int_op((x,y) => new MalInteger(x - y), a), "*": (a ...) => binary_int_op((x,y) => new MalInteger(x * y), a), "/": (a ...) => binary_int_op((x,y) => new MalInteger(x / y), a), "time-ms": &mal_time_ms, "list": (a ...) => new MalList(a), "list?": (a ...) => mal_type_q!MalList(a), "vector": (a ...) => new MalVector(a), "vector?": (a ...) => mal_type_q!MalVector(a), "hash-map": (a ...) => new MalHashmap(a), "map?": (a ...) => mal_type_q!MalHashmap(a), "assoc": &mal_assoc, "dissoc": &mal_dissoc, "get": &mal_get, "contains?": &mal_contains_q, "keys": &mal_keys, "vals": &mal_vals, "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, "empty?": &mal_empty_q, "count": &mal_count, "apply": &mal_apply, "map": &mal_map, "conj": &mal_conj, "seq": &mal_seq, "meta": &mal_meta, "with-meta": &mal_with_meta, "atom": (a ...) => new MalAtom(verify_args_count(a, 1)[0]), "atom?": (a ...) => mal_type_q!MalAtom(a), "deref": (a ...) => verify_cast!MalAtom(verify_args_count(a, 1)[0]).val, "reset!": &mal_reset_bang, "swap!": &mal_swap_bang ]; } ================================================ FILE: impls/d/printer.d ================================================ import types; string pr_str(MalType obj, bool readable = true) { return obj.print(readable); } ================================================ FILE: impls/d/reader.d ================================================ import std.array; import std.regex; import std.stdio; import types; MalSymbol sym_quote; MalSymbol sym_quasiquote; MalSymbol sym_unquote; MalSymbol sym_splice_unquote; MalSymbol sym_deref; MalSymbol sym_with_meta; static this() { sym_quote = new MalSymbol("quote"); sym_quasiquote = new MalSymbol("quasiquote"); sym_unquote = new MalSymbol("unquote"); sym_splice_unquote = new MalSymbol("splice-unquote"); sym_deref = new MalSymbol("deref"); sym_with_meta = new MalSymbol("with-meta"); } class Reader { int pos = 0; const string[] tokens; this(string[] the_tokens) { tokens = the_tokens.dup; } string peek() { if (pos >= tokens.length) return null; return tokens[pos]; } string next() { auto token = peek(); pos++; return token; } } auto tokenize_ctr = ctRegex!(r"[\s,]*(~@|[\[\]{}()'`~^@]|" ~ `"` ~ `(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"` ~ r"`,;)]*)"); string[] tokenize(string str) { string[] tokens; foreach(c; matchAll(str, tokenize_ctr)) { auto token = c[1]; if (token.length == 0) continue; if (token[0] == ';') continue; tokens ~= token; } return tokens; } MalString parse_string(string token) { // TODO: this could be done with replaceAll // https://dlang.org/library/std/regex/replace_all.html string unescaped = token[1..$-1] // Remove surrounding quotes .replace("\\\\", "\u029e") .replace("\\n", "\n") .replace("\\\"", "\"") .replace("\u029e", "\\"); return new MalString(unescaped); } auto integer_ctr = ctRegex!(r"^-?[0-9]+$"); auto string_ctr = ctRegex!(`^"(?:\\.|[^\\"])*"$`); MalType read_atom(Reader reader) { auto token = reader.next(); switch (token) { case "nil": return mal_nil; case "false": return mal_false; case "true": return mal_true; default: switch (token[0]) { case ':': return new MalString("\u029e" ~ token[1..$]); case '"': auto captures = matchFirst(token, string_ctr); if (captures.empty()) { throw new Exception("expected '\"', got EOF"); } return parse_string(token); default: auto captures = matchFirst(token, integer_ctr); if (!captures.empty()) { return new MalInteger(token); } return new MalSymbol(token); } } } MalType[] read_items(Reader reader, string start, string end) { auto open_paren = reader.next(); if (open_paren != start) throw new Exception("expected '" ~ start ~ "', got EOF"); string token; MalType[] res; while ((token = reader.peek()) != end) { if (token is null) { throw new Exception("expected '" ~ end ~ "', got EOF"); } res ~= read_form(reader); } reader.next(); // consume the ')' return res; } MalList read_list(Reader reader) { return new MalList(read_items(reader, "(", ")")); } MalVector read_vector(Reader reader) { return new MalVector(read_items(reader, "[", "]")); } MalHashmap read_hashmap(Reader reader) { return new MalHashmap(read_items(reader, "{", "}")); } MalList read_quote_shortcut(Reader reader, MalSymbol sym) { reader.next(); // consume the special quote char return new MalList([sym, read_form(reader)]); } MalType read_form(Reader reader) { auto token = reader.peek(); if (token is null) return new MalNil(); switch(token) { case "'": return read_quote_shortcut(reader, sym_quote); case "`": return read_quote_shortcut(reader, sym_quasiquote); case "~": return read_quote_shortcut(reader, sym_unquote); case "~@": return read_quote_shortcut(reader, sym_splice_unquote); case "@": return read_quote_shortcut(reader, sym_deref); case "^": reader.next(); // consume the caret char auto meta = read_form(reader); return new MalList([sym_with_meta, read_form(reader), meta]); case "(": return read_list(reader); case ")": throw new Exception("unexpected ')'"); case "[": return read_vector(reader); case "]": throw new Exception("unexpected ']'"); case "{": return read_hashmap(reader); case "}": throw new Exception("unexpected '}'"); default: return read_atom(reader); } } MalType read_str(string str) { auto tokens = tokenize(str); auto reader = new Reader(tokens); return read_form(reader); } ================================================ FILE: impls/d/readline.d ================================================ import std.string; import std.path; import std.file; import core.stdc.string; import core.stdc.stdlib; // readline/readline.h extern (C) char* readline(const char* prompt); // readline/history.h extern (C) void using_history(); extern (C) void add_history(const char *line); extern (C) int read_history(const char *filename); extern (C) int append_history(int nelement, const char *filename); bool history_loaded = false; const string history_file = "~/.mal-history"; void load_history() { if (history_loaded) return; using_history(); string hf = expandTilde(history_file); std.file.append(hf, ""); // Create the file if needed read_history(toStringz(hf)); history_loaded = true; } void append_to_history() { string hf = expandTilde(history_file); append_history(1, toStringz(hf)); } // Convert from C-string to D-string (making a copy) pure string fromCstr(char* cstr) { auto len = core.stdc.string.strlen(cstr); if (len == 0) return ""; string line = cstr[0..len].dup; return line; } string _readline(in string prompt) { load_history(); auto cstr = readline(toStringz(prompt)); if (cstr is null) return null; scope(exit) { core.stdc.stdlib.free(cstr); } if (cstr[0] != '\0') { add_history(cstr); // Add input to in-memory history append_to_history(); // Flush new line of history to disk } return fromCstr(cstr); } ================================================ FILE: impls/d/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/d/step0_repl.d ================================================ import std.stdio; import std.string; import readline; string READ(string str) { return str; } string EVAL(string ast) { return ast; } string PRINT(string ast) { return ast; } string rep(string str) { return PRINT(EVAL(READ(str))); } void main() { for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; writeln(rep(line)); } writeln(""); } ================================================ FILE: impls/d/step1_read_print.d ================================================ import std.stdio; import std.string; import readline; import reader; import printer; import types; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast) { return ast; } string PRINT(MalType ast) { return pr_str(ast); } string rep(string str) { return PRINT(EVAL(READ(str))); } void main() { for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step2_eval.d ================================================ import std.algorithm; import std.array; import std.stdio; import std.string; import readline; import reader; import printer; import types; alias Env = MalType[string]; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast, Env env) { if (auto dbgeval = ("DEBUG-EVAL" in env)) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { auto v = (sym.name in env); if (v is null) throw new Exception("'" ~ sym.name ~ "' not found"); return *v; } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } // todo: indent right else if (auto ast_list = cast(MalList)ast) { if (ast_list.elements.length == 0) { return ast; } auto fobj = verify_cast!MalBuiltinFunc(EVAL(ast_list.elements[0], env)); auto args = array(ast_list.elements[1..$].map!(e => EVAL(e, env))); return fobj.fn(args); } else { return ast; } } string PRINT(MalType ast) { return pr_str(ast); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } static MalType mal_add(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val + i1.val); } static MalType mal_sub(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val - i1.val); } static MalType mal_mul(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val * i1.val); } static MalType mal_div(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val / i1.val); } void main() { Env repl_env; repl_env["+"] = new MalBuiltinFunc(&mal_add, "+"); repl_env["-"] = new MalBuiltinFunc(&mal_sub, "-"); repl_env["*"] = new MalBuiltinFunc(&mal_mul, "*"); repl_env["/"] = new MalBuiltinFunc(&mal_div, "/"); for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step3_env.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import env; import readline; import reader; import printer; import types; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast, Env env) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } // todo: indent right else if (auto ast_list = cast(MalList)ast) { if (ast_list.elements.length == 0) { return ast; } auto a0_sym = verify_cast!MalSymbol(ast_list.elements[0]); switch (a0_sym.name) { case "def!": auto a1 = verify_cast!MalSymbol(ast_list.elements[1]); return env.set(a1.name, EVAL(ast_list.elements[2], env)); case "let*": auto a1 = verify_cast!MalSequential(ast_list.elements[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } return EVAL(ast_list.elements[2], let_env); default: auto fobj = verify_cast!MalBuiltinFunc(EVAL(ast_list.elements[0], env)); auto args = array(ast_list.elements[1..$].map!(e => EVAL(e, env))); return fobj.fn(args); } } else { return ast; } } string PRINT(MalType ast) { return pr_str(ast); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } static MalType mal_add(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val + i1.val); } static MalType mal_sub(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val - i1.val); } static MalType mal_mul(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val * i1.val); } static MalType mal_div(MalType[] a ...) { verify_args_count(a, 2); MalInteger i0 = verify_cast!MalInteger(a[0]); MalInteger i1 = verify_cast!MalInteger(a[1]); return new MalInteger(i0.val / i1.val); } void main() { auto repl_env = new Env(null); repl_env.set("+", new MalBuiltinFunc(&mal_add, "+")); repl_env.set("-", new MalBuiltinFunc(&mal_sub, "-")); repl_env.set("*", new MalBuiltinFunc(&mal_mul, "*")); repl_env.set("/", new MalBuiltinFunc(&mal_div, "/")); for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step4_if_fn_do.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import env; import mal_core; import readline; import reader; import printer; import types; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast, Env env) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } // todo: indent right else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } return EVAL(aste[2], let_env); case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } return EVAL(aste[$-1], env); case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) return EVAL(aste[2], env); else if (aste.length > 3) return EVAL(aste[3], env); else return mal_nil; case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = array(aste[1..$].map!(e => EVAL(e, env))); if (auto funcobj = cast(MalFunc)first) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); return EVAL(funcobj.func_body, callenv); } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } void main() { auto repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step5_tco.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import env; import mal_core; import readline; import reader; import printer; import types; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = array(aste[1..$].map!(e => EVAL(e, env))); if (auto funcobj = cast(MalFunc)first) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } void main() { auto repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step6_file.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import core.stdc.stdlib; import env; import mal_core; import readline; import reader; import printer; import types; MalType READ(string str) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = array(aste[1..$].map!(e => EVAL(e, env))); if (auto funcobj = cast(MalFunc)first) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } static MalList create_argv_list(string[] args) { if (args.length <= 2) return new MalList([]); return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); } void main(string[] args) { Env repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } BuiltinFuncType eval_func = (a ...) { verify_args_count(a, 1); return EVAL(a[0], repl_env); }; repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); repl_env.set("*ARGV*", create_argv_list(args)); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if (args.length > 1) { try { rep("(load-file \"" ~ args[1] ~ "\")", repl_env); return; } catch (Exception e) { writeln("Error: ", e.msg); exit(1); } } for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step7_quote.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import core.stdc.stdlib; import env; import mal_core; import readline; import reader; import printer; import types; bool starts_with(MalType ast, MalSymbol sym) { auto lst = cast(MalList) ast; if (lst is null) return false; auto lste = lst.elements; return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); auto ast_seq = cast(MalSequential) ast; if (ast_seq is null) return ast; auto aste = ast_seq.elements; if (starts_with(ast, sym_unquote)) return 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) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "quote": return aste[1]; case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = array(aste[1..$].map!(e => EVAL(e, env))); if (auto funcobj = cast(MalFunc)first) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } static MalList create_argv_list(string[] args) { if (args.length <= 2) return new MalList([]); return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); } void main(string[] args) { Env repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } BuiltinFuncType eval_func = (a ...) { verify_args_count(a, 1); return EVAL(a[0], repl_env); }; repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); repl_env.set("*ARGV*", create_argv_list(args)); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if (args.length > 1) { try { rep("(load-file \"" ~ args[1] ~ "\")", repl_env); return; } catch (Exception e) { writeln("Error: ", e.msg); exit(1); } } for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step8_macros.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import core.stdc.stdlib; import env; import mal_core; import readline; import reader; import printer; import types; bool starts_with(MalType ast, MalSymbol sym) { auto lst = cast(MalList) ast; if (lst is null) return false; auto lste = lst.elements; return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); auto ast_seq = cast(MalSequential) ast; if (ast_seq is null) return ast; auto aste = ast_seq.elements; if (starts_with(ast, sym_unquote)) return 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) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "quote": return aste[1]; case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO case "defmacro!": auto a1 = verify_cast!MalSymbol(aste[1]); auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); mac.is_macro = true; return env.set(a1.name, mac); case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = aste[1..$]; if (auto funcobj = cast(MalFunc)first) { if (funcobj.is_macro) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = EVAL(funcobj.func_body, callenv); continue; // TCO } rest = array(rest.map!(e => EVAL(e, env))); auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } static MalList create_argv_list(string[] args) { if (args.length <= 2) return new MalList([]); return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); } void main(string[] args) { Env repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } BuiltinFuncType eval_func = (a ...) { verify_args_count(a, 1); return EVAL(a[0], repl_env); }; repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); repl_env.set("*ARGV*", create_argv_list(args)); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if (args.length > 1) { try { rep("(load-file \"" ~ args[1] ~ "\")", repl_env); return; } catch (Exception e) { writeln("Error: ", e.msg); exit(1); } } for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/step9_try.d ================================================ module main; import std.algorithm; import std.array; import std.range; import std.stdio; import std.string; import core.stdc.stdlib; import env; import mal_core; import readline; import reader; import printer; import types; bool starts_with(MalType ast, MalSymbol sym) { auto lst = cast(MalList) ast; if (lst is null) return false; auto lste = lst.elements; return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); auto ast_seq = cast(MalSequential) ast; if (ast_seq is null) return ast; auto aste = ast_seq.elements; if (starts_with(ast, sym_unquote)) return 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) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "quote": return aste[1]; case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO case "defmacro!": auto a1 = verify_cast!MalSymbol(aste[1]); auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); mac.is_macro = true; return env.set(a1.name, mac); case "try*": if (aste.length < 2) return mal_nil; if (aste.length < 3) { ast = aste[1]; continue; // TCO } MalType exc; try { // d seems to do erroneous tco all by itself without this // little distraction pr_str(aste[1]); return EVAL(aste[1], env); } catch (MalException e) { exc = e.data; } catch (Exception e) { exc = new MalString(e.msg); } auto catch_clause = verify_cast!MalList(aste[2]); auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); ast = catch_clause.elements[2]; env = catch_env; continue; // TCO case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = aste[1..$]; if (auto funcobj = cast(MalFunc)first) { if (funcobj.is_macro) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = EVAL(funcobj.func_body, callenv); continue; // TCO } rest = array(rest.map!(e => EVAL(e, env))); auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } static MalList create_argv_list(string[] args) { if (args.length <= 2) return new MalList([]); return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); } void main(string[] args) { Env repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } BuiltinFuncType eval_func = (a ...) { verify_args_count(a, 1); return EVAL(a[0], repl_env); }; repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); repl_env.set("*ARGV*", create_argv_list(args)); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if (args.length > 1) { try { rep("(load-file \"" ~ args[1] ~ "\")", repl_env); return; } catch (Exception e) { writeln("Error: ", e.msg); exit(1); } } for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (MalException e) { writeln("Error: ", pr_str(e.data)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/stepA_mal.d ================================================ module main; import std.algorithm; import std.compiler; import std.array; import std.range; import std.stdio; import std.string; import core.stdc.stdlib; import env; import mal_core; import readline; import reader; import printer; import types; bool starts_with(MalType ast, MalSymbol sym) { auto lst = cast(MalList) ast; if (lst is null) return false; auto lste = lst.elements; return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); auto ast_seq = cast(MalSequential) ast; if (ast_seq is null) return ast; auto aste = ast_seq.elements; if (starts_with(ast, sym_unquote)) return 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) { return read_str(str); } MalType EVAL(MalType ast, Env env) { for (;;) { if (auto dbgeval = env.get("DEBUG-EVAL")) if (dbgeval.is_truthy()) writeln("EVAL: ", pr_str(ast)); if (auto sym = cast(MalSymbol)ast) { if (auto val = env.get(sym.name)) return val; else throw new Exception("'" ~ sym.name ~ "' not found"); } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); return new MalVector(el); } else if (auto hm = cast(MalHashmap)ast) { typeof(hm.data) new_data; foreach (string k, MalType v; hm.data) { new_data[k] = EVAL(v, env); } return new MalHashmap(new_data); } else if (auto ast_list = cast(MalList)ast) { auto aste = ast_list.elements; if (aste.length == 0) { return ast; } auto a0_sym = cast(MalSymbol) aste[0]; auto sym_name = a0_sym is null ? "" : a0_sym.name; switch (sym_name) { case "def!": auto a1 = verify_cast!MalSymbol(aste[1]); return env.set(a1.name, EVAL(aste[2], env)); case "let*": auto a1 = verify_cast!MalSequential(aste[1]); auto let_env = new Env(env); foreach (kv; chunks(a1.elements, 2)) { if (kv.length < 2) throw new Exception("let* requires even number of elements"); auto var_name = verify_cast!MalSymbol(kv[0]); let_env.set(var_name.name, EVAL(kv[1], let_env)); } ast = aste[2]; env = let_env; continue; // TCO case "quote": return aste[1]; case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO case "defmacro!": auto a1 = verify_cast!MalSymbol(aste[1]); auto mac = verify_cast!MalFunc(EVAL(aste[2], env)); mac = new MalFunc(mac.arg_names, mac.func_body, mac.def_env); mac.is_macro = true; return env.set(a1.name, mac); case "try*": if (aste.length < 2) return mal_nil; if (aste.length < 3) { ast = aste[1]; continue; // TCO } MalType exc; try { // d seems to do erroneous tco all by itself without this // little distraction pr_str(aste[1]); return EVAL(aste[1], env); } catch (MalException e) { exc = e.data; } catch (Exception e) { exc = new MalString(e.msg); } auto catch_clause = verify_cast!MalList(aste[2]); auto catch_env = new Env(env, [catch_clause.elements[1]], [exc]); ast = catch_clause.elements[2]; env = catch_env; continue; // TCO case "do": foreach (elt; aste[1..$-1]) { EVAL(elt, env); } ast = aste[$-1]; continue; // TCO case "if": auto cond = EVAL(aste[1], env); if (cond.is_truthy()) { ast = aste[2]; continue; // TCO } else if (aste.length > 3) { ast = aste[3]; continue; // TCO } else { return mal_nil; } case "fn*": auto args_list = verify_cast!MalSequential(aste[1]); return new MalFunc(args_list.elements, aste[2], env); default: auto first = EVAL(aste[0], env); auto rest = aste[1..$]; if (auto funcobj = cast(MalFunc)first) { if (funcobj.is_macro) { auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = EVAL(funcobj.func_body, callenv); continue; // TCO } rest = array(rest.map!(e => EVAL(e, env))); auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; continue; // TCO } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else { throw new Exception("Expected a function"); } } } else { return ast; } } } string PRINT(MalType ast) { return pr_str(ast); } MalType re(string str, Env env) { return EVAL(READ(str), env); } string rep(string str, Env env) { return PRINT(re(str, env)); } static MalList create_argv_list(string[] args) { if (args.length <= 2) return new MalList([]); return new MalList(array(args[2..$].map!(s => cast(MalType)(new MalString(s))))); } void main(string[] args) { Env repl_env = new Env(null); foreach (string sym_name, BuiltinStaticFuncType f; core_ns) { repl_env.set(sym_name, new MalBuiltinFunc(f, sym_name)); } BuiltinFuncType eval_func = (a ...) { verify_args_count(a, 1); return EVAL(a[0], repl_env); }; repl_env.set("eval", new MalBuiltinFunc(eval_func, "eval")); repl_env.set("*ARGV*", create_argv_list(args)); // core.mal: defined using the language itself re("(def! *host-language* \"" ~ std.compiler.name ~ "\")", repl_env); re("(def! not (fn* (a) (if a false true)))", repl_env); re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if (args.length > 1) { try { rep("(load-file \"" ~ args[1] ~ "\")", repl_env); return; } catch (Exception e) { writeln("Error: ", e.msg); exit(1); } } re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); for (;;) { string line = _readline("user> "); if (line is null) break; if (line.length == 0) continue; try { writeln(rep(line, repl_env)); } catch (MalException e) { writeln("Error: ", pr_str(e.data)); } catch (Exception e) { writeln("Error: ", e.msg); } } writeln(""); } ================================================ FILE: impls/d/tests/step5_tco.mal ================================================ ;; D: skipping non-TCO recursion ;; Reason: completes at 10,000, segfaults at 40,000 ================================================ FILE: impls/d/types.d ================================================ import std.algorithm; import std.array; import std.conv; import std.functional; import std.range; import env; abstract class MalType { string print(bool readable) const; bool is_truthy() const { return true; } } interface MalMeta { MalType meta(); MalType with_meta(MalType new_meta); } interface HasSeq { MalType seq(); } class MalNil : MalType, HasSeq { override string print(bool readable) const { return "nil"; } override bool is_truthy() const { return false; } override bool opEquals(Object o) { return (cast(MalNil)(o) !is null); } override MalType seq() { return this; } } class MalFalse : MalType { override string print(bool readable) const { return "false"; } override bool is_truthy() const { return false; } override bool opEquals(Object o) { return (cast(MalFalse)(o) !is null); } } class MalTrue : MalType { override string print(bool readable) const { return "true"; } override bool opEquals(Object o) { return (cast(MalTrue)(o) !is null); } } MalNil mal_nil; MalFalse mal_false; MalTrue mal_true; static this() { mal_nil = new MalNil; mal_false = new MalFalse; mal_true = new MalTrue; } MalType bool_to_mal(in bool b) { return b ? mal_true : mal_false; } class MalSymbol : MalType { const string name; this(in string token) { name = token; } override string print(bool readable) const { return name; } override size_t toHash() { return typeid(name).getHash(&name); } override int opCmp(Object other) { MalSymbol o = cast(MalSymbol) other; return cmp(name, o.name); } override bool opEquals(Object other) { auto o = cast(MalSymbol) other; return (o !is null && name == o.name); } } class MalInteger : MalType { const long val; this(string token) { val = to!long(token); } this(long v) { val = v; } override string print(bool readable) const { return to!string(val); } override bool opEquals(Object o) { auto oint = cast(MalInteger)(o); return (oint !is null && val == oint.val); } } class MalString : MalType, HasSeq { const string val; this(in string token) { val = token; } override string print(bool readable) const { if (is_keyword()) return ":" ~ val[2..$]; if (readable) { string escaped = val.replace("\\", "\\\\") .replace("\"", "\\\"") .replace("\n", "\\n"); return "\"" ~ escaped ~ "\""; } else { return val; } } bool is_keyword() const { return val.length > 1 && val[0..2] == "\u029e"; } override bool opEquals(Object o) { auto ostr = cast(MalString)(o); return (ostr !is null && val == ostr.val); } override MalType seq() { if (is_keyword() || val.length == 0) return mal_nil; auto chars = val.map!(c => cast(MalType)(new MalString(to!string(c)))); return new MalList(array(chars)); } } abstract class MalSequential : MalType, HasSeq, MalMeta { MalType[] elements; MalType meta_val; this(MalType[] lst) { elements = lst; meta_val = mal_nil; } override bool opEquals(Object o) { auto oseq = cast(MalSequential)(o); return (oseq !is null && elements == oseq.elements); } MalSequential conj(MalType element); MalType seq() { if (elements.length == 0) return mal_nil; return new MalList(elements); } } class MalList : MalSequential, MalMeta { this(MalType[] lst) { super(lst); } this(MalList that, MalType new_meta) { super(that.elements); meta_val = new_meta; } override string print(bool readable) const { auto items_strs = elements.map!(e => e.print(readable)); return "(" ~ array(items_strs).join(" ") ~ ")"; } override MalSequential conj(MalType element) { return new MalList([element] ~ elements); } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalList(this, new_meta); } } class MalVector : MalSequential, MalMeta { this(MalType[] lst) { super(lst); } this(MalVector that, MalType new_meta) { super(that.elements); meta_val = new_meta; } override string print(bool readable) const { auto items_strs = elements.map!(e => e.print(readable)); return "[" ~ array(items_strs).join(" ") ~ "]"; } override MalSequential conj(MalType element) { return new MalVector(elements ~ [element]); } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalVector(this, new_meta); } } class MalHashmap : MalType, MalMeta { MalType[string] data; MalType meta_val; this(MalType[string] map) { data = map; meta_val = mal_nil; } this(MalType[] lst) { put_kv_list(lst); meta_val = mal_nil; } this(MalHashmap that, MalType new_meta) { data = that.data; meta_val = new_meta; } bool contains(in MalType key) { auto valp = (make_hash_key(key) in data); return valp !is null; } MalType get(in MalType key) { auto valp = (make_hash_key(key) in data); return valp is null ? mal_nil : *valp; } void remove(in MalType key) { data.remove(make_hash_key(key)); } void put(in MalType key, MalType val) { data[make_hash_key(key)] = val; } void put_kv_list(MalType[] lst) { foreach (kv; chunks(lst, 2)) { if (kv.length < 2) throw new Exception("requires even number of elements"); put(kv[0], kv[1]); } } private string make_hash_key(in MalType key) { return verify_cast!MalString(key).val; } override string print(bool readable) const { string[] parts; foreach (k, v; data) { parts ~= (new MalString(k)).print(readable); parts ~= v.print(readable); } return "{" ~ parts.join(" ") ~ "}"; } override bool opEquals(Object o) { auto ohm = cast(MalHashmap)(o); return (ohm !is null && data == ohm.data); } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalHashmap(this, new_meta); } } alias BuiltinStaticFuncType = MalType function(MalType[] a ...); alias BuiltinFuncType = MalType delegate(MalType[] a ...); class MalBuiltinFunc : MalType, MalMeta { const BuiltinFuncType fn; const string name; MalType meta_val; this(in BuiltinFuncType fn_v, in string name_v) { fn = fn_v; name = name_v; meta_val = mal_nil; } this(in BuiltinStaticFuncType static_fn_v, in string name_v) { fn = toDelegate(static_fn_v); name = name_v; meta_val = mal_nil; } this(MalBuiltinFunc that, MalType new_meta) { fn = that.fn; name = that.name; meta_val = new_meta; } override string print(bool readable) const { return ""; } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalBuiltinFunc(this, new_meta); } } class MalFunc : MalType, MalMeta { MalType[] arg_names; MalType func_body; Env def_env; bool is_macro; MalType meta_val; this(MalType[] arg_names_v, MalType func_body_v, Env def_env_v) { arg_names = arg_names_v; func_body = func_body_v; def_env = def_env_v; is_macro = false; meta_val = mal_nil; } this(MalFunc that, MalType new_meta) { arg_names = that.arg_names; func_body = that.func_body; def_env = that.def_env; is_macro = that.is_macro; meta_val = new_meta; } override string print(bool readable) const { return " e.print(true))).join(",") ~ ">"; } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalFunc(this, new_meta); } } class MalAtom : MalType, MalMeta { MalType val; MalType meta_val; this(MalType v) { val = v; meta_val = mal_nil; } this(MalAtom that, MalType new_meta) { val = that.val; meta_val = new_meta; } override string print(bool readable) const { return "(atom " ~ val.print(readable) ~ ")"; } override bool opEquals(Object other) { auto o = cast(MalAtom) other; return (o !is null && val == o.val); } override MalType meta() { return meta_val; } override MalType with_meta(MalType new_meta) { return new MalAtom(this, new_meta); } } class MalException : Exception { MalType data; this(MalType val) { super("MalException"); data = val; } } T verify_cast(T)(in MalType v) { if (T res = cast(T) v) return res; throw new Exception("Expected " ~ typeid(T).name); } MalType mal_type_q(T)(in MalType[] a) { verify_args_count(a, 1); T res = cast(T) a[0]; return bool_to_mal(res !is null); } inout(MalType[]) verify_args_count(inout MalType[] args, in int expected_length) { if (args.length != expected_length) { throw new Exception("Expected " ~ to!string(expected_length) ~ " arguments"); } return args; } void verify_min_args_count(in MalType[] args, in int min_expected_length) { if (args.length < min_expected_length) { throw new Exception("Expected at least " ~ to!string(min_expected_length) ~ " arguments"); } } ================================================ FILE: impls/dart/.analysis_options ================================================ analyzer: strong-mode: true exclude: - step2_eval.dart - step3_env.dart - step4_if_fn_do.dart - step5_tco.dart ================================================ FILE: impls/dart/.packages ================================================ # Generated by pub on 2016-08-20 13:39:08.695546. mal:lib/ ================================================ FILE: impls/dart/Dockerfile ================================================ FROM ubuntu:vivid MAINTAINER Harry Terkelsen ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install apt-transport-https RUN curl https://dl-ssl.google.com/linux/linux_signing_key.pub | apt-key add - RUN curl https://storage.googleapis.com/download.dartlang.org/linux/debian/dart_stable.list > /etc/apt/sources.list.d/dart_stable.list RUN apt-get -y update RUN apt-get -y install dart ================================================ FILE: impls/dart/Makefile ================================================ all: @true clean: ================================================ FILE: impls/dart/core.dart ================================================ import 'dart:io'; import 'printer.dart'; import 'reader.dart' as reader; import 'types.dart'; Map ns = { '+': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value + b.value); }), '-': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value - b.value); }), '*': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value * b.value); }), '/': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value ~/ b.value); }), 'list': new MalBuiltin((List args) => new MalList(args.toList())), 'list?': new MalBuiltin( (List args) => new MalBool(args.single is MalList)), 'empty?': new MalBuiltin((List args) { var a = args.single as MalIterable; return new MalBool(a.elements.isEmpty); }), 'count': new MalBuiltin((List args) { var a = args.first as MalIterable; return new MalInt(a.elements.length); }), '=': new MalBuiltin((List args) { var a = args[0]; var b = args[1]; return new MalBool(a == b); }), '<': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value < b.value); }), '<=': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value <= b.value); }), '>': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value > b.value); }), '>=': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalBool(a.value >= b.value); }), 'pr-str': new MalBuiltin((List args) { return new MalString( args.map((a) => pr_str(a, print_readably: true)).join(' ')); }), 'str': new MalBuiltin((List args) { return new MalString( args.map((a) => pr_str(a, print_readably: false)).join()); }), 'prn': new MalBuiltin((List args) { print(args.map((a) => pr_str(a, print_readably: true)).join(' ')); return new MalNil(); }), 'println': new MalBuiltin((List args) { print(args.map((a) => pr_str(a, print_readably: false)).join(' ')); return new MalNil(); }), 'read-string': new MalBuiltin((List args) { var code = args.single as MalString; return reader.read_str(code.value); }), 'slurp': new MalBuiltin((List args) { var fileName = args.single as MalString; var file = new File(fileName.value); return new MalString(file.readAsStringSync()); }), 'atom': new MalBuiltin((List args) { var value = args.single; return new MalAtom(value); }), 'atom?': new MalBuiltin((List args) { var value = args.single; return new MalBool(value is MalAtom); }), 'deref': new MalBuiltin((List args) { var atom = args.single as MalAtom; return atom.value; }), 'reset!': new MalBuiltin((List args) { var atom = args[0] as MalAtom; var newValue = args[1]; atom.value = newValue; return newValue; }), 'swap!': new MalBuiltin((List args) { var atom = args[0] as MalAtom; var func = args[1] as MalCallable; var fnArgs = [atom.value]..addAll(args.sublist(2)); var result = func.call(fnArgs); atom.value = result; return result; }), 'cons': new MalBuiltin((List args) { var x = args[0]; var xs = args[1] as MalIterable; return new MalList([x]..addAll(xs)); }), 'concat': new MalBuiltin((List args) { var results = []; for (MalIterable element in args) { results.addAll(element); } return new MalList(results); }), '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] as MalList).elements); } throw new MalException(new MalString("vec: wrong arguments")); }), 'nth': new MalBuiltin((List args) { var indexable = args[0] as MalIterable; var index = args[1] as MalInt; try { return indexable[index.value]; } on RangeError catch (e) { throw new MalException(new MalString(e.toString())); } }), 'first': new MalBuiltin((List args) { var list = args.first as MalIterable; if (list.isEmpty) return new MalNil(); return list.first; }), 'rest': new MalBuiltin((List args) { var list = args.first as MalIterable; if (list.isEmpty) return new MalList([]); return new MalList(list.sublist(1)); }), 'throw': new MalBuiltin((List args) { throw new MalException(args.first); }), 'nil?': new MalBuiltin((List args) { return new MalBool(args.first is MalNil); }), 'true?': new MalBuiltin((List args) { return new MalBool(args.first is MalBool && (args.first as MalBool).value); }), 'false?': new MalBuiltin((List args) { return new MalBool(args.first is MalBool && !(args.first as MalBool).value); }), 'symbol': new MalBuiltin((List args) { return new MalSymbol((args.first as MalString).value); }), 'symbol?': new MalBuiltin((List args) { return new MalBool(args.first is MalSymbol); }), 'keyword': new MalBuiltin((List args) { if (args.first is MalKeyword) return args.first; return new MalKeyword((args.first as MalString).value); }), 'keyword?': new MalBuiltin((List args) { return new MalBool(args.first is MalKeyword); }), 'number?': new MalBuiltin((List args) { return new MalBool(args.first is MalInt); }), 'fn?': new MalBuiltin((List args) { return new MalBool(args.first is MalCallable && !(args.first.isMacro)); }), 'macro?': new MalBuiltin((List args) { return new MalBool(args.first is MalCallable && args.first.isMacro); }), 'vector': new MalBuiltin((List args) { return new MalVector(args); }), 'vector?': new MalBuiltin((List args) { return new MalBool(args.first is MalVector); }), 'hash-map': new MalBuiltin((List args) { return new MalHashMap.fromSequence(args); }), 'map?': new MalBuiltin((List args) { return new MalBool(args.first is MalHashMap); }), 'assoc': new MalBuiltin((List args) { var map = args.first as MalHashMap; var assoc = new MalHashMap.fromSequence(args.skip(1).toList()); var newMap = new Map.from(map.value); newMap.addAll(assoc.value); return new MalHashMap(newMap); }), 'dissoc': new MalBuiltin((List args) { var map = args.first as MalHashMap; var newMap = new Map.from(map.value); for (var key in args.skip(1)) { newMap.remove(key); } return new MalHashMap(newMap); }), 'get': new MalBuiltin((List args) { if (args[0] is MalNil) return new MalNil(); var map = args[0] as MalHashMap; var key = args[1]; return map.value[key] ?? new MalNil(); }), 'contains?': new MalBuiltin((List args) { var map = args[0] as MalHashMap; var key = args[1]; return new MalBool(map.value.containsKey(key)); }), 'keys': new MalBuiltin((List args) { return new MalList((args.first as MalHashMap).value.keys.toList()); }), 'vals': new MalBuiltin((List args) { return new MalList((args.first as MalHashMap).value.values.toList()); }), 'sequential?': new MalBuiltin((List args) { return new MalBool(args.first is MalList || args.first is MalVector); }), 'readline': new MalBuiltin((List args) { var message = args.first as MalString; stdout.write(message.value); var input = stdin.readLineSync(); if (input == null) return new MalNil(); return new MalString(input); }), 'time-ms': new MalBuiltin((List args) { assert(args.isEmpty); return new MalInt(new DateTime.now().millisecondsSinceEpoch); }), 'conj': new MalBuiltin((List args) { var collection = args.first; var elements = args.sublist(1); if (collection is MalList) { return new MalList( elements.reversed.toList()..addAll(collection.elements)); } if (collection is MalVector) { return new MalVector(collection.elements.toList()..addAll(elements)); } throw new MalException(new MalString('"conj" takes a list or vector')); }), 'string?': new MalBuiltin((List args) { return new MalBool(args.first is MalString); }), 'seq': new MalBuiltin((List args) { var arg = args.first; if (arg is MalIterable && arg.isEmpty) return new MalNil(); if (arg is MalString && arg.value.isEmpty) return new MalNil(); if (arg is MalNil || arg is MalList) return arg; if (arg is MalVector) return new MalList(arg.elements.toList()); if (arg is MalString) { var chars = []; for (var i = 0; i < arg.value.length; i++) { chars.add(new MalString(arg.value[i])); } return new MalList(chars); } throw new MalException(new MalString('bad argument to "seq"')); }), 'map': new MalBuiltin((List args) { var fn = args[0] as MalCallable; var list = args[1] as MalIterable; var newList = []; for (var element in list) { newList.add(fn.call([element])); } return new MalList(newList); }), 'apply': new MalBuiltin((List args) { var func = args.first as MalCallable; var argList = args.last as MalIterable; var newArgs = args.sublist(1, args.length - 1); newArgs.addAll(argList); return func.call(newArgs); }), 'meta': new MalBuiltin((List args) { var arg = args.first; return arg.meta ?? new MalNil(); }), 'with-meta': new MalBuiltin((List args) { var evaled = args.first; var evaledWithMeta = evaled.clone(); evaledWithMeta.meta = args[1]; return evaledWithMeta; }), }; ================================================ FILE: impls/dart/env.dart ================================================ import 'types.dart'; class Env { final Env outer; final data = {}; Env([this.outer, List binds, List exprs]) { if (binds == null) { assert(exprs == null); } else { assert(exprs != null && (binds.length == exprs.length || binds.contains(new MalSymbol('&')))); for (var i = 0; i < binds.length; i++) { if (binds[i].value == '&') { set(binds[i + 1].value, new MalList(exprs.sublist(i))); break; } set(binds[i].value, exprs[i]); } } } void set(String key, MalType value) { data[key] = value; } MalType get(String key) { var value = data[key]; if (value != null) { return value; } if (outer != null) { return outer.get(key); } return null; } } class NotFoundException implements Exception { /// The name of the symbol that was not found. final String value; NotFoundException(this.value); String toString() => "'$value' not found"; } ================================================ FILE: impls/dart/printer.dart ================================================ import 'types.dart'; String pr_str(MalType data, {bool print_readably: true}) { if (data is MalSymbol) { return data.value; } else if (data is MalInt) { return '${data.value}'; } else if (data is MalList) { var printedElements = data.elements.map((e) => pr_str(e, print_readably: print_readably)); return '(${printedElements.join(" ")})'; } else if (data is MalVector) { var printedElements = data.elements.map((e) => pr_str(e, print_readably: print_readably)); return '[${printedElements.join(" ")}]'; } else if (data is MalHashMap) { var printedElements = []; data.value.forEach((key, value) { printedElements.add(pr_str(key, print_readably: print_readably)); printedElements.add(pr_str(value, print_readably: print_readably)); }); return '{${printedElements.join(" ")}}'; } else if (data is MalString) { if (print_readably) { var readableValue = data.value .replaceAll('\\', r'\\') .replaceAll('\n', r'\n') .replaceAll('\"', r'\"'); return '"$readableValue"'; } else { return '${data.value}'; } } else if (data is MalKeyword) { return ':${data.value}'; } else if (data is MalBool) { return '${data.value}'; } else if (data is MalNil) { return 'nil'; } else if (data is MalBuiltin) { return '#'; } else if (data is MalClosure) { return '#'; } else if (data is MalAtom) { return "(atom ${pr_str(data.value, print_readably: print_readably)})"; } throw new ArgumentError("Unrecognized type: ${data.runtimeType}"); } ================================================ FILE: impls/dart/pubspec.yaml ================================================ name: mal author: Harry Terkelsen version: 0.0.1 ================================================ FILE: impls/dart/reader.dart ================================================ import 'types.dart'; final malRegExp = new RegExp( r"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)"""); final strRegExp = new RegExp( r"""^"(?:\\.|[^\\"])*"$"""); class Reader { final List tokens; int _position = 0; Reader(this.tokens); String next() { var token = peek(); _position++; return token; } String peek() { if (_position >= tokens.length) return null; return tokens[_position]; } } class ParseException implements Exception { final String message; ParseException(this.message); } class NoInputException implements Exception {} MalType read_str(String code) { var tokens = tokenizer(code); if (tokens.isEmpty) { throw new NoInputException(); } var reader = new Reader(tokens); return read_form(reader); } List tokenizer(String code) { var matches = malRegExp.allMatches(code); return matches .map((m) => m.group(1)) .where((token) => token.isNotEmpty && !token.startsWith(';')) .toList(); } MalType read_form(Reader reader) { const macros = const { "'": 'quote', '`': 'quasiquote', '~': 'unquote', '~@': 'splice-unquote', '@': 'deref', '^': 'with-meta', }; const sequenceStarters = const {'(': ')', '[': ']', '{': '}'}; var token = reader.peek(); if (sequenceStarters.containsKey(token)) { var elements = read_sequence(reader, token, sequenceStarters[token]); if (token == '(') { return new MalList(elements); } if (token == '[') { return new MalVector(elements); } if (token == '{') { return new MalHashMap.fromSequence(elements); } throw new StateError("Impossible!"); } else if (macros.containsKey(token)) { var macro = new MalSymbol(macros[token]); reader.next(); var form = read_form(reader); if (token == '^') { var meta = read_form(reader); return new MalList([macro, meta, form]); } else { return new MalList([macro, form]); } } else { return read_atom(reader); } } List read_sequence(Reader reader, String open, String close) { // Consume opening token var actualOpen = reader.next(); assert(actualOpen == open); var elements = []; for (var token = reader.peek();; token = reader.peek()) { if (token == null) { throw new ParseException("expected '$close', got EOF"); } if (token == close) break; elements.add(read_form(reader)); } var actualClose = reader.next(); assert(actualClose == close); return elements; } MalType read_atom(Reader reader) { var token = reader.next(); var intAtom = int.parse(token, onError: (_) => null); if (intAtom != null) { return new MalInt(intAtom); } if (strRegExp.matchAsPrefix(token) != null) { var sanitizedToken = token // remove surrounding quotes .substring(1, token.length - 1) .replaceAllMapped(new RegExp("\\\\(.)"), (Match m) => m[1] == 'n' ? '\n' : m[1]); return new MalString(sanitizedToken); } if (token[0] == '"') { throw new ParseException("expected '\"', got EOF"); } if (token[0] == ':') { return new MalKeyword(token.substring(1)); } if (token == 'nil') { return new MalNil(); } if (token == 'true') { return new MalBool(true); } if (token == 'false') { return new MalBool(false); } return new MalSymbol(token); } ================================================ FILE: impls/dart/run ================================================ #!/usr/bin/env bash exec dart --checked $(dirname $0)/${STEP:-stepA_mal}.dart "${@}" ================================================ FILE: impls/dart/step0_repl.dart ================================================ import 'dart:io'; String READ(String x) => x; String EVAL(String x) => x; String PRINT(String x) => x; String rep(String x) => PRINT(EVAL(READ(x))); const prompt = 'user> '; main() { while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output = rep(input); stdout.writeln(output); } } ================================================ FILE: impls/dart/step1_read_print.dart ================================================ import 'dart:io'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType x) => x; String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x))); } const prompt = 'user> '; main() { while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step2_eval.dart ================================================ import 'dart:io'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Map replEnv = { '+': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value + b.value); }), '-': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value - b.value); }), '*': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value * b.value); }), '/': new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value ~/ b.value); }) }; MalType READ(String x) => reader.read_str(x); class NotFoundException implements Exception { /// The name of the symbol that was not found. final String value; NotFoundException(this.value); } MalType EVAL(MalType ast, Map env) { // stdout.writeln("EVAL: ${printer.pr_str(ast)}"); if (ast is MalSymbol) { var result = env[ast.value]; if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. var forms = (ast as MalList).elements; if (forms.isEmpty) { return ast; } else { MalBuiltin f = EVAL(forms.first, env); List args = forms.sublist(1).map((x) => EVAL(x, env)).toList(); return f.call(args); } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main() { while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step3_env.dart ================================================ import 'dart:io'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv() { replEnv.set('+', new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value + b.value); })); replEnv.set('-', new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value - b.value); })); replEnv.set('*', new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value * b.value); })); replEnv.set('/', new MalBuiltin((List args) { var a = args[0] as MalInt; var b = args[1] as MalInt; return new MalInt(a.value ~/ b.value); })); } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } return EVAL(args[1], newEnv); } } MalBuiltin f = EVAL(list.elements.first, env); List args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); return f.call(args); } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main() { setupEnv(); while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step4_if_fn_do.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv() { ns.forEach((sym, fun) => replEnv.set(sym, fun)); rep('(def! not (fn* (a) (if a false true)))'); } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } return EVAL(args[1], newEnv); } else if (symbol.value == "do") { return args.map((e) => EVAL(e, env)).toList().last; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } return EVAL(args[2], env); } else { // True side of branch return EVAL(args[1], env); } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } } var f = EVAL(list.elements.first, env); var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalCallable) { return f.call(args); } else { throw 'bad!'; } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main() { setupEnv(); while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step5_tco.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv() { ns.forEach((sym, fun) => replEnv.set(sym, fun)); rep('(def! not (fn* (a) (if a false true)))'); } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } } var f = EVAL(list.elements.first, env); var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main() { setupEnv(); while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step6_file.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv(List argv) { // TODO(het): use replEnv#set once generalized tearoffs are implemented ns.forEach((sym, fun) => replEnv.set(sym, fun)); replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } } var f = EVAL(list.elements.first, env); var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main(List args) { setupEnv(args.isEmpty ? const [] : args.sublist(1)); if (args.isNotEmpty) { rep("(load-file \"${args.first}\")"); return; } while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step7_quote.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv(List argv) { // TODO(het): use replEnv#set once generalized tearoffs are implemented ns.forEach((sym, fun) => replEnv.set(sym, fun)); replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); } bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } 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 { return ast; } } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).elements.isEmpty) { return ast; } else { var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; } } var f = EVAL(list.elements.first, env); var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main(List args) { setupEnv(args.isEmpty ? const [] : args.sublist(1)); if (args.isNotEmpty) { rep("(load-file \"${args.first}\")"); return; } while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step8_macros.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond " " (fn* (& xs) (if (> (count xs) 0) " " (list 'if (first xs) " " (if (> (count xs) 1) " " (nth xs 1) " " (throw \"odd number of forms to cond\")) " " (cons 'cond (rest (rest xs)))))))"); } bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } 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 { return ast; } } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; } } var f = EVAL(list.elements.first, env); if (f is MalCallable && f.isMacro) { ast = f.call(list.elements.sublist(1)); continue; } var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main(List args) { setupEnv(args.isEmpty ? const [] : args.sublist(1)); if (args.isNotEmpty) { rep("(load-file \"${args.first}\")"); return; } while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/step9_try.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond " " (fn* (& xs) (if (> (count xs) 0) " " (list 'if (first xs) " " (if (> (count xs) 1) " " (nth xs 1) " " (throw \"odd number of forms to cond\")) " " (cons 'cond (rest (rest xs)))))))"); } bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } 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 { return ast; } } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; } else if (symbol.value == 'try*') { var body = args.first; if (args.length < 2) { ast = EVAL(body, env); continue; } var catchClause = args[1] as MalList; try { return EVAL(body, env); } catch (e) { assert((catchClause.first as MalSymbol).value == 'catch*'); var exceptionSymbol = catchClause[1] as MalSymbol; var catchBody = catchClause[2]; MalType exceptionValue; if (e is MalException) { exceptionValue = e.value; } else if (e is reader.ParseException) { exceptionValue = new MalString(e.message); } else { exceptionValue = new MalString(e.toString()); } var newEnv = new Env(env, [exceptionSymbol], [exceptionValue]); ast = EVAL(catchBody, newEnv); } continue; } } var f = EVAL(list.elements.first, env); if (f is MalCallable && f.isMacro) { ast = f.call(list.elements.sublist(1)); continue; } var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main(List args) { setupEnv(args.isEmpty ? const [] : args.sublist(1)); if (args.isNotEmpty) { rep("(load-file \"${args.first}\")"); return; } while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/stepA_mal.dart ================================================ import 'dart:io'; import 'core.dart'; import 'env.dart'; import 'printer.dart' as printer; import 'reader.dart' as reader; import 'types.dart'; final Env replEnv = new Env(); void setupEnv(List argv) { ns.forEach((sym, fun) => replEnv.set(sym, fun)); replEnv.set('eval', new MalBuiltin((List args) => EVAL(args.single, replEnv))); replEnv.set('*ARGV*', new MalList(argv.map((s) => new MalString(s)).toList())); replEnv.set('*host-language*', new MalString('dart')); rep('(def! not (fn* (a) (if a false true)))'); rep("(def! load-file " " (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond " " (fn* (& xs) (if (> (count xs) 0) " " (list 'if (first xs) " " (if (> (count xs) 1) " " (nth xs 1) " " (throw \"odd number of forms to cond\")) " " (cons 'cond (rest (rest xs)))))))"); } bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } 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 { return ast; } } MalType READ(String x) => reader.read_str(x); MalType EVAL(MalType ast, Env env) { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalBool && dbgeval.value == false)) { stdout.writeln("EVAL: ${printer.pr_str(ast)}"); } if (ast is MalSymbol) { var result = env.get(ast.value); if (result == null) { throw new NotFoundException(ast.value); } return result; } else if (ast is MalList) { // Exit this switch. } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { var newMap = new Map.from(ast.value); for (var key in newMap.keys) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); } else { return ast; } // ast is a list. todo: indent left. if ((ast as MalList).isEmpty) return ast; var list = ast as MalList; if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); env.set(key.value, value); return value; } else if (symbol.value == "defmacro!") { MalSymbol key = args.first; MalClosure macro = (EVAL(args[1], env) as MalClosure).clone(); macro.isMacro = true; env.set(key.value, macro); return macro; } else if (symbol.value == "let*") { // TODO(het): If elements.length is not even, give helpful error Iterable> pairs(List elements) sync* { for (var i = 0; i < elements.length; i += 2) { yield [elements[i], elements[i + 1]]; } } var newEnv = new Env(env); MalIterable bindings = args.first; for (var pair in pairs(bindings.elements)) { MalSymbol key = pair[0]; MalType value = EVAL(pair[1], newEnv); newEnv.set(key.value, value); } ast = args[1]; env = newEnv; continue; } else if (symbol.value == "do") { for (var elt in args.sublist(0, args.length - 1)) { EVAL(elt, env); } ast = args.last; continue; } else if (symbol.value == "if") { var condition = EVAL(args[0], env); if (condition is MalNil || condition is MalBool && condition.value == false) { // False side of branch if (args.length < 3) { return new MalNil(); } ast = args[2]; continue; } else { // True side of branch ast = args[1]; continue; } } else if (symbol.value == "fn*") { var params = (args[0] as MalIterable) .elements .map((e) => e as MalSymbol) .toList(); return new MalClosure( params, args[1], env, (List funcArgs) => EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; } else if (symbol.value == 'try*') { var body = args.first; if (args.length < 2) { ast = EVAL(body, env); continue; } var catchClause = args[1] as MalList; try { return EVAL(body, env); } catch (e) { assert((catchClause.first as MalSymbol).value == 'catch*'); var exceptionSymbol = catchClause[1] as MalSymbol; var catchBody = catchClause[2]; MalType exceptionValue; if (e is MalException) { exceptionValue = e.value; } else if (e is reader.ParseException) { exceptionValue = new MalString(e.message); } else { exceptionValue = new MalString(e.toString()); } var newEnv = new Env(env, [exceptionSymbol], [exceptionValue]); ast = EVAL(catchBody, newEnv); } continue; } } var f = EVAL(list.elements.first, env); if (f is MalCallable && f.isMacro) { ast = f.call(list.elements.sublist(1)); continue; } var args = list.elements.sublist(1).map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { ast = f.ast; env = new Env(f.env, f.params, args); continue; } else { throw 'bad!'; } } } String PRINT(MalType x) => printer.pr_str(x); String rep(String x) { return PRINT(EVAL(READ(x), replEnv)); } const prompt = 'user> '; main(List args) { setupEnv(args.isEmpty ? const [] : args.sublist(1)); if (args.isNotEmpty) { rep("(load-file \"${args.first}\")"); return; } rep("(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { stdout.write(prompt); var input = stdin.readLineSync(); if (input == null) return; var output; try { output = rep(input); } on reader.ParseException catch (e) { stdout.writeln("Error: '${e.message}'"); continue; } on NotFoundException catch (e) { stdout.writeln("Error: '${e.value}' not found"); continue; } on MalException catch (e) { stdout.writeln("Error: ${printer.pr_str(e.value)}"); continue; } on reader.NoInputException { continue; } stdout.writeln(output); } } ================================================ FILE: impls/dart/types.dart ================================================ import 'dart:collection'; import 'env.dart'; abstract class MalType { bool get isMacro => false; MalType meta; MalType clone(); } abstract class MalIterable extends MalType with ListMixin implements List { final List elements; MalIterable(this.elements); MalType operator [](int index) => elements[index]; void operator []=(int index, MalType value) { elements[index] = value; } int get length => elements.length; void set length(int newLength) { elements.length = newLength; } bool operator ==(other) { if (other is! MalIterable) return false; // apparently (= (list) nil) should be false... if (other is MalNil) return false; if (elements.length != other.elements.length) return false; for (var i = 0; i < elements.length; i++) { if (elements[i] != other.elements[i]) return false; } return true; } @override MalIterable clone(); } class MalList extends MalIterable { MalList(List elements) : super(elements); @override MalList clone() { return new MalList(elements.toList()); } } class MalVector extends MalIterable { MalVector(List elements) : super(elements); @override MalVector clone() { return new MalVector(elements.toList()); } } class MalHashMap extends MalType { final Map value; MalHashMap(this.value); MalHashMap.fromSequence(List elements) : value = _mapFromSequence(elements); static Map _mapFromSequence(List elements) { var result = {}; var readingKey = true; MalType pendingKey; for (var malType in elements) { if (readingKey) { if (malType is MalString || malType is MalKeyword) { pendingKey = malType; } else { throw new ArgumentError('hash-map keys must be strings or keywords'); } } else { result[pendingKey] = malType; } readingKey = !readingKey; } return result; } bool operator ==(other) { if (other is! MalHashMap) return false; var otherMap = (other as MalHashMap).value; if (otherMap.length != value.length) return false; for (var key in value.keys) { if (!otherMap.containsKey(key)) return false; if (value[key] != otherMap[key]) return false; } return true; } @override MalHashMap clone() { return new MalHashMap(new Map.from(value)); } } class MalInt extends MalType { final int value; MalInt(this.value); bool operator ==(other) { if (other is! MalInt) return false; return other.value == value; } @override MalInt clone() { return new MalInt(value); } } class MalSymbol extends MalType { final String value; MalSymbol(this.value); int get hashCode => value.hashCode; bool operator ==(other) { if (other is! MalSymbol) return false; return value == other.value; } @override MalSymbol clone() { return new MalSymbol(value); } } class MalKeyword extends MalType { final String value; MalKeyword(this.value); int get hashCode => value.hashCode; bool operator ==(other) { if (other is! MalKeyword) return false; return value == other.value; } @override MalKeyword clone() { return new MalKeyword(value); } } class MalString extends MalType { final String value; MalString(this.value); int get hashCode => value.hashCode; bool operator ==(other) { if (other is! MalString) return false; return other.value == value; } @override MalString clone() { return new MalString(value); } } class MalBool extends MalType { final bool value; MalBool(this.value); bool operator ==(other) { if (other is! MalBool) return false; return other.value == value; } @override MalBool clone() { return new MalBool(value); } } class MalNil extends MalIterable { MalNil() : super(const []); bool operator ==(other) => other is MalNil; @override MalNil clone() { return new MalNil(); } } class MalAtom extends MalType { MalType value; MalAtom(this.value); @override MalAtom clone() { return new MalAtom(value); } } abstract class MalCallable extends MalType { MalType call(List args); bool get isMacro => false; } typedef MalType BuiltinFunc(List args); class MalBuiltin extends MalCallable { final BuiltinFunc func; MalBuiltin(this.func); MalType call(List args) { return func(args); } @override MalBuiltin clone() { return new MalBuiltin(func); } } typedef MalType EvalFun(MalType ast, Env env); class MalClosure extends MalCallable { final List params; final MalType ast; final Env env; final Function func; @override bool isMacro = false; MalClosure(this.params, this.ast, this.env, this.func); MalType call(List args) { return func(args); } @override MalClosure clone() { var closure = new MalClosure(this.params.toList(), this.ast, this.env, this.func); closure.isMacro = this.isMacro; return closure; } } class MalException implements Exception { final MalType value; MalException(this.value); } ================================================ FILE: impls/elisp/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install emacs-nox ================================================ FILE: impls/elisp/Makefile ================================================ all: emacs -Q --batch -L . --eval '(byte-recompile-directory "." 0)' # For debugging, it is sometimes useful to attempt a run without byte compation. nocompile: clean exec emacs -Q --batch -L . --eval "(setq text-quoting-style 'straight)" --load stepA_mal.el clean: rm -f *.elc *~ mal/*.elc mal/*~ ================================================ FILE: impls/elisp/mal/core.el ================================================ (require 'seq) (require 'mal/types) (defun mal-boolean (value) (if value mal-true mal-false)) (defun mal-= (a b) (let (va vb) (cond ((or (setq va (mal-seq-value a)) (mal-list-p a)) (and (or (setq vb (mal-seq-value b)) (mal-list-p b)) (mal-seq-= va vb))) ((setq va (mal-number-value a)) (equal va (mal-number-value b))) ((setq va (mal-string-value a)) (equal va (mal-string-value b))) ((setq va (mal-symbol-value a)) (eq va (mal-symbol-value b))) ((setq va (mal-keyword-value a)) (equal va (mal-keyword-value b))) ((setq va (mal-map-value a)) (and (setq vb (mal-map-value b)) (mal-map-= va vb))) (t (eq a b))))) (defun mal-seq-= (a b) (let* ((len (seq-length a)) (res (= len (seq-length b)))) (while (and res (< 0 len)) (setq len (1- len)) (unless (mal-= (seq-elt a len) (seq-elt b len)) (setq res nil))) res)) (defun mal-map-= (a b) (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 (value) (cond ((setq value (mal-vector-value seq)) (mal-vector (vconcat value args))) ((setq value (mal-list-value seq)) (mal-list (append (reverse args) value))) ((mal-list-p seq) (mal-list (reverse args))) (t (error "seq: bad type"))))) (defun elisp-to-mal (arg) (cond ((not arg) mal-nil) ((eq arg t) mal-true) ((numberp arg) (mal-number arg)) ((stringp arg) (mal-string arg)) ((keywordp arg) (mal-keyword (symbol-name arg))) ((symbolp arg) (mal-symbol arg)) ((consp arg) (mal-list (mapcar 'elisp-to-mal arg))) ((vectorp arg) (mal-vector (vconcat (mapcar 'elisp-to-mal arg)))) ((hash-table-p arg) (let ((output (make-hash-table :test 'mal-=))) (maphash (lambda (key value) (puthash (elisp-to-mal key) (elisp-to-mal value) output)) arg) (mal-map output))) (t ;; represent anything else as printed arg (mal-string (format "%S" arg))))) (defconst core-ns '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))) (< . (lambda (a b) (mal-boolean (< (mal-number-value a) (mal-number-value b))))) (<= . (lambda (a b) (mal-boolean (<= (mal-number-value a) (mal-number-value b))))) (> . (lambda (a b) (mal-boolean (> (mal-number-value a) (mal-number-value b))))) (>= . (lambda (a b) (mal-boolean (>= (mal-number-value a) (mal-number-value b))))) (= . (lambda (a b) (mal-boolean (mal-= a b)))) (list . (lambda (&rest args) (mal-list args))) (list? . (lambda (mal-object) (mal-boolean (mal-list-p mal-object)))) (empty? . (lambda (seq) (mal-boolean (seq-empty-p (mal-seq-value seq))))) (count . (lambda (seq) (mal-number (length (mal-seq-value seq))))) (pr-str . (lambda (&rest args) (mal-string (pr-join args t " ")))) (str . (lambda (&rest args) (mal-string (pr-join args nil "")))) (prn . (lambda (&rest args) (println (pr-join args t " ")) mal-nil)) (println . (lambda (&rest args) (println (pr-join args nil " ")) mal-nil)) (read-string . (lambda (input) (read-str (mal-string-value input)))) (slurp . (lambda (file) (with-temp-buffer (insert-file-contents-literally (mal-string-value file)) (mal-string (buffer-string))))) (atom . mal-atom) (atom? . (lambda (mal-object) (mal-boolean (mal-atom-value mal-object)))) (deref . mal-atom-value) (reset! . (lambda (atom value) (mal-reset atom value) value)) (swap! . (lambda (atom fn &rest args) (let ((value (apply (or (mal-func-value fn) (mal-fn-core-value fn)) (mal-atom-value atom) args))) (mal-reset atom value) value))) (vec . (lambda (seq) (if (mal-vector-value seq) seq (mal-vector (seq-into (mal-list-value seq) 'vector))))) (cons . (lambda (arg seq) (let ((value (mal-vector-value seq))) (mal-list (cons arg (if value (seq-into value 'list) (mal-list-value seq))))))) (concat . (lambda (&rest lists) (mal-list (seq-mapcat 'mal-seq-value lists 'list)))) (nth . (lambda (seq index) (let ((list (mal-seq-value seq)) (i (mal-number-value index))) ;; seq-elt returns nil for a list and a bad index (or (seq-elt (mal-seq-value seq) (mal-number-value index)) (error "Args out of range: %s, %d" (pr-str seq t) i))))) (first . (lambda (seq) (let ((value (mal-seq-value seq))) (if (seq-empty-p value) mal-nil (seq-first value))))) (rest . (lambda (seq) (let ((value(mal-vector-value seq))) (mal-list (cdr (if value (seq-into value 'list) (mal-list-value seq))))))) (throw . (lambda (mal-object) (signal 'mal-custom (list mal-object)))) (apply . (lambda (fn &rest args) (let ((butlast (butlast args)) (last (mal-seq-value (car (last args)))) (fn* (or (mal-func-value fn) (mal-fn-core-value fn) (mal-macro-value fn)))) (apply fn* (seq-concatenate 'list butlast last))))) (map . (lambda (fn seq) (mal-list (mapcar (or (mal-func-value fn) (mal-fn-core-value fn)) (mal-seq-value seq))))) (nil? . (lambda (arg) (mal-boolean (eq mal-nil arg)))) (true? . (lambda (arg) (mal-boolean (eq mal-true arg)))) (false? . (lambda (arg) (mal-boolean (eq mal-false arg)))) (number? . (lambda (arg) (mal-boolean (mal-number-value arg)))) (symbol? . (lambda (arg) (mal-boolean (mal-symbol-value arg)))) (keyword? . (lambda (arg) (mal-boolean (mal-keyword-value arg)))) (string? . (lambda (arg) (mal-boolean (mal-string-value arg)))) (vector? . (lambda (arg) (mal-boolean (mal-vector-value arg)))) (map? . (lambda (arg) (mal-boolean (mal-map-value arg)))) (symbol . (lambda (string) (mal-symbol (intern (mal-string-value string))))) (keyword . (lambda (x) (let ((value (mal-string-value x))) (if value (mal-keyword (concat ":" value)) x)))) (vector . (lambda (&rest args) (mal-vector (seq-into args 'vector)))) (hash-map . (lambda (&rest args) (let ((map (make-hash-table :test 'mal-=))) (while args (puthash (pop args) (pop args) map)) (mal-map map)))) (sequential? . (lambda (mal-object) (mal-boolean (or (mal-list-p mal-object) (mal-vector-value mal-object))))) (fn? . (lambda (arg) (mal-boolean (or (mal-fn-core-value arg) (mal-func-value arg))))) (macro? . (lambda (arg) (mal-boolean (mal-macro-value arg)))) (get . (lambda (map key) (or (let ((value (mal-map-value map))) (when value (gethash key value))) mal-nil))) (contains? . (lambda (map key) (mal-boolean (gethash key (mal-map-value map))))) (assoc . (lambda (map &rest args) (let ((map* (copy-hash-table (mal-map-value map)))) (while args (puthash (pop args) (pop args) map*)) (mal-map map*)))) (dissoc . (lambda (map &rest args) (let ((map* (copy-hash-table (mal-map-value map)))) (dolist (k args) (remhash k map*)) (mal-map map*)))) (keys . (lambda (map) (let (keys) (maphash (lambda (key _value) (push key keys)) (mal-map-value map)) (mal-list keys)))) (vals . (lambda (map) (let (vals) (maphash (lambda (_key value) (push value vals)) (mal-map-value map)) (mal-list vals)))) (readline . (lambda (prompt) (or (mal-string (readln (mal-string-value prompt))) mal-nil))) (meta . mal-meta) (with-meta . with-meta) (time-ms . (lambda () (mal-number (floor (* (float-time) 1000))))) (conj . mal-conj) (seq . (lambda (mal-object) (let (value) (or (cond ((setq value (mal-list-value mal-object)) mal-object) ((and (setq value (mal-vector-value mal-object)) (not (seq-empty-p value))) (mal-list (seq-into value 'list))) ((and (setq value (mal-string-value mal-object)) (not (seq-empty-p value))) (mal-list (mapcar (lambda (item) (mal-string (char-to-string item))) value)))) mal-nil)))) (elisp-eval . (lambda (string) (elisp-to-mal (eval (read (mal-string-value string)))))) )) (provide 'mal/core) ================================================ FILE: impls/elisp/mal/env.el ================================================ (require 'mal/types) ;; An env is represented by an elisp list of hash-tables. In other words ;; * car: a hash-table ;; * cdr: the outer environment or () ;; Keys are elisp symbols. (defun mal-env (&optional outer binds exprs) (let ((env (cons (make-hash-table :test 'eq) outer)) key) (while (setq key (pop binds)) (if (eq key '&) (mal-env-set env (pop binds) (mal-list exprs)) (mal-env-set env key (pop exprs)))) env)) (defun mal-env-set (env key value) (let ((data (car env))) (puthash key value data))) (defun mal-env-get (env key) (let (value) (while (and (not (setq value (gethash key (pop env)))) env)) value)) (provide 'mal/env) ================================================ FILE: impls/elisp/mal/printer.el ================================================ (require 'mal/types) (defun pr-str (form print-readably) (let (value) (cond ((eq mal-nil form) "nil") ((eq mal-true form) "true") ((eq mal-false form) "false") ((setq value (mal-number-value form)) (number-to-string value)) ((setq value (mal-string-value form)) (if print-readably (let ((print-escape-newlines t)) (prin1-to-string value)) value)) ((setq value (mal-symbol-value form)) (symbol-name value)) ((setq value (mal-keyword-value form)) value) ((setq value (mal-list-value form)) (pr-list value print-readably)) ((mal-list-p form) "()") ((setq value (mal-vector-value form)) (pr-vector value print-readably)) ((setq value (mal-map-value form)) (pr-map value print-readably)) ((or (mal-fn-core-value form) (mal-func-value form)) "#") ((mal-macro-value form) "#") ((setq value (mal-atom-value form)) (format "(atom %s)" (pr-str value print-readably))) (t (error "pr-str: unknown type: %s" form))))) (defun pr-list (form print-readably) (let ((items (pr-join form print-readably " "))) (concat "(" items ")"))) (defun pr-vector (form print-readably) (let ((items (pr-join form print-readably " "))) (concat "[" items "]"))) (defun pr-map (form print-readably) (let (pairs) (maphash (lambda (key value) (push value pairs) (push key pairs)) form) (let ((items (pr-join pairs print-readably " "))) (concat "{" items "}")))) (defun pr-join (forms print-readably separator) (mapconcat (lambda (item) (pr-str item print-readably)) forms separator)) (provide 'mal/printer) ================================================ FILE: impls/elisp/mal/reader.el ================================================ (require 'mal/types) ;; HACK: `text-quoting-style' prettifies quotes in error messages on ;; Emacs 25, but no longer does from 26 upwards... (when (= emacs-major-version 25) (setq text-quoting-style 'grave)) (defvar reader--tokens nil) (defun peek () (car reader--tokens)) (defun next () (pop reader--tokens)) (defun read-str (input) (setq reader--tokens (tokenizer input)) (read-form)) (defun tokenizer (input) (let (output) (with-temp-buffer (insert input) (goto-char (point-min)) (while (not (eobp)) (when (looking-at token-re) (let ((token (match-string 1))) (if (= (length token) 0) (let ((remainder (buffer-substring (point) (point-max)))) (push remainder output) (goto-char (point-max))) (when (not (string-match-p comment-re token)) (push token output)) (goto-char (match-end 1)))))) (nreverse output)))) (defun read-form () (pcase (peek) ("'" (read-quote)) ("`" (read-quasiquote)) ("~" (read-unquote)) ("~@" (read-splice-unquote)) ("@" (read-deref)) ("^" (read-with-meta)) ("(" (read-list)) ("[" (read-vector)) ("{" (read-map)) (_ ;; assume anything else is an atom (read-atom)))) (defun read-simple-reader-macro (symbol) (next) ; pop reader macro token ;; turn form into (symbol form) (mal-list (list (mal-symbol symbol) (read-form)))) (defun read-quote () (read-simple-reader-macro 'quote)) (defun read-quasiquote () (read-simple-reader-macro 'quasiquote)) (defun read-unquote () (read-simple-reader-macro 'unquote)) (defun read-splice-unquote () (read-simple-reader-macro 'splice-unquote)) (defun read-deref () (read-simple-reader-macro 'deref)) (defun read-with-meta () (next) ; pop with-meta token (let ((meta (read-form))) (mal-list (list (mal-symbol 'with-meta) (read-form) meta)))) (defun read-list () (next) ; pop list start (let (output end-of-list) (while (not end-of-list) (let ((token (peek))) (cond ((string= token ")") (next) ; pop list end (setq end-of-list t)) ((not token) (signal 'unterminated-sequence '(list))) (t (push (read-form) output))))) (mal-list (nreverse output)))) (defun read-vector () (next) ; pop vector start (let (output end-of-vector) (while (not end-of-vector) (let ((token (peek))) (cond ((string= token "]") (next) ; pop vector end (setq end-of-vector t)) ((not token) (signal 'unterminated-sequence '(vector))) (t (push (read-form) output))))) (mal-vector (vconcat (nreverse output))))) ;; HACK overriden by core.el in later steps (define-hash-table-test 'mal-= 'equal 'sxhash) (defun read-map () (next) ; pop map start (let ((output (make-hash-table :test 'mal-=)) end-of-map) (while (not end-of-map) (let ((token (peek))) (cond ((string= token "}") (next) ; pop map end (setq end-of-map t)) ((not token) (signal 'unterminated-sequence '(map))) (t (puthash (read-form) (read-form) output))))) (mal-map output))) (defun read-atom () (let ((token (next))) (if token (cond ((string= token "nil") mal-nil) ((string= token "true") mal-true) ((string= token "false") mal-false) ((string-match number-re token) (mal-number (string-to-number token))) ((= (aref token 0) ?\") (if (string-match string-re token) (mal-string (read token)) (signal 'unterminated-sequence '(string)))) ((= (aref token 0) ?:) (mal-keyword token)) (t ;; assume anything else is a symbol (mal-symbol (intern token)))) (signal 'end-of-token-stream nil)))) (provide 'mal/reader) ================================================ FILE: impls/elisp/mal/types.el ================================================ ;; Structural pattern matching is ideal, but too slow for MAL. ;; So we use a mal-foo-value getter that returns nil in case of bad ;; type (or if a list is empty, unfortunately). (defmacro mal-object (name) (let ((constructor (intern (format "mal-%s" name))) (accessor (intern (format "mal-%s-value" name)))) `(progn (defsubst ,constructor (value) (record ',name value)) (defun ,accessor (arg) (and (recordp arg) (eq (aref arg 0) ',name) (aref arg 1)))))) (defconst mal-nil #&8"n") (defconst mal-false #&8"f") (defconst mal-true #&8"t") (defsubst mal-number (elisp-number) elisp-number) (defsubst mal-number-value (obj) (and (numberp obj) obj)) (defsubst mal-symbol (elisp-symbol) elisp-symbol) ;; A nil result means either 'not a symbol' or 'the nil symbol'. (defsubst mal-symbol-value (obj) (and (symbolp obj)obj)) (defsubst mal-string (elisp-string) elisp-string) (defsubst mal-string-value (obj) (and (stringp obj) obj)) ;; In elisp, keywords are symbols. Using them would cause confusion, ;; or at least make mal-symbol-value more complex, for little benefit. ;; The wrapped value is an elisp string including the initial colon. (mal-object keyword) ;; Use the native type when possible, but #s(type value meta ...) for ;; the empty list or when metadata is present. (defsubst mal-vector (elisp-vector) elisp-vector) (defun mal-vector-value (obj) (if (vectorp obj) obj (and (recordp obj) (eq (aref obj 0) 'vector) (aref obj 1)))) (defsubst mal-map (elisp-hash-table) elisp-hash-table) (defun mal-map-value (obj) (if (hash-table-p obj) obj (and (recordp obj) (eq (aref obj 0) 'map) (aref obj 1)))) (defconst mal-empty-list #s(list nil)) (defsubst mal-list (elisp-list) (or elisp-list mal-empty-list)) ;; A nil result means either 'not a list' or 'empty list'. (defun mal-list-value (obj) (if (listp obj) obj (and (recordp obj) (eq (aref obj 0) 'list) (aref obj 1)))) (defun mal-list-p (obj) (or (listp obj) (and (recordp obj) (eq (aref obj 0) 'list)))) ;; A nil result means either 'not a list' or 'empty list'. (defun mal-seq-value (arg) (or (mal-vector-value arg) (mal-list-value arg))) (mal-object atom) (defun mal-reset (atom value) (setf (aref atom 1) value)) (mal-object fn-core) (mal-object macro) ;; Function created by fn*. (defsubst mal-func (value body params env) (record 'func value body params env)) (defun mal-func-value ( obj) (and (recordp obj) (eq (aref obj 0) 'func) (aref obj 1))) (defsubst mal-func-body (obj) (aref obj 2)) (defsubst mal-func-params (obj) (aref obj 3)) (defsubst mal-func-env (obj) (aref obj 4)) (defun with-meta (obj meta) (cond ((vectorp obj) (record 'vector obj meta)) ((hash-table-p obj) (record 'map obj meta)) ((listp obj) (record 'list obj meta)) ((< (length obj) 4) (record (aref obj 0) (aref obj 1) meta)) (t (record (aref obj 0) (aref obj 1) (aref obj 2) (aref obj 3) (aref obj 4) meta)))) (defun mal-meta (obj) (if (and (recordp obj) (member (length obj) '(3 6))) (aref obj (1- (length obj))) mal-nil)) ;;; regex (defvar token-re (rx (* (any white ?,)) ;; leading whitespace (group (or "~@" ;; special 2-char token (any "[]{}()'`~^@") ;; special 1-char tokens (and ?\" (* (or (and ?\\ anything) (not (any "\\\"")))) ?\") ;; string with escapes (and ?\; (* not-newline)) ;; comment (* (not (any white "[]{}()'\"`,;"))) ;; catch-all )))) (defvar whitespace-re (rx bos (* (any white ?,)) eos)) (defvar comment-re (rx bos ?\; (* anything))) (defvar sequence-end-re (rx bos (any ")]}") eos)) (defvar number-re (rx bos (? (any "+-")) (+ (char digit)) eos)) (defvar string-re (rx bos ?\" (* (or (and ?\\ anything) (not (any "\\\"")))) ?\" eos)) ;;; errors (when (not (fboundp 'define-error)) (defun define-error (name message &optional parent) "Define NAME as a new error signal. MESSAGE is a string that will be output to the echo area if such an error is signaled without being caught by a `condition-case'. PARENT is either a signal or a list of signals from which it inherits. Defaults to `error'." (unless parent (setq parent 'error)) (let ((conditions (if (consp parent) (apply #'nconc (mapcar (lambda (parent) (cons parent (or (get parent 'error-conditions) (error "Unknown signal `%s'" parent)))) parent)) (cons parent (get parent 'error-conditions))))) (put name 'error-conditions (delete-dups (copy-sequence (cons name conditions)))) (when message (put name 'error-message message))))) (define-error 'mal "MAL error") (define-error 'unterminated-sequence "Unexpected end of input during token sequence" 'mal) (define-error 'end-of-token-stream "End of token stream" 'mal) (define-error 'mal-custom "Custom error" 'mal) (provide 'mal/types) ================================================ FILE: impls/elisp/run ================================================ #!/bin/sh dir=$(dirname $0) exec emacs -Q --batch -L $dir --eval "(setq text-quoting-style 'straight)" --load $dir/${STEP:-stepA_mal}.elc "${@}" ================================================ FILE: impls/elisp/step0_repl.el ================================================ (defun READ (input) input) (defun EVAL (input) input) (defun PRINT (input) input) (defun rep (input) (PRINT (EVAL (READ input)))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defun main () (let (input) (while (setq input (readln "user> ")) (println (rep input))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step1_read_print.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/reader) (require 'mal/printer) (defun READ (input) (read-str input)) (defun EVAL (input) input) (defun PRINT (input) (pr-str input t)) (defun rep (input) (PRINT (EVAL (READ input)))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input)))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step2_eval.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/reader) (require 'mal/printer) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (a) ;; (println "EVAL: %s\n" (PRINT ast)) (cond ((setq a (mal-list-value ast)) (let ((fn* (mal-fn-core-value (EVAL (car a) env))) (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (apply fn* args))) ((setq a (mal-symbol-value ast)) (or (gethash a env) (error "'%s' not found" a))) ((setq a (mal-vector-value ast)) (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is ast)))) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (make-hash-table :test 'eq)) (dolist (binding '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) (let ((symbol (car binding)) (fn (cdr binding))) (puthash symbol (mal-fn-core fn) repl-env))) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step3_env.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (a) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (mal-env-set env identifier value))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (EVAL form env*))) (t ;; not a special form (let ((fn* (mal-fn-core-value (EVAL (car a) env))) (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (apply fn* args))))) ((setq a (mal-symbol-value ast)) (or (mal-env-get env a) (error "'%s' not found" a))) ((setq a (mal-vector-value ast)) (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is ast)))) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step4_if_fn_do.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (a) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (mal-env-set env identifier value))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (EVAL form env*))) (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (EVAL (car a) env)) (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (EVAL (cadddr a) env) mal-nil) (EVAL (caddr a) env)))) (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((mal-func-value fn) (EVAL (mal-func-body fn) (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)))) ((setq fn* (mal-fn-core-value fn)) ;; built-in function (apply fn* (mapcar (lambda (x) (EVAL x env)) args))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (or (mal-env-get env a) (error "'%s' not found" a))) ((setq a (mal-vector-value ast)) (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is ast)))) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step5_tco.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri))) (main) ================================================ FILE: impls/elisp/step6_file.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl-env) (if argv (with-error-handling (rep (format "(load-file \"%s\")" (car argv)) repl-env)) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri)))) (main) ================================================ FILE: impls/elisp/step7_quote.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun qq-reducer (elt acc) (let ((value (mal-list-value elt))) (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) (list (mal-symbol 'concat) (cadr value) 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) (let (value) (cond ((setq value (mal-list-value ast)) ; not empty (if (eq 'unquote (mal-symbol-value (car value))) (cadr value) (qq-iter value))) ((setq value (mal-vector-value ast)) (mal-list (list (mal-symbol 'vec) (qq-iter value)))) ((or (mal-map-value ast) (mal-symbol-value ast)) (mal-list (list (mal-symbol 'quote) ast))) (t ; including the empty list case ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (quote (setq return (cadr a))) (quasiquote (setq ast (quasiquote (cadr a)))) ; TCO (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl-env) (if argv (with-error-handling (rep (format "(load-file \"%s\")" (car argv)) repl-env)) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri)))) (main) ================================================ FILE: impls/elisp/step8_macros.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun qq-reducer (elt acc) (let ((value (mal-list-value elt))) (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) (list (mal-symbol 'concat) (cadr value) 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) (let (value) (cond ((setq value (mal-list-value ast)) ; not empty (if (eq 'unquote (mal-symbol-value (car value))) (cadr value) (qq-iter value))) ((setq value (mal-vector-value ast)) (mal-list (list (mal-symbol 'vec) (qq-iter value)))) ((or (mal-map-value ast) (mal-symbol-value ast)) (mal-list (list (mal-symbol 'quote) ast))) (t ; including the empty list case ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (quote (setq return (cadr a))) (quasiquote (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! (let ((identifier (mal-symbol-value (cadr a))) (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) (setq return (mal-env-set env identifier value)))) (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((setq fn* (mal-macro-value fn)) (setq ast (apply fn* args))) ; TCO ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl-env) (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)))))))" repl-env) (if argv (with-error-handling (rep (format "(load-file \"%s\")" (car argv)) repl-env)) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri)))) (main) ================================================ FILE: impls/elisp/step9_try.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun qq-reducer (elt acc) (let ((value (mal-list-value elt))) (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) (list (mal-symbol 'concat) (cadr value) 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) (let (value) (cond ((setq value (mal-list-value ast)) ; not empty (if (eq 'unquote (mal-symbol-value (car value))) (cadr value) (qq-iter value))) ((setq value (mal-vector-value ast)) (mal-list (list (mal-symbol 'vec) (qq-iter value)))) ((or (mal-map-value ast) (mal-symbol-value ast)) (mal-list (list (mal-symbol 'quote) ast))) (t ; including the empty list case ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (quote (setq return (cadr a))) (quasiquote (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! (let ((identifier (mal-symbol-value (cadr a))) (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) (setq return (mal-env-set env identifier value)))) (try* (if (cddr a) (condition-case err (setq return (EVAL (cadr a) env)) (error (let* ((a2* (mal-list-value (caddr a))) (identifier (mal-symbol-value (cadr a2*))) (form (caddr a2*)) (err* (if (eq (car err) 'mal-custom) ;; throw (cadr err) ;; normal error (mal-string (error-message-string err)))) (env* (mal-env env))) (mal-env-set env* identifier err*) (setq env env* ast form)))) ; TCO (setq ast (cadr a)))) ; TCO (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((setq fn* (mal-macro-value fn)) (setq ast (apply fn* args))) ; TCO ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl-env) (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)))))))" repl-env) (if argv (with-error-handling (rep (format "(load-file \"%s\")" (car argv)) repl-env)) (let (input) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri)))) (main) ================================================ FILE: impls/elisp/stepA_mal.el ================================================ ;; -*- lexical-binding: t; -*- (require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) (defun qq-reducer (elt acc) (let ((value (mal-list-value elt))) (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) (list (mal-symbol 'concat) (cadr value) 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) (let (value) (cond ((setq value (mal-list-value ast)) ; not empty (if (eq 'unquote (mal-symbol-value (car value))) (cadr value) (qq-iter value))) ((setq value (mal-vector-value ast)) (mal-list (list (mal-symbol 'vec) (qq-iter value)))) ((or (mal-map-value ast) (mal-symbol-value ast)) (mal-list (list (mal-symbol 'quote) ast))) (t ; including the empty list case ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) (let (return a) (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) (cond ((setq a (mal-list-value ast)) (cl-case (mal-symbol-value (car a)) (def! (let ((identifier (mal-symbol-value (cadr a))) (value (EVAL (caddr a) env))) (setq return (mal-env-set env identifier value)))) (let* (let ((env* (mal-env env)) (bindings (mal-seq-value (cadr a))) (form (caddr a)) key) (seq-do (lambda (current) (if key (let ((value (EVAL current env*))) (mal-env-set env* key value) (setq key nil)) (setq key (mal-symbol-value current)))) bindings) (setq env env* ast form))) ; TCO (quote (setq return (cadr a))) (quasiquote (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! (let ((identifier (mal-symbol-value (cadr a))) (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) (setq return (mal-env-set env identifier value)))) (try* (if (cddr a) (condition-case err (setq return (EVAL (cadr a) env)) (error (let* ((a2* (mal-list-value (caddr a))) (identifier (mal-symbol-value (cadr a2*))) (form (caddr a2*)) (err* (if (eq (car err) 'mal-custom) ;; throw (cadr err) ;; normal error (mal-string (error-message-string err)))) (env* (mal-env env))) (mal-env-set env* identifier err*) (setq env env* ast form)))) ; TCO (setq ast (cadr a)))) ; TCO (do (setq a (cdr a)) ; skip 'do (while (cdr a) (EVAL (pop a) env)) (setq ast (car a))) ; TCO (if (let ((condition (EVAL (cadr a) env))) (if (memq condition (list mal-nil mal-false)) (if (cdddr a) (setq ast (cadddr a)) ; TCO (setq return mal-nil)) (setq ast (caddr a))))) ; TCO (fn* (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) (body (caddr a))) (setq return (mal-func (lambda (&rest args) (EVAL body (mal-env env binds args))) body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) (args (cdr a)) fn*) (cond ((setq fn* (mal-macro-value fn)) (setq ast (apply fn* args))) ; TCO ((mal-func-value fn) (setq env (mal-env (mal-func-env fn) (mal-func-params fn) (mapcar (lambda (x) (EVAL x env)) args)) ast (mal-func-body fn))) ; TCO ((setq fn* (mal-fn-core-value fn)) ;; built-in function (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) (t (error "cannot apply %s" (PRINT ast)))))))) ((setq a (mal-symbol-value ast)) (setq return (or (mal-env-get env a) (error "'%s' not found" a)))) ((setq a (mal-vector-value ast)) (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))) ((setq a (mal-map-value ast)) (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (setq return (mal-map map)))) (t ;; return as is (setq return ast)))) ;; End of the TCO loop return)) (defun PRINT (input) (pr-str input t)) (defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) (princ (if args (apply 'format format-string args) format-string)) (terpri)) (defmacro with-error-handling (&rest body) `(condition-case err (progn ,@body) (end-of-token-stream ;; empty input, carry on ) (unterminated-sequence (princ (format "Expected '%c', got EOF\n" (cl-case (cadr err) (string ?\") (list ?\)) (vector ?\]) (map ?}))))) (error ; catch-all (println (error-message-string err))))) (defun main () (defvar repl-env (mal-env)) (dolist (binding core-ns) (let ((symbol (car binding)) (fn (cdr binding))) (mal-env-set repl-env symbol (mal-fn-core fn)))) (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) (mal-env-set repl-env '*host-language* (mal-string "elisp")) (rep "(def! not (fn* (a) (if a false true)))" repl-env) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl-env) (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)))))))" repl-env) (if argv (with-error-handling (rep (format "(load-file \"%s\")" (car argv)) repl-env)) (let (input) (rep "(println (str \"Mal [\" *host-language* \"]\"))" repl-env) (while (setq input (readln "user> ")) (with-error-handling (println (rep input repl-env)))) ;; print final newline (terpri)))) (main) ================================================ FILE: impls/elisp/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/elisp/tests/stepA_mal.mal ================================================ ;; Testing basic elisp interop (elisp-eval "42") ;=>42 (elisp-eval "(+ 1 1)") ;=>2 (elisp-eval "[foo bar baz]") ;=>[foo bar baz] (elisp-eval "(mapcar '1+ (number-sequence 0 2))") ;=>(1 2 3) (elisp-eval "(progn (princ \"Hello World!\n\") nil)") ;/Hello World! ;=>nil (elisp-eval "(setq emacs-version-re (rx (+ digit) \".\" digit))") (elisp-eval "(and (string-match-p emacs-version-re emacs-version) t)") ;=>true ================================================ FILE: impls/elixir/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Elixir RUN apt-get install -y elixir ================================================ FILE: impls/elixir/Makefile ================================================ SOURCES_BASE = lib/mal/types.ex lib/mal/reader.ex lib/mal/printer.ex SOURCES_LISP = lib/mal/env.ex lib/mal/core.ex lib/mix/tasks/stepA_mal.ex SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: mix compile dist: mal mal: $(SOURCES) mix escript.build clean: mix clean rm -f mal .PHONY: clean ================================================ FILE: impls/elixir/lib/mal/atom.ex ================================================ defmodule Mal.Atom do alias Mal.Function def new(value) do {:ok, pid} = Agent.start_link(fn -> value end) pid end def deref({:atom, pid}) do Agent.get(pid, fn value -> value end) end def reset!({:atom, pid}, new_value) do Agent.update(pid, fn _ -> new_value end) new_value end def swap!({:atom, pid}, %Function{value: func}, args) do Agent.get_and_update(pid, fn state -> func_args = [state | args] new = func.(func_args) {new, new} end) end end ================================================ FILE: impls/elixir/lib/mal/core.ex ================================================ defmodule Mal.Core do import Mal.Types alias Mal.Function def namespace do raw = %{ "+" => fn [a, b] -> a + b end, "-" => fn [a, b] -> a - b end, "*" => fn [a, b] -> a * b end, "/" => fn [a, b] -> div(a, b) end, ">" => fn [a, b] -> a > b end, "<" => fn [a, b] -> a < b end, "<=" => fn [a, b] -> a <= b end, ">=" => fn [a, b] -> a >= b end, "concat" => &concat/1, "=" => &equal/1, "list?" => &list?/1, "empty?" => &empty?/1, "count" => &count/1, "pr-str" => &pr_str/1, "str" => &str/1, "prn" => &prn/1, "println" => &println/1, "slurp" => &slurp/1, "nth" => &nth/1, "first" => &first/1, "rest" => &rest/1, "map" => &map/1, "apply" => &apply/1, "keyword" => &keyword/1, "symbol?" => &symbol?/1, "cons" => &cons/1, "vec" => &vec/1, "vector?" => &vector?/1, "assoc" => &assoc/1, "dissoc" => &dissoc/1, "get" => &get/1, "map?" => &map?/1, "list" => &list/1, "vector" => &vector/1, "hash-map" => &hash_map/1, "meta" => &meta/1, "with-meta" => &with_meta/1, "atom" => &atom/1, "atom?" => &atom?/1, "deref" => &deref/1, "reset!" => &reset!/1, "swap!" => &swap!/1, "conj" => &conj/1, "seq" => &seq/1, "fn?" => &fn?/1, "macro?" => ¯o?/1, "time-ms" => fn _ -> :erlang.system_time(:milli_seconds) end, "readline" => fn [prompt] -> readline(prompt) end, "sequential?" => fn arg -> vector?(arg) or list?(arg) end, "keyword?" => fn [type] -> is_atom(type) end, "nil?" => fn [type] -> type == nil end, "true?" => fn [type] -> type == true end, "false?" => fn [type] -> type == false end, "string?" => fn [obj] -> String.valid?(obj) end, "number?" => fn [obj] -> is_number(obj) end, "symbol" => fn [name] -> {:symbol, name} end, "read-string" => fn [input] -> Mal.Reader.read_str(input) end, "throw" => fn [arg] -> throw({:error, arg}) end, "contains?" => fn [{:map, map, _}, key] -> Map.has_key?(map, key) end, "keys" => fn [{:map, map, _}] -> Map.keys(map) |> list end, "vals" => fn [{:map, map, _}] -> Map.values(map) |> list end } convert(raw) end defp convert(map) do for {name, func} <- map, into: %{} do {name, %Function{value: func}} end end def readline(prompt) do IO.write(:stdio, prompt) IO.read(:stdio, :line) |> String.trim("\n") end defp convert_vector({type, ast, meta}) when type == :map do new_ast = Enum.map(ast, fn {key, value} -> {key, convert_vector(value)} end) {:map, new_ast, meta} end defp convert_vector({type, ast, meta}) when type in [:list, :vector] do new_ast = Enum.map(ast, &convert_vector/1) {:list, new_ast, meta} end defp convert_vector(other), do: other defp equal([a, b]) do convert_vector(a) == convert_vector(b) end defp empty?([{_type, [], _meta}]), do: true defp empty?(_), do: false defp count([{_type, ast, _meta}]), do: length(ast) defp count(_), do: 0 defp pr_str(args) do args |> Enum.map(&Mal.Printer.print_str/1) |> Enum.join(" ") end defp str(args) do args |> Enum.map(&(Mal.Printer.print_str(&1, false))) |> Enum.join("") end defp prn(args) do args |> pr_str |> IO.puts nil end defp println(args) do args |> Enum.map(&(Mal.Printer.print_str(&1, false))) |> Enum.join(" ") |> IO.puts nil end defp slurp([file_name]) do case File.read(file_name) do {:ok, content} -> content {:error, :enoent} -> throw({:error, "can't find file #{file_name}"}) {:error, :eisdir} -> throw({:error, "can't read directory #{file_name}"}) {:error, :eaccess} -> throw({:error, "missing permissions #{file_name}"}) {:error, reason} -> throw({:error, "can't read file #{file_name}, #{reason}"}) end end defp nth([{_type, ast, _meta}, index]) do case Enum.at(ast, index, :error) do :error -> throw({:error, "index out of bounds"}) any -> any end end defp first([{_type, [head | _tail], _}]), do: head defp first(_), do: nil defp rest([{_type, [_head | tail], _}]), do: list(tail) defp rest([{_type, [], _}]), do: list([]) defp rest([nil]), do: list([]) defp map([%Function{value: function}, ast]), do: do_map(function, ast) defp map([function, ast]), do: do_map(function, ast) defp do_map(function, {_type, ast, _meta}) do ast |> Enum.map(fn arg -> function.([arg]) end) |> list end defp apply([%Function{value: function} | tail]), do: do_apply(function, tail) defp apply([function | tail]), do: do_apply(function, tail) defp do_apply(function, tail) do [{_type, ast, _meta} | reversed_args] = Enum.reverse(tail) args = Enum.reverse(reversed_args) func_args = Enum.concat(args, ast) function.(func_args) end defp keyword([atom]) when is_atom(atom), do: atom defp keyword([atom]), do: String.to_atom(atom) defp cons([prepend, {_type, ast, meta}]), do: {:list, [prepend | ast], meta} defp concat(args) do args |> Enum.map(fn tuple -> elem(tuple, 1) end) |> Enum.concat |> 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} end defp dissoc([{:map, hash_map, meta} | keys]) do {:map, Map.drop(hash_map, keys), meta} end defp get([{:map, map, _}, key]), do: Map.get(map, key, nil) defp get(_), do: nil defp meta([{_type, _ast, meta}]), do: meta defp meta([%Function{meta: meta}]), do: meta defp meta(_), do: nil defp with_meta([{type, ast, _old_meta}, meta]), do: {type, ast, meta} defp with_meta([%Function{} = func, meta]), do: %{func | meta: meta} defp with_meta(_), do: nil defp deref(args) do apply(&Mal.Atom.deref/1, args) end defp reset!(args) do apply(&Mal.Atom.reset!/2, args) end defp swap!([atom, function | args]) do Mal.Atom.swap!(atom, function, args) end defp conj([{:list, ast, meta} | args]) do new_list = Enum.reverse(args) ++ ast {:list, new_list, meta} end defp conj([{:vector, ast, meta} | args]) do {:vector, ast ++ args, meta} end defp seq([nil]), do: nil defp seq([{:list, [], _meta}]), do: nil defp seq([{:list, ast, meta}]), do: {:list, ast, meta} defp seq([{:vector, [], _meta}]), do: nil defp seq([{:vector, ast, meta}]), do: {:list, ast, meta} defp seq([""]), do: nil defp seq([s]), do: {:list, String.split(s, "", trim: true), nil} defp seq(_), do: nil defp fn?([%Function{macro: false}]), do: true defp fn?(_), do: false defp macro?([%Function{macro: true}]), do: true defp macro?(_), do: false end ================================================ FILE: impls/elixir/lib/mal/env.ex ================================================ defmodule Mal.Env do import Mal.Types def new(outer \\ nil, binds \\ [], exprs \\ []) def new(outer, binds, exprs) do {:ok, pid} = Agent.start_link(fn -> %{outer: outer, env: %{}} end) set_bindings(pid, binds, exprs) end defp set_bindings(pid, [], []), do: pid defp set_bindings(pid, ["&", key], exprs) do set(pid, key, list(exprs)) pid end defp set_bindings(pid, [key | binds], [value | exprs]) do set(pid, key, value) set_bindings(pid, binds, exprs) end def set(pid, key, value) do Agent.update(pid, fn map -> %{map | :env => Map.put(map.env, key, value)} end) end def merge(pid, env_values) do Agent.update(pid, fn map -> %{map | :env => Map.merge(map.env, env_values)} end) end def find(pid, key) do Agent.get(pid, fn map -> case Map.has_key?(map.env, key) do true -> pid false -> map.outer && find(map.outer, key) end end) end def retrieve_key(pid, key) do Agent.get(pid, fn map -> case Map.fetch(map.env, key) do {:ok, value} -> {:ok, value} :error -> :not_found end end) end def get(pid, key) do case find(pid, key) do nil -> :not_found env -> retrieve_key(env, key) end end end ================================================ FILE: impls/elixir/lib/mal/printer.ex ================================================ defmodule Mal.Printer do alias Mal.Function def print_str(mal, print_readably \\ true) def print_str(mal, _) when is_atom(mal), do: inspect(mal) def print_str(mal, _) when is_integer(mal), do: Integer.to_string(mal) def print_str(mal, _) when is_function(mal), do: inspect(mal) def print_str(%Function{value: mal, macro: true}, _), do: "#Macro<#{inspect(mal)}" def print_str(%Function{value: mal}, _), do: inspect(mal) def print_str({:symbol, value}, _), do: value def print_str({:exception, exception}, print_readably) do print_str(exception, print_readably) end def print_str(mal, false) when is_bitstring(mal), do: mal def print_str(mal, true) when is_bitstring(mal), do: inspect(mal) def print_str({:atom, _pid} = atom, print_readably) do output = atom |> Mal.Atom.deref |> print_str(print_readably) "(atom #{output})" end def print_str({:map, mal, _}, print_readably) do evaluate_pair = fn {key, value} -> "#{print_str(key, print_readably)} #{print_str(value, print_readably)}" end output = mal |> Enum.map(evaluate_pair) |> Enum.join(" ") "{#{output}}" end def print_str({:vector, vector, _}, print_readably) do "[#{print_list(vector, print_readably)}]" end def print_str({:list, mal, _}, print_readably) do "(#{print_list(mal, print_readably)})" end defp print_list(list, print_readably) do list |> Enum.map(fn(x) -> print_str(x, print_readably) end) |> Enum.join(" ") end end ================================================ FILE: impls/elixir/lib/mal/reader.ex ================================================ defmodule Mal.Reader do import Mal.Types def read_str(input) do case tokenize(input) do [] -> nil tokens -> tokens |> read_form |> elem(0) end end def tokenize(input) do regex = ~r/[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ Regex.scan(regex, input, capture: :all_but_first) |> List.flatten |> List.delete_at(-1) # Remove the last match, which is an empty string |> Enum.filter(fn token -> not String.starts_with?(token, ";") end) end defp read_form([next | rest] = tokens) do case next do "(" -> read_list(tokens) "[" -> read_vector(tokens) "{" -> read_hash_map(tokens) "'" -> create_quote("quote", rest) "`" -> create_quote("quasiquote", rest) "~" -> create_quote("unquote", rest) "~@" -> create_quote("splice-unquote", rest) "@" -> create_quote("deref", rest) "^" -> create_meta(rest) ")" -> throw({:error, "unexpected )"}) "]" -> throw({:error, "unexpected ]"}) "}" -> throw({:error, "unexpected }"}) _ -> token = read_atom(next) {token, rest} end end defp create_meta(tokens) do {meta, meta_rest} = read_form(tokens) {token, rest_tokens} = read_form(meta_rest) new_token = list([{:symbol, "with-meta"}, token, meta]) {new_token, rest_tokens} end defp create_quote(quote_type, tokens) do {token, rest_tokens} = read_form(tokens) new_token = list([{:symbol, quote_type}, token]) {new_token, rest_tokens} end defp read_list([_ | tokens]) do {ast, rest} = do_read_sequence(tokens, [], "(", ")") {list(ast), rest} end defp read_vector([_ | tokens]) do {ast, rest} = do_read_sequence(tokens, [], "[", "]") {vector(ast), rest} end defp read_hash_map([_ | tokens]) do {map, rest} = do_read_sequence(tokens, [], "{", "}") {hash_map(map), rest} end defp do_read_sequence([], _acc, _start_sep, end_sep), do: throw({:error, "expected #{end_sep}, got EOF"}) defp do_read_sequence([head | tail] = tokens, acc, start_sep, end_sep) do cond do String.starts_with?(head, end_sep) -> {Enum.reverse(acc), tail} true -> {token, rest} = read_form(tokens) do_read_sequence(rest, [token | acc], start_sep, end_sep) end end defp read_atom("nil"), do: nil defp read_atom("true"), do: true defp read_atom("false"), do: false defp read_atom(":" <> rest), do: String.to_atom(rest) defp read_atom(token) do cond do String.match?(token, ~r/^"(?:\\.|[^\\"])*"$/) -> token |> Code.string_to_quoted |> elem(1) String.starts_with?(token, "\"") -> throw({:error, "expected '\"', got EOF"}) integer?(token) -> Integer.parse(token) |> elem(0) true -> {:symbol, token} end end end ================================================ FILE: impls/elixir/lib/mal/types.ex ================================================ defmodule Mal.Types do def integer?(input) do Regex.match?(~r/^-?[0-9]+$/, input) end def hash_map(ast) do map = ast |> Enum.chunk(2) |> Enum.map(&List.to_tuple/1) |> Enum.into(%{}) {:map, map, nil} end def map?([{:map, _ast, _meta}]), do: true def map?(_), do: false def list(ast), do: {:list, ast, nil} def list?([{:list, _, _}]), do: true def list?(_), do: false def vector(ast), do: {:vector, ast, nil} def vector?([{:vector, _ast, _meta}]), do: true def vector?(_), do: false def symbol?([{:symbol, _}]), do: true def symbol?(_), do: false def atom([value]) do pid = Mal.Atom.new(value) {:atom, pid} end def atom?([{:atom, _}]), do: true def atom?(_), do: false end defmodule Mal.Function do defstruct value: nil, macro: false, meta: nil end ================================================ FILE: impls/elixir/lib/mal.ex ================================================ defmodule Mal do end ================================================ FILE: impls/elixir/lib/mix/tasks/step0_repl.ex ================================================ defmodule Mix.Tasks.Step0Repl do def run(_), do: loop() defp loop do Mal.Core.readline("user> ") |> read_eval_print |> IO.puts loop() end defp read(input) do input end defp eval(input) do input end defp print(input) do input end defp read_eval_print(:eof), do: exit(:normal) defp read_eval_print(line) do read(line) |> eval |> print end end ================================================ FILE: impls/elixir/lib/mix/tasks/step1_read_print.ex ================================================ defmodule Mix.Tasks.Step1ReadPrint do def run(_), do: loop() defp loop do Mal.Core.readline("user> ") |> read_eval_print |> IO.puts loop() end defp read(input) do Mal.Reader.read_str(input) end defp eval(ast), do: ast defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof), do: exit(:normal) defp read_eval_print(line) do read(line) |> eval |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step2_eval.ex ================================================ defmodule Mix.Tasks.Step2Eval do @repl_env %{ "+" => &+/2, "-" => &-/2, "*" => &*/2, "/" => &div/2 } def run(_), do: loop() defp loop do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print |> IO.puts loop() end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Map.fetch(env, symbol) do {:ok, value} -> value :error -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval(ast, env) do # IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") eval_ast(ast, env) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) apply(func, args) end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof), do: exit(:normal) defp read_eval_print(line) do read(line) |> eval(@repl_env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step3_env.ex ================================================ defmodule Mix.Tasks.Step3Env do @initial_env %{ "+" => &+/2, "-" => &-/2, "*" => &*/2, "/" => &div/2 } def run(_) do env = Mal.Env.new() Mal.Env.merge(env, @initial_env) loop(env) end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) defp eval(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) apply(func, args) end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step4_if_fn_do.ex ================================================ defmodule Mix.Tasks.Step4IfFnDo do import Mal.Types alias Mal.Function def run(_) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(env) loop(env) end defp bootstrap(env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) defp eval(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) func.value.(args) end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step5_tco.ex ================================================ defmodule Mix.Tasks.Step5Tco do import Mal.Types alias Mal.Function def run(_) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(env) loop(env) end defp bootstrap(env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) defp eval(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) case func do %Function{value: closure} -> closure.(args) _ -> func.(args) end end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step6_file.ex ================================================ defmodule Mix.Tasks.Step6File do import Mal.Types alias Mal.Function def run(args) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(args, env) loop(env) end defp load_file(file_name, env) do read_eval_print(""" (load-file "#{file_name}") """, env) exit(:normal) end defp bootstrap(args, env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) # load-file: read_eval_print(""" (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) case args do [file_name | rest] -> Mal.Env.set(env, "*ARGV*", list(rest)) load_file(file_name, env) [] -> Mal.Env.set(env, "*ARGV*", list([])) end end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) defp eval(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) func.value.(args) end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step7_quote.ex ================================================ defmodule Mix.Tasks.Step7Quote do import Mal.Types alias Mal.Function def run(args) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(args, env) loop(env) end defp load_file(file_name, env) do read_eval_print(""" (load-file "#{file_name}") """, env) exit(:normal) end defp bootstrap(args, env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) # load-file: read_eval_print(""" (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) case args do [file_name | rest] -> Mal.Env.set(env, "*ARGV*", list(rest)) load_file(file_name, env) [] -> Mal.Env.set(env, "*ARGV*", list([])) end end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) 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 defp qq_foldr([]), do: list([]) defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) 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(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) args = Enum.map(args, fn elem -> eval(elem, env) end) func.value.(args) end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step8_macros.ex ================================================ defmodule Mix.Tasks.Step8Macros do import Mal.Types alias Mal.Function def run(args) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(args, env) loop(env) end defp load_file(file_name, env) do read_eval_print(""" (load-file "#{file_name}") """, env) exit(:normal) end defp bootstrap(args, env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) # load-file: read_eval_print(""" (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) # cond read_eval_print(""" (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)))))))" """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) case args do [file_name | rest] -> Mal.Env.set(env, "*ARGV*", list(rest)) load_file(file_name, env) [] -> Mal.Env.set(env, "*ARGV*", list([])) end end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) 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 defp qq_foldr([]), do: list([]) defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) 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(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do macro = %{eval(function, env) | macro: true} Mal.Env.set(env, key, macro) macro end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) case func do %Function{macro: true} -> func.value.(args) |> eval(env) _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) end end defp eval_list([], _env, meta), do: {:list, [], meta} defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, message} -> IO.puts("Error: #{message}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/step9_try.ex ================================================ defmodule Mix.Tasks.Step9Try do import Mal.Types alias Mal.Function def run(args) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(args, env) loop(env) end defp load_file(file_name, env) do read_eval_print(""" (load-file "#{file_name}") """, env) exit(:normal) end defp bootstrap(args, env) do # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) # load-file: read_eval_print(""" (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) # cond read_eval_print(""" (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)))))))" """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) case args do [file_name | rest] -> Mal.Env.set(env, "*ARGV*", list(rest)) load_file(file_name, env) [] -> Mal.Env.set(env, "*ARGV*", list([])) end end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) 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 defp qq_foldr([]), do: list([]) defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) 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(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do macro = %{eval(function, env) | macro: true} Mal.Env.set(env, key, macro) macro end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) end # (try* A (catch* B C)) defp eval_list([{:symbol, "try*"}, try_form, {:list, catch_list, _meta}], env, _) do eval_try(try_form, catch_list, env) end defp eval_list([{:symbol, "try*"}, try_form], env, _) do eval(try_form, env) end defp eval_list([{:symbol, "try*"}, _try_form, _], _env, _) do throw({:error, "try* requires a list as the second parameter"}) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) case func do %Function{macro: true} -> func.value.(args) |> eval(env) _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) end end defp eval_list([], _env, meta), do: {:list, [], meta} defp eval_try(try_form, [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do try do eval(try_form, env) catch {:error, message}-> catch_env = Mal.Env.new(env) Mal.Env.set(catch_env, exception, {:exception, message}) eval(catch_form, catch_env) end end defp eval_try(_try_form, _catch_list, _env) do throw({:error, "catch* requires two arguments"}) end defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, exception} -> IO.puts("Error: #{Mal.Printer.print_str(exception)}") end end ================================================ FILE: impls/elixir/lib/mix/tasks/stepA_mal.ex ================================================ defmodule Mix.Tasks.StepAMal do import Mal.Types alias Mal.Function # for escript execution def main(args) do run(args) end def run(args) do env = Mal.Env.new() Mal.Env.merge(env, Mal.Core.namespace) bootstrap(args, env) loop(env) end defp load_file(file_name, env) do read_eval_print(""" (load-file "#{file_name}") """, env) exit(:normal) end defp bootstrap(args, env) do # *host-language* read_eval_print("(def! *host-language* \"Elixir\")", env) # not: read_eval_print(""" (def! not (fn* (a) (if a false true))) """, env) # load-file: read_eval_print(""" (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """, env) # cond read_eval_print(""" (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)))))))" """, env) Mal.Env.set(env, "eval", %Function{value: fn [ast] -> eval(ast, env) end}) case args do [file_name | rest] -> Mal.Env.set(env, "*ARGV*", list(rest)) load_file(file_name, env) [] -> Mal.Env.set(env, "*ARGV*", list([])) read_eval_print("(println (str \"Mal [\" *host-language* \"]\"))", env) end end defp loop(env) do IO.write(:stdio, "user> ") IO.read(:stdio, :line) |> read_eval_print(env) |> IO.puts loop(env) end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do map = for {key, value} <- ast, into: %{} do {key, eval(value, env)} end {:map, map, meta} end defp eval_ast({:vector, ast, meta}, env) do {:vector, Enum.map(ast, fn elem -> eval(elem, env) end), meta} end defp eval_ast({:symbol, symbol}, env) do case Mal.Env.get(env, symbol) do {:ok, value} -> value :not_found -> throw({:error, "'#{symbol}' not found"}) end end defp eval_ast(ast, _env), do: ast defp read(input) do Mal.Reader.read_str(input) end defp eval_bindings([], env), do: env defp eval_bindings([{:symbol, key}, binding | tail], env) do evaluated = eval(binding, env) Mal.Env.set(env, key, evaluated) eval_bindings(tail, env) end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) 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 defp qq_foldr([]), do: list([]) defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) 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(ast, env) do case Mal.Env.get(env, "DEBUG-EVAL") do :not_found -> :ok {:ok, nil} -> :ok {:ok, false} -> :ok _ -> IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") end eval_ast(ast, env) end defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do case if_false do [] -> nil [body] -> eval(body, env) end else eval(if_true, env) end end defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end defp eval_list([{:symbol, "def!"}, {:symbol, key}, value], env, _) do evaluated = eval(value, env) Mal.Env.set(env, key, evaluated) evaluated end defp eval_list([{:symbol, "defmacro!"}, {:symbol, key}, function], env, _) do macro = %{eval(function, env) | macro: true} Mal.Env.set(env, key, macro) macro end defp eval_list([{:symbol, "let*"}, {list_type, bindings, _}, body], env, _) when list_type == :list or list_type == :vector do let_env = Mal.Env.new(env) eval_bindings(bindings, let_env) eval(body, let_env) end defp eval_list([{:symbol, "fn*"}, {list_type, params, _}, body], env, _) when list_type == :list or list_type == :vector do param_symbols = for {:symbol, symbol} <- params, do: symbol closure = fn args -> inner = Mal.Env.new(env, param_symbols, args) eval(body, inner) end %Function{value: closure} end defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) end # (try* A (catch* B C)) defp eval_list([{:symbol, "try*"}, try_form, {:list, catch_list, _meta}], env, _) do eval_try(try_form, catch_list, env) end defp eval_list([{:symbol, "try*"}, try_form], env, _) do eval(try_form, env) end defp eval_list([{:symbol, "try*"}, _try_form, _], _env, _) do throw({:error, "try* requires a list as the second parameter"}) end defp eval_list([a0 | args], env, _meta) do func = eval(a0, env) case func do %Function{macro: true} -> func.value.(args) |> eval(env) _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) end end defp eval_list([], _env, meta), do: {:list, [], meta} defp eval_try(try_form, [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do try do eval(try_form, env) catch {:error, message}-> catch_env = Mal.Env.new(env) Mal.Env.set(catch_env, exception, {:exception, message}) eval(catch_form, catch_env) end end defp eval_try(_try_form, _catch_list, _env) do throw({:error, "catch* requires two arguments"}) end defp print(value) do Mal.Printer.print_str(value) end defp read_eval_print(:eof, _env), do: exit(:normal) defp read_eval_print(line, env) do read(line) |> eval(env) |> print catch {:error, exception} -> IO.puts("Error: #{Mal.Printer.print_str(exception)}") end end ================================================ FILE: impls/elixir/mix.exs ================================================ defmodule Mal.Mixfile do use Mix.Project def project do [app: :mal, version: "0.0.1", elixir: "~> 1.5", build_embedded: Mix.env == :prod, start_permanent: Mix.env == :prod, deps: deps(), default_task: "stepA_mal", escript: escript()] end def escript do [main_module: Mix.Tasks.StepAMal] end # Configuration for the OTP application # # Type `mix help compile.app` for more information def application do [applications: [:logger]] end # Dependencies can be Hex packages: # # {:mydep, "~> 0.3.0"} # # Or git/path repositories: # # {:mydep, git: "https://github.com/elixir-lang/mydep.git", tag: "0.1.0"} # # Type `mix help deps` for more examples and options defp deps do [] end end ================================================ FILE: impls/elixir/run ================================================ #!/usr/bin/env bash cd $(dirname $0) exec mix ${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/elixir/tests/step5_tco.mal ================================================ ;; Elixir: skipping non-TCO recursion ;; Reason: Elixir has TCO, test always completes. ================================================ FILE: impls/elm/.dockerignore ================================================ node_modules ================================================ FILE: impls/elm/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm ENV HOME /mal ENV NPM_CONFIG_CACHE /mal/.npm ================================================ FILE: impls/elm/Makefile ================================================ SOURCES = src/Step0_repl.elm src/Step1_read_print.elm src/Step2_eval.elm \ src/Step3_env.elm src/Step4_if_fn_do.elm src/Step5_tco.elm src/Step6_file.elm \ src/Step7_quote.elm src/Step8_macros.elm src/Step9_try.elm src/StepA_mal.elm BINS = $(SOURCES:src/Step%.elm=step%.js) ELM = node_modules/.bin/elm all: node_modules $(BINS) node_modules: npm install step%.js: src/Step%.elm node_modules $(ELM) make $< --output $@ STEP0_SOURCES = src/IO.elm STEP1_SOURCES = $(STEP0_SOURCES) src/Reader.elm src/Printer.elm src/Utils.elm src/Types.elm src/Env.elm STEP2_SOURCES = $(STEP1_SOURCES) STEP3_SOURCES = $(STEP2_SOURCES) STEP4_SOURCES = $(STEP3_SOURCES) src/Core.elm src/Eval.elm step0_repl.js: $(STEP0_SOURCES) step1_read_print.js: $(STEP1_SOURCES) step2_eval.js: $(STEP2_SOURCES) step3_env.js: $(STEP3_SOURCES) step4_if_fn_do.js: $(STEP4_SOURCES) step5_tco.js: $(STEP4_SOURCES) step6_file.js: $(STEP4_SOURCES) step7_quote.js: $(STEP4_SOURCES) step8_macros.js: $(STEP4_SOURCES) step9_try.js: $(STEP4_SOURCES) stepA_mal.js: $(STEP4_SOURCES) clean: rm -f $(BINS) ================================================ FILE: impls/elm/bootstrap.js ================================================ var readline = require('./node_readline'); var fs = require('fs'); // The first two arguments are: 'node' and 'bootstrap.js' // The third argument is the name of the Elm module to load. var args = process.argv.slice(2); var mod = require('./' + args[0]); var app = mod.Elm['S' + args[0].slice(1)].init({ flags: { args: args.slice(1) } }); // Hook up the writeLine and readLine ports of the app. app.ports.writeLine.subscribe(function(line) { console.log(line); app.ports.input.send({"tag": "lineWritten"}); }); app.ports.readLine.subscribe(function(prompt) { var line = readline.readline(prompt); app.ports.input.send({"tag": "lineRead", "line": line}); }); // Read the contents of a file. if ('readFile' in app.ports) { app.ports.readFile.subscribe(function(filename) { try { var contents = fs.readFileSync(filename, 'utf8'); app.ports.input.send({"tag": "fileRead", "contents": contents}); } catch (e) { app.ports.input.send({"tag": "exception", "message": e.message}); } }); } ================================================ FILE: impls/elm/elm.json ================================================ { "type": "application", "source-directories": [ "src" ], "elm-version": "0.19.1", "dependencies": { "direct": { "elm/core": "1.0.5", "elm/json": "1.1.3", "elm/parser": "1.1.0", "elm/regex": "1.0.0", "elm/time": "1.0.0" }, "indirect": {} }, "test-dependencies": { "direct": {}, "indirect": {} } } ================================================ FILE: impls/elm/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL //var RL_LIB = "libedit.so.2"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var koffi = require('koffi'), fs = require('fs'); var rllib = null; try { rllib = koffi.load(RL_LIB); } catch (e) { console.error('ERROR loading RL_LIB:', RL_LIB, e); throw e; } var readlineFunc = rllib.func('char *readline(char *)'); var addHistoryFunc = rllib.func('int add_history(char *)'); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i> MalFunction binaryOp fn retType args = case args of [ MalInt x, MalInt y ] -> Eval.succeed (retType (fn x y)) _ -> Eval.fail "unsupported arguments" {- list -} core_list = Eval.succeed << MalList Nothing {- list? -} isList args = case args of [ MalList _ _ ] -> Eval.succeed (MalBool True) _ -> Eval.succeed (MalBool False) {- empty? -} isEmpty args = case args of [ MalList _ list ] -> Eval.succeed <| MalBool (List.isEmpty list) [ MalVector _ vec ] -> Eval.succeed <| MalBool (Array.isEmpty vec) _ -> Eval.fail "unsupported arguments" {- count -} count args = case args of [ MalNil ] -> Eval.succeed (MalInt 0) [ MalList _ list ] -> Eval.succeed <| MalInt (List.length list) [ MalVector _ vec ] -> Eval.succeed <| MalInt (Array.length vec) _ -> Eval.fail "unsupported arguments" equalLists a b = case ( a, b ) of ( [], [] ) -> True ( x :: xs, y :: ys ) -> if deepEquals (x, y) then equalLists xs ys else False _ -> False compareListTo list other = case other of MalList _ otherList -> equalLists list otherList MalVector _ vec -> equalLists list (Array.toList vec) _ -> False equalMaps a b = if Dict.keys a /= Dict.keys b then False else zip (Dict.values a) (Dict.values b) |> List.map deepEquals |> List.all identity deepEquals c = case c of ( MalList _ list, MalList _ otherList ) -> equalLists list otherList ( MalList _ list, MalVector _ vec ) -> equalLists list (Array.toList vec) ( MalList _ _, _ ) -> False ( MalVector _ vec, MalList _ list ) -> equalLists (Array.toList vec) list ( MalVector _ vec, MalVector _ otherVec ) -> equalLists (Array.toList vec) (Array.toList otherVec) ( MalVector _ _, _ ) -> False ( MalMap _ map, MalMap _ otherMap ) -> equalMaps map otherMap ( MalMap _ _, _ ) -> False ( _, MalMap _ _ ) -> False (a, b) -> a == b {- = -} equals args = case args of [ a, b ] -> Eval.succeed <| MalBool (deepEquals (a, b)) _ -> Eval.fail "unsupported arguments" {- pr-str -} prStr args = Eval.withEnv (\env -> args |> List.map (printString env True) |> String.join " " |> MalString |> Eval.succeed ) {- str -} core_str args = Eval.withEnv (\env -> args |> List.map (printString env False) |> String.join "" |> MalString |> Eval.succeed ) {- helper function to write a string to stdout -} writeLine str = Eval.io (IO.writeLine str) (\msg -> case msg of LineWritten -> Eval.succeed MalNil _ -> Eval.fail "wrong IO, expected LineWritten" ) prn args = Eval.withEnv (\env -> args |> List.map (printString env True) |> String.join " " |> writeLine ) println args = Eval.withEnv (\env -> args |> List.map (printString env False) |> String.join " " |> writeLine ) printEnv args = case args of [] -> Eval.withEnv (Printer.printEnv >> writeLine) _ -> Eval.fail "unsupported arguments" readString args = case args of [ MalString str ] -> case Reader.readString str of Ok ast -> Eval.succeed ast Err msg -> Eval.fail msg _ -> Eval.fail "unsupported arguments" slurp args = case args of [ MalString filename ] -> Eval.io (IO.readFile filename) (\msg -> case msg of FileRead contents -> Eval.succeed <| MalString contents Exception errMsg -> Eval.fail errMsg _ -> Eval.fail "wrong IO, expected FileRead" ) _ -> Eval.fail "unsupported arguments" atom args = case args of [ value ] -> Eval.withEnv (\env -> case Env.newAtom value env of ( newEnv, atomId ) -> Eval.setEnv newEnv |> Eval.map (\_ -> MalAtom atomId) ) _ -> Eval.fail "unsupported arguments" isAtom args = case args of [ MalAtom _ ] -> Eval.succeed <| MalBool True _ -> Eval.succeed <| MalBool False deref args = case args of [ MalAtom atomId ] -> Eval.withEnv (Env.getAtom atomId >> Eval.succeed) _ -> Eval.fail "unsupported arguments" reset args = case args of [ MalAtom atomId, value ] -> Eval.modifyEnv (Env.setAtom atomId value) |> Eval.map (always value) _ -> Eval.fail "unsupported arguments" {- helper function for calling a core or user function -} callFn func args = case func of CoreFunc _ fn -> fn args UserFunc { eagerFn } -> eagerFn args swap args = case args of (MalAtom atomId) :: (MalFunction func) :: moreArgs -> Eval.withEnv (\env -> let value = Env.getAtom atomId env in callFn func (value :: moreArgs) ) |> Eval.andThen (\res -> Eval.modifyEnv (Env.setAtom atomId res) |> Eval.map (always res) ) _ -> Eval.fail "unsupported arguments" gc args = Eval.withEnv (Env.gc MalNil >> Printer.printEnv >> writeLine) setDebug enabled = Eval.modifyEnv (\env -> { env | debug = enabled } ) |> Eval.andThen (\_ -> Eval.succeed MalNil) debug args = case args of [ MalBool value ] -> setDebug value _ -> Eval.withEnv (\env -> Eval.succeed (MalBool env.debug) ) typeof args = case args of [ MalInt _ ] -> Eval.succeed <| MalSymbol "int" [ MalBool _ ] -> Eval.succeed <| MalSymbol "bool" [ MalString _ ] -> Eval.succeed <| MalSymbol "string" [ MalKeyword _ ] -> Eval.succeed <| MalSymbol "keyword" [ MalSymbol _ ] -> Eval.succeed <| MalSymbol "symbol" [ MalNil ] -> Eval.succeed <| MalSymbol "nil" [ MalList _ _ ] -> Eval.succeed <| MalSymbol "vector" [ MalVector _ _ ] -> Eval.succeed <| MalSymbol "vector" [ MalMap _ _ ] -> Eval.succeed <| MalSymbol "vector" [ MalFunction _ ] -> Eval.succeed <| MalSymbol "function" [ MalAtom _ ] -> Eval.succeed <| MalSymbol "atom" _ -> Eval.fail "unsupported arguments" cons args = case args of [ e, MalList _ list ] -> Eval.succeed <| MalList Nothing (e :: list) [ e, MalVector _ vec ] -> Eval.succeed <| MalList Nothing (e :: (Array.toList vec)) _ -> Eval.fail "unsupported arguments" concat args = let go arg acc = case arg of MalList _ list -> Eval.succeed (acc ++ list) MalVector _ vec -> Eval.succeed (acc ++ Array.toList vec) _ -> Eval.fail "unsupported arguments" in List.foldl (go >> Eval.andThen) (Eval.succeed []) args |> Eval.map (MalList Nothing) core_vec args = case args of [MalVector _ xs] -> Eval.succeed <| MalVector Nothing xs [MalList _ xs] -> Eval.succeed <| MalVector Nothing <| Array.fromList xs [_] -> Eval.fail "vec: arg type" _ -> Eval.fail "vec: arg count" nth args = let get list index = if index < 0 then Nothing else if index == 0 then List.head list else case list of [] -> Nothing _ :: rest -> get rest (index - 1) make res = case res of Just value -> Eval.succeed value Nothing -> Eval.fail "index out of bounds" in case args of [ MalList _ list, MalInt index ] -> make <| get list index [ MalVector _ vec, MalInt index ] -> make <| Array.get index vec _ -> Eval.fail "unsupported arguments" first args = let make = Eval.succeed << Maybe.withDefault MalNil in case args of [ MalNil ] -> Eval.succeed MalNil [ MalList _ list ] -> make <| List.head list [ MalVector _ vec ] -> make <| Array.get 0 vec _ -> Eval.fail "unsupported arguments" core_rest args = case args of [ MalNil ] -> Eval.succeed <| MalList Nothing [] [ MalList _ [] ] -> Eval.succeed <| MalList Nothing [] [ MalList _ (head :: tail) ] -> Eval.succeed <| MalList Nothing tail [ MalVector _ vec ] -> Array.toList vec |> List.tail |> Maybe.withDefault [] |> MalList Nothing |> Eval.succeed _ -> Eval.fail "unsupported arguments" throw args = case args of ex :: _ -> Eval.throw ex _ -> Eval.fail "undefined exception" apply args = case args of (MalFunction func) :: rest -> case List.reverse rest of (MalList _ last) :: middle -> callFn func ((List.reverse middle) ++ last) (MalVector _ last) :: middle -> callFn func ((List.reverse middle) ++ (Array.toList last) ) _ -> Eval.fail "apply expected the last argument to be a list or vector" _ -> Eval.fail "unsupported arguments" core_map args = let go func list acc = case list of [] -> Eval.succeed <| MalList Nothing <| List.reverse acc inv :: rest -> callFn func [ inv ] |> Eval.andThen (\outv -> Eval.pushRef outv (go func rest (outv :: acc)) ) in case args of [ MalFunction func, MalList _ list ] -> Eval.withStack (go func list []) [ MalFunction func, MalVector _ vec ] -> go func (Array.toList vec) [] _ -> Eval.fail "unsupported arguments" isNil args = Eval.succeed <| MalBool <| case args of MalNil :: _ -> True _ -> False isTrue args = Eval.succeed <| MalBool <| case args of (MalBool True) :: _ -> True _ -> False isFalse args = Eval.succeed <| MalBool <| case args of (MalBool False) :: _ -> True _ -> False isNumber args = Eval.succeed <| MalBool <| case args of (MalInt _) :: _ -> True _ -> False isSymbol args = Eval.succeed <| MalBool <| case args of (MalSymbol _) :: _ -> True _ -> False isKeyword args = Eval.succeed <| MalBool <| case args of (MalKeyword _) :: _ -> True _ -> False isVector args = Eval.succeed <| MalBool <| case args of (MalVector _ _) :: _ -> True _ -> False isMap args = Eval.succeed <| MalBool <| case args of (MalMap _ _) :: _ -> True _ -> False isString args = Eval.succeed <| MalBool <| case args of (MalString _) :: _ -> True _ -> False isSequential args = Eval.succeed <| MalBool <| case args of (MalList _ _) :: _ -> True (MalVector _ _) :: _ -> True _ -> False isFn args = Eval.succeed <| MalBool <| case args of (MalFunction (CoreFunc _ _)) :: _ -> True (MalFunction (UserFunc fn)) :: _ -> not fn.isMacro _ -> False isMacro args = Eval.succeed <| MalBool <| case args of (MalFunction (UserFunc fn)) :: _ -> fn.isMacro _ -> False symbol args = case args of [ MalString str ] -> Eval.succeed <| MalSymbol str _ -> Eval.fail "unsupported arguments" core_keyword args = case args of [ MalString str ] -> Eval.succeed <| MalKeyword str [ (MalKeyword _) as kw ] -> Eval.succeed kw _ -> Eval.fail "unsupported arguments" vector args = Eval.succeed <| MalVector Nothing <| Array.fromList args parseKey key = case key of MalString str -> Ok str MalKeyword keyword -> Ok <| String.cons keywordPrefix keyword _ -> Err "map key must be a symbol or keyword" buildMap list acc = case list of [] -> Eval.succeed <| MalMap Nothing acc key :: value :: rest -> parseKey key |> Eval.fromResult |> Eval.andThen (\k -> buildMap rest (Dict.insert k value acc) ) _ -> Eval.fail "expected an even number of key-value pairs" hashMap args = buildMap args Dict.empty assoc args = case args of (MalMap _ dict) :: rest -> buildMap rest dict _ -> Eval.fail "unsupported arguments" dissoc args = let go keys acc = case keys of [] -> Eval.succeed <| MalMap Nothing acc key :: rest -> parseKey key |> Eval.fromResult |> Eval.andThen (\k -> go rest (Dict.remove k acc) ) in case args of (MalMap _ dict) :: keys -> go keys dict _ -> Eval.fail "unsupported arguments" core_get args = case args of [ MalNil, key ] -> Eval.succeed MalNil [ MalMap _ dict, key ] -> parseKey key |> Eval.fromResult |> Eval.map (\k -> Dict.get k dict |> Maybe.withDefault MalNil ) _ -> Eval.fail "unsupported arguments" contains args = case args of [ MalMap _ dict, key ] -> parseKey key |> Eval.fromResult |> Eval.map (\k -> Dict.member k dict) |> Eval.map MalBool _ -> Eval.fail "unsupported arguments" unparseKey key = case String.uncons key of Just ( prefix, rest ) -> if prefix == keywordPrefix then MalKeyword rest else MalString key _ -> MalString key core_keys args = case args of [ MalMap _ dict ] -> Dict.keys dict |> List.map unparseKey |> MalList Nothing |> Eval.succeed _ -> Eval.fail "unsupported arguments" vals args = case args of [ MalMap _ dict ] -> Dict.values dict |> MalList Nothing |> Eval.succeed _ -> Eval.fail "unsupported arguments" readLine args = case args of [ MalString prompt ] -> Eval.io (IO.readLine prompt) (\msg -> case msg of LineRead (Just line) -> Eval.succeed (MalString line) LineRead Nothing -> Eval.succeed MalNil _ -> Eval.fail "wrong IO, expected LineRead" ) _ -> Eval.fail "unsupported arguments" withMeta args = case args of [ MalFunction (UserFunc func), meta ] -> Eval.succeed <| MalFunction <| UserFunc { func | meta = Just meta } [ MalList _ xs, meta ] -> Eval.succeed <| MalList (Just meta) xs [ MalVector _ xs, meta ] -> Eval.succeed <| MalVector (Just meta) xs [ MalMap _ map, meta ] -> Eval.succeed <| MalMap (Just meta) map [ MalFunction (CoreFunc _ f), meta ] -> Eval.succeed <| MalFunction (CoreFunc (Just meta) f) _ -> Eval.fail "with-meta expected a user function and a map" core_meta args = case args of [ MalFunction (UserFunc { meta }) ] -> Eval.succeed (Maybe.withDefault MalNil meta) [ MalFunction (CoreFunc meta f) ] -> Eval.succeed (Maybe.withDefault MalNil meta) [ MalList meta _ ] -> Eval.succeed (Maybe.withDefault MalNil meta) [ MalVector meta _ ] -> Eval.succeed (Maybe.withDefault MalNil meta) [ MalMap meta _ ] -> Eval.succeed (Maybe.withDefault MalNil meta) _ -> Eval.succeed MalNil conj args = case args of (MalList _ list) :: rest -> Eval.succeed <| MalList Nothing <| List.reverse rest ++ list (MalVector _ vec) :: rest -> Eval.succeed <| MalVector Nothing <| Array.append vec (Array.fromList rest) _ -> Eval.fail "unsupported arguments" seq args = case args of [ MalNil ] -> Eval.succeed MalNil [ MalList _ [] ] -> Eval.succeed MalNil [ MalString "" ] -> Eval.succeed MalNil [ MalList _ xs ] -> Eval.succeed (MalList Nothing xs) [ MalVector _ vec ] -> Eval.succeed <| if Array.isEmpty vec then MalNil else MalList Nothing <| Array.toList vec [ MalString str ] -> Eval.succeed <| MalList Nothing <| (String.toList str |> List.map String.fromChar |> List.map MalString ) _ -> Eval.fail "unsupported arguments" requestTime = Task.perform (GotTime >> Ok >> Input) Time.now timeMs args = case args of [] -> Eval.io requestTime (\msg -> case msg of GotTime time -> Time.posixToMillis time |> MalInt |> Eval.succeed _ -> Eval.fail "wrong IO, expected GotTime" ) _ -> Eval.fail "time-ms takes no arguments" in Env.global |> Env.set "+" (makeFn <| binaryOp (+) MalInt) |> Env.set "-" (makeFn <| binaryOp (-) MalInt) |> Env.set "*" (makeFn <| binaryOp (*) MalInt) |> Env.set "/" (makeFn <| binaryOp (//) MalInt) |> Env.set "<" (makeFn <| binaryOp (<) MalBool) |> Env.set ">" (makeFn <| binaryOp (>) MalBool) |> Env.set "<=" (makeFn <| binaryOp (<=) MalBool) |> Env.set ">=" (makeFn <| binaryOp (>=) MalBool) |> Env.set "list" (makeFn core_list) |> Env.set "list?" (makeFn isList) |> Env.set "empty?" (makeFn isEmpty) |> Env.set "count" (makeFn count) |> Env.set "=" (makeFn equals) |> Env.set "pr-str" (makeFn prStr) |> Env.set "str" (makeFn core_str) |> Env.set "prn" (makeFn prn) |> Env.set "println" (makeFn println) |> Env.set "pr-env" (makeFn printEnv) |> Env.set "read-string" (makeFn readString) |> Env.set "slurp" (makeFn slurp) |> Env.set "atom" (makeFn atom) |> Env.set "atom?" (makeFn isAtom) |> Env.set "deref" (makeFn deref) |> Env.set "reset!" (makeFn reset) |> Env.set "swap!" (makeFn swap) |> Env.set "gc" (makeFn gc) |> Env.set "debug!" (makeFn debug) |> Env.set "typeof" (makeFn typeof) |> Env.set "cons" (makeFn cons) |> Env.set "concat" (makeFn concat) |> Env.set "vec" (makeFn core_vec) |> Env.set "nth" (makeFn nth) |> Env.set "first" (makeFn first) |> Env.set "rest" (makeFn core_rest) |> Env.set "throw" (makeFn throw) |> Env.set "apply" (makeFn apply) |> Env.set "map" (makeFn core_map) |> Env.set "nil?" (makeFn isNil) |> Env.set "true?" (makeFn isTrue) |> Env.set "false?" (makeFn isFalse) |> Env.set "number?" (makeFn isNumber) |> Env.set "symbol?" (makeFn isSymbol) |> Env.set "keyword?" (makeFn isKeyword) |> Env.set "vector?" (makeFn isVector) |> Env.set "map?" (makeFn isMap) |> Env.set "string?" (makeFn isString) |> Env.set "sequential?" (makeFn isSequential) |> Env.set "fn?" (makeFn isFn) |> Env.set "macro?" (makeFn isMacro) |> Env.set "symbol" (makeFn symbol) |> Env.set "keyword" (makeFn core_keyword) |> Env.set "vector" (makeFn vector) |> Env.set "hash-map" (makeFn hashMap) |> Env.set "assoc" (makeFn assoc) |> Env.set "dissoc" (makeFn dissoc) |> Env.set "get" (makeFn core_get) |> Env.set "contains?" (makeFn contains) |> Env.set "keys" (makeFn core_keys) |> Env.set "vals" (makeFn vals) |> Env.set "readline" (makeFn readLine) |> Env.set "with-meta" (makeFn withMeta) |> Env.set "meta" (makeFn core_meta) |> Env.set "conj" (makeFn conj) |> Env.set "seq" (makeFn seq) |> Env.set "time-ms" (makeFn timeMs) ================================================ FILE: impls/elm/src/Env.elm ================================================ module Env exposing ( debug , enter , gc , get , getAtom , global , globalFrameId , leave , newAtom , pop , push , pushRef , ref , restoreRefs , set , setAtom ) import Array import Dict import Set import Types exposing (Env, Frame, MalExpr(..), MalFunction(..)) import Utils exposing (flip) debug : Env -> String -> a -> a debug env msg value = if env.debug then Debug.log msg value else value globalFrameId : Int globalFrameId = 0 defaultGcInterval : Int defaultGcInterval = 10 global : Env global = { frames = Dict.singleton globalFrameId (emptyFrame Nothing Nothing) , nextFrameId = globalFrameId + 1 , currentFrameId = globalFrameId , atoms = Dict.empty , nextAtomId = 0 , debug = False , gcInterval = defaultGcInterval , gcCounter = 0 , stack = [] , keepFrames = [] } getFrame : Env -> Int -> Frame getFrame env frameId = case Dict.get frameId env.frames of Just frame -> frame Nothing -> Debug.todo <| "frame #" ++ String.fromInt frameId ++ " not found" emptyFrame : Maybe Int -> Maybe Int -> Frame emptyFrame outerId exitId = { outerId = outerId , exitId = exitId , data = Dict.empty , refCnt = 1 } set : String -> MalExpr -> Env -> Env set name expr env = let frameId = env.currentFrameId updateFrame = Maybe.map (\frame -> { frame | data = Dict.insert name expr frame.data } ) newFrames = Dict.update frameId updateFrame env.frames in { env | frames = newFrames } get : String -> Env -> Result String MalExpr get name env = let go frameId = let frame = getFrame env frameId in case Dict.get name frame.data of Just value -> Ok value Nothing -> frame.outerId |> Maybe.map go |> Maybe.withDefault (Err <| "'" ++ name ++ "' not found") in go env.currentFrameId newAtom : MalExpr -> Env -> ( Env, Int ) newAtom value env = let atomId = env.nextAtomId newEnv = { env | atoms = Dict.insert atomId value env.atoms , nextAtomId = atomId + 1 } in ( newEnv, atomId ) getAtom : Int -> Env -> MalExpr getAtom atomId env = case Dict.get atomId env.atoms of Just value -> value Nothing -> Debug.todo <| "atom " ++ String.fromInt atomId ++ " not found" setAtom : Int -> MalExpr -> Env -> Env setAtom atomId value env = { env | atoms = Dict.insert atomId value env.atoms } push : Env -> Env push env = let frameId = env.nextFrameId newFrame = emptyFrame (Just env.currentFrameId) Nothing bogus = debug env "push" frameId in { env | currentFrameId = frameId , frames = Dict.insert frameId newFrame env.frames , nextFrameId = env.nextFrameId + 1 } pop : Env -> Env pop env = let frameId = env.currentFrameId frame = getFrame env frameId bogus = debug env "pop" frameId in case frame.outerId of Just outerId -> { env | currentFrameId = outerId , frames = Dict.update frameId free env.frames } _ -> Debug.todo "tried to pop global frame" setBinds : List ( String, MalExpr ) -> Frame -> Frame setBinds binds frame = case binds of [] -> frame ( name, expr ) :: rest -> setBinds rest { frame | data = Dict.insert name expr frame.data } {-| Enter a new frame with a set of binds -} enter : Int -> List ( String, MalExpr ) -> Env -> Env enter outerId binds env = let frameId = debug env "enter #" env.nextFrameId exitId = env.currentFrameId newFrame = setBinds binds (emptyFrame (Just outerId) (Just exitId)) in { env | currentFrameId = frameId , frames = Dict.insert frameId newFrame env.frames , nextFrameId = env.nextFrameId + 1 } leave : Env -> Env leave env = let frameId = debug env "leave #" env.currentFrameId frame = getFrame env frameId exitId = case frame.exitId of Just exitId2 -> exitId2 Nothing -> Debug.todo <| "frame #" ++ String.fromInt frameId ++ " doesn't have an exitId" in { env | currentFrameId = exitId , frames = env.frames |> Dict.insert frameId { frame | exitId = Nothing } |> Dict.update frameId free } {-| Increase refCnt for the current frame, and all it's parent frames. -} ref : Env -> Env ref originalEnv = let go frameId env = let frame = getFrame env frameId newFrame = { frame | refCnt = frame.refCnt + 1 } newEnv = { env | frames = Dict.insert frameId newFrame env.frames } in case frame.outerId of Just outerId -> go outerId newEnv Nothing -> newEnv newEnv2 = go originalEnv.currentFrameId originalEnv in { newEnv2 | gcCounter = newEnv2.gcCounter + 1 } free : Maybe Frame -> Maybe Frame free = Maybe.andThen (\frame -> if frame.refCnt == 1 then Nothing else Just { frame | refCnt = frame.refCnt - 1 } ) pushRef : MalExpr -> Env -> Env pushRef ref_arg env = { env | stack = ref_arg :: env.stack } restoreRefs : List MalExpr -> Env -> Env restoreRefs refs env = { env | stack = refs } {-| Given an Env see which frames are not reachable from the global frame, or from the current expression. Return a new Env with the unreachable frames removed. -} gc : MalExpr -> Env -> Env gc expr env = let countList acc = List.foldl countExpr acc countFrame { data } acc = data |> Dict.values |> countList acc recur frameId acc = if not (Set.member frameId acc) then let frame = getFrame env frameId newAcc = Set.insert frameId acc in countFrame frame newAcc else acc countBound bound acc = bound |> List.map Tuple.second |> countList acc countExpr expr_arg acc = case expr_arg of MalFunction (UserFunc { frameId }) -> recur frameId acc MalApply { frameId, bound } -> recur frameId acc |> countBound bound MalList _ list -> countList acc list MalVector _ vec -> countList acc (Array.toList vec) MalMap _ map -> countList acc (Dict.values map) MalAtom atomId -> let value = getAtom atomId env in countExpr value acc _ -> acc initSet = Set.fromList ([ globalFrameId, env.currentFrameId ] ++ env.keepFrames ) countFrames frames acc = Set.toList frames |> List.map (getFrame env) |> List.foldl countFrame acc expand frameId frame fn acc = case fn frame of Nothing -> acc Just parentId -> Set.insert parentId acc expandBoth frameId = let frame = getFrame env frameId in expand frameId frame .outerId >> expand frameId frame .exitId expandParents frames = Set.foldl expandBoth frames frames loop acc = let newAcc = expandParents acc newParents = Set.diff newAcc acc in if Set.isEmpty newParents then newAcc else loop <| countFrames newParents newAcc makeNewEnv newFrames = { env | frames = newFrames , gcCounter = 0 } keepFilter keep frameId _ = Set.member frameId keep filterFrames frames keep = Dict.filter (keepFilter keep) frames in countFrames initSet initSet |> countExpr expr |> flip countList env.stack |> loop |> filterFrames env.frames |> makeNewEnv ================================================ FILE: impls/elm/src/Eval.elm ================================================ module Eval exposing (..) import Env import IO exposing (IO) import Types exposing (..) apply : Eval a -> Env -> EvalContext a apply f env = f env run : Env -> Eval a -> EvalContext a run env e = apply e env withEnv : (Env -> Eval a) -> Eval a withEnv f env = apply (f env) env setEnv : Env -> Eval () setEnv env _ = apply (succeed ()) env modifyEnv : (Env -> Env) -> Eval () modifyEnv f env = apply (succeed ()) (f env) succeed : a -> Eval a succeed res env = ( env, EvalOk res ) io : Cmd Msg -> (IO -> Eval a) -> Eval a io cmd cont env = ( env, EvalIO cmd cont ) map : (a -> b) -> Eval a -> Eval b map f e env0 = case apply e env0 of ( env, EvalOk res ) -> ( env, EvalOk (f res) ) ( env, EvalErr msg ) -> ( env, EvalErr msg ) ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> map f) ) {-| Chain two Eval's together. The function f takes the result from the left eval and generates a new Eval. -} andThen : (a -> Eval b) -> Eval a -> Eval b andThen f e env0 = case apply e env0 of ( env, EvalOk res ) -> apply (f res) env ( env, EvalErr msg ) -> ( env, EvalErr msg ) ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> andThen f) ) {-| Apply a transformation to the Env, for a Ok and a Err. -} finally : (Env -> Env) -> Eval a -> Eval a finally f e env0 = case apply e env0 of ( env, EvalOk res ) -> ( f env, EvalOk res ) ( env, EvalErr msg ) -> ( f env, EvalErr msg ) ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> finally f) ) gcPass : Eval MalExpr -> Eval MalExpr gcPass e env0 = let go env t expr = if env.gcCounter >= env.gcInterval then --Debug.log -- ("before GC: " -- ++ (printEnv env) -- ) -- "" -- |> always ( Env.gc env, t expr ) ( Env.gc expr env, t expr ) else ( env, t expr ) in case apply e env0 of ( env, EvalOk res ) -> go env EvalOk res ( env, EvalErr msg ) -> go env EvalErr msg ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> gcPass) ) catchError : (MalExpr -> Eval a) -> Eval a -> Eval a catchError f e env0 = case apply e env0 of ( env, EvalOk res ) -> ( env, EvalOk res ) ( env, EvalErr msg ) -> apply (f msg) env ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> catchError f) ) fail : String -> Eval a fail msg env = ( env, EvalErr <| MalString msg ) throw : MalExpr -> Eval a throw ex env = ( env, EvalErr ex ) {-| Apply f to expr repeatedly. Continues iterating if f returns (Left eval). Stops if f returns (Right expr). Tail call optimized. -} runLoop : (MalExpr -> Env -> Either (Eval MalExpr) MalExpr) -> MalExpr -> Eval MalExpr runLoop f expr0 env0 = case f expr0 env0 of Left e -> case apply e env0 of ( env, EvalOk expr ) -> runLoop f expr env ( env, EvalErr msg ) -> ( env, EvalErr msg ) ( env, EvalIO cmd cont ) -> ( env, EvalIO cmd (cont >> andThen (runLoop f)) ) Right expr -> ( env0, EvalOk expr ) fromResult : Result String a -> Eval a fromResult res = case res of Ok val -> succeed val Err msg -> fail msg {-| Chain the left and right Eval but ignore the right's result. -} ignore : Eval b -> Eval a -> Eval a ignore right left = left |> andThen (\res -> right |> andThen (\_ -> succeed res) ) withStack : Eval a -> Eval a withStack e = withEnv (\env -> e |> ignore (modifyEnv (Env.restoreRefs env.stack) ) ) pushRef : MalExpr -> Eval a -> Eval a pushRef ref e = modifyEnv (Env.pushRef ref) |> andThen (always e) inGlobal : Eval a -> Eval a inGlobal body = let enter env = setEnv { env | keepFrames = env.currentFrameId :: env.keepFrames , currentFrameId = Env.globalFrameId } leave oldEnv newEnv = { newEnv | keepFrames = oldEnv.keepFrames , currentFrameId = oldEnv.currentFrameId } in withEnv (\env -> if env.currentFrameId /= Env.globalFrameId then enter env |> andThen (always body) |> finally (leave env) else body ) runSimple : Eval a -> Result MalExpr a runSimple e = case run Env.global e of ( _, EvalOk res ) -> Ok res ( _, EvalErr msg ) -> Err msg _ -> Debug.todo "can't happen" ================================================ FILE: impls/elm/src/IO.elm ================================================ port module IO exposing ( IO(..) , decodeIO , input , readFile , readLine , writeLine ) import Json.Decode exposing (..) import Time exposing (Posix) {-| Output a string to stdout -} port writeLine : String -> Cmd msg {-| Read a line from the stdin -} port readLine : String -> Cmd msg {-| Read the contents of a file -} port readFile : String -> Cmd msg {-| Received a response for a command. -} port input : (Value -> msg) -> Sub msg type IO = LineRead (Maybe String) | LineWritten | FileRead String | Exception String | GotTime Posix decodeIO : Decoder IO decodeIO = field "tag" string |> andThen decodeTag decodeTag : String -> Decoder IO decodeTag tag = case tag of "lineRead" -> field "line" (nullable string) |> map LineRead "lineWritten" -> succeed LineWritten "fileRead" -> field "contents" string |> map FileRead "exception" -> field "message" string |> map Exception _ -> fail <| "Trying to decode IO, but tag " ++ tag ++ " is not supported." ================================================ FILE: impls/elm/src/Printer.elm ================================================ module Printer exposing (..) import Array exposing (Array) import Dict exposing (Dict) import Env import Types exposing (Env, MalExpr(..), MalFunction(..), keywordPrefix) import Utils exposing (encodeString, wrap) printStr : Bool -> MalExpr -> String printStr = printString Env.global printString : Env -> Bool -> MalExpr -> String printString env readably ast = case ast of MalNil -> "nil" MalBool True -> "true" MalBool False -> "false" MalInt int -> String.fromInt int MalString str -> printRawString env readably str MalSymbol sym -> sym MalKeyword kw -> ":" ++ kw MalList _ list -> printList env readably list MalVector _ vec -> printVector env readably vec MalMap _ map -> printMap env readably map MalFunction _ -> "#" MalAtom atomId -> let value = Env.getAtom atomId env in "(atom " ++ printString env True value ++ ")" MalApply _ -> "#" printBound : Env -> Bool -> List ( String, MalExpr ) -> String printBound env readably = let printEntry ( name, value ) = name ++ "=" ++ printString env readably value in List.map printEntry >> String.join " " >> wrap "(" ")" printRawString : Env -> Bool -> String -> String printRawString env readably str = if readably then encodeString str else str printList : Env -> Bool -> List MalExpr -> String printList env readably = List.map (printString env readably) >> String.join " " >> wrap "(" ")" printVector : Env -> Bool -> Array MalExpr -> String printVector env readably = Array.map (printString env readably) >> Array.toList >> String.join " " >> wrap "[" "]" printMap : Env -> Bool -> Dict String MalExpr -> String printMap env readably = let -- Strip off the keyword prefix if it is there. printKey k = case String.uncons k of Just ( prefix, rest ) -> if prefix == keywordPrefix then ":" ++ rest else printRawString env readably k _ -> printRawString env readably k printEntry ( k, v ) = printKey k ++ " " ++ printString env readably v in Dict.toList >> List.map printEntry >> String.join " " >> wrap "{" "}" printEnv : Env -> String printEnv env = let printOuterId = Maybe.map String.fromInt >> Maybe.withDefault "nil" printHeader frameId { outerId, exitId, refCnt } = "#" ++ String.fromInt frameId ++ " outer=" ++ printOuterId outerId ++ " exit=" ++ printOuterId exitId ++ " refCnt=" ++ String.fromInt refCnt printFrame frameId frame = String.join "\n" (printHeader frameId frame :: Dict.foldr printDatum [] frame.data ) printFrameAcc k v acc = printFrame k v :: acc printDatum k v acc = (k ++ " = " ++ printString env False v) :: acc in "--- Environment ---\n" ++ "Current frame: #" ++ String.fromInt env.currentFrameId ++ "\n\n" ++ String.join "\n\n" (Dict.foldr printFrameAcc [] env.frames) ================================================ FILE: impls/elm/src/Reader.elm ================================================ module Reader exposing (..) import Array import Dict import Parser exposing (DeadEnd, Parser, lazy, (|.), (|=)) import Types exposing (MalExpr(..), keywordPrefix) import Utils exposing (decodeString, makeCall) comment : Parser () comment = Parser.lineComment ";" ws : Parser () ws = let isSpaceChar : Char -> Bool isSpaceChar c = List.member c [' ', '\n', '\r', ','] in Parser.succeed () |. Parser.sequence { start = "" , separator = "" , end = "" , spaces = Parser.chompWhile isSpaceChar , item = comment , trailing = Parser.Optional } int : Parser MalExpr int = -- Parser.map MalInt Parser.int fails with elm/parser 1.1.0 let isDigit : Char -> Bool isDigit c = '0' <= c && c <= '9' toInt s = case String.toInt s of Just r -> MalInt r Nothing -> Debug.todo "should not happen" in Parser.map toInt <| Parser.getChompedString <| Parser.chompIf isDigit |. Parser.chompWhile isDigit symbolString : Parser String symbolString = let isSymbolChar : Char -> Bool isSymbolChar c = not (List.member c [' ', '\n', '\r', ',', '\\', '[', ']', '{', '}', '(', '\'', '"', '`', ';', ')']) in Parser.getChompedString <| Parser.chompIf isSymbolChar |. Parser.chompWhile isSymbolChar symbolOrConst : Parser MalExpr symbolOrConst = let make sym = case sym of "nil" -> MalNil "true" -> MalBool True "false" -> MalBool False _ -> MalSymbol sym in Parser.map make symbolString keywordString : Parser String keywordString = Parser.succeed identity |. Parser.token ":" |= symbolString keyword : Parser MalExpr keyword = Parser.map MalKeyword keywordString list : Parser MalExpr list = Parser.map (MalList Nothing) <| Parser.sequence { start = "(" , separator = "" , end = ")" , spaces = ws , item = form , trailing = Parser.Optional } vector : Parser MalExpr vector = Parser.map (MalVector Nothing << Array.fromList) <| Parser.sequence { start = "[" , separator = "" , end = "]" , spaces = ws , item = form , trailing = Parser.Optional } mapKey : Parser String mapKey = Parser.oneOf [ Parser.map (String.cons keywordPrefix) keywordString , Parser.map decodeString strString ] mapEntry : Parser ( String, MalExpr ) mapEntry = Parser.succeed Tuple.pair |= mapKey |= form map : Parser MalExpr map = Parser.map (MalMap Nothing << Dict.fromList) <| Parser.sequence { start = "{" , separator = "" , end = "}" , spaces = ws , item = mapEntry , trailing = Parser.Optional } atom : Parser MalExpr atom = Parser.oneOf [ Parser.succeed identity |. Parser.token "-" |= Parser.oneOf [ Parser.map (MalInt << negate) Parser.int , Parser.map (MalSymbol << (++) "-") symbolString , Parser.succeed (MalSymbol "-") ] , int , keyword , symbolOrConst , str ] form : Parser MalExpr form = lazy <| \() -> let parsers = [ list , vector , map , simpleMacro "'" "quote" , simpleMacro "`" "quasiquote" , simpleMacro "~@" "splice-unquote" , simpleMacro "~" "unquote" , simpleMacro "@" "deref" , withMeta , atom ] in Parser.succeed identity |. ws |= Parser.oneOf parsers simpleMacro : String -> String -> Parser MalExpr simpleMacro token symbol = Parser.succeed (makeCall symbol << List.singleton) |. Parser.token token |= form withMeta : Parser MalExpr withMeta = let make meta expr = makeCall "with-meta" [ expr, meta ] in Parser.succeed make |. Parser.token "^" |= form |= form readString : String -> Result String MalExpr readString str2 = case Parser.run (form |. ws |. Parser.end) str2 of Ok ast -> Ok ast Err deadEnds -> -- Should become Err <| Parser.deadEndsToString deadEnds -- once the function is implemented. Err <| formatError deadEnds formatError : List DeadEnd -> String formatError = let format1 deadEnd = Debug.toString deadEnd.problem ++ " at " ++ String.fromInt deadEnd.row ++ ":" ++ String.fromInt deadEnd.col in (++) "end of input\n" << String.join "\n" << List.map format1 str : Parser MalExpr str = Parser.map (MalString << decodeString) strString strString : Parser String strString = let isStringNormalChar : Char -> Bool isStringNormalChar c = not <| List.member c ['"', '\\'] in Parser.getChompedString <| Parser.sequence { start = "\"" , separator = "" , end = "\"" , spaces = Parser.succeed () , item = Parser.oneOf [ Parser.chompIf isStringNormalChar |. Parser.chompWhile isStringNormalChar , Parser.token "\\" |. Parser.chompIf (\_ -> True) ] , trailing = Parser.Forbidden } ================================================ FILE: impls/elm/src/Step0_repl.elm ================================================ module Step0_repl exposing (..) import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type alias Model = { args : List String } type Msg = Input (Result String IO) init : Flags -> ( Model, Cmd Msg ) init flags = ( flags, readLine prompt ) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Input (Ok (LineRead (Just line))) -> ( model, writeLine (rep line) ) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> ( model, Cmd.none ) Input (Ok _) -> ( model, Cmd.none ) Input (Err msg2) -> Debug.log msg2 ( model, Cmd.none ) prompt : String prompt = "user> " read : String -> String read ast = ast eval : String -> String eval ast = ast print : String -> String print ast = ast rep : String -> String rep = read >> eval >> print ================================================ FILE: impls/elm/src/Step1_read_print.elm ================================================ module Step1_read_print exposing (..) import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printStr) import Reader exposing (readString) import Types exposing (MalExpr(..)) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type alias Model = { args : List String } type Msg = Input (Result String IO) init : Flags -> ( Model, Cmd Msg ) init flags = ( flags, readLine prompt ) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Input (Ok (LineRead (Just line))) -> ( model, writeLine (rep line) ) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString eval : MalExpr -> MalExpr eval ast = ast print : MalExpr -> String print = printStr True {-| Read-Eval-Print -} rep : String -> String rep = let formatResult result = case result of Ok optStr -> optStr Err msg -> msg in readString >> Result.map (eval >> print) >> formatResult ================================================ FILE: impls/elm/src/Step2_eval.elm ================================================ module Step2_eval exposing (..) import Array import Dict exposing (Dict) import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printStr) import Reader exposing (readString) import Tuple exposing (mapFirst, second) import Types exposing (..) import Utils exposing (maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type alias ReplEnv = Dict String MalExpr type alias Model = { args : List String , env : ReplEnv } type Msg = Input (Result String IO) init : Flags -> ( Model, Cmd Msg ) init { args } = ( { args = args, env = initReplEnv }, readLine prompt ) initReplEnv : ReplEnv initReplEnv = let makeFn = CoreFunc Nothing >> MalFunction binaryOp fn args = case args of [ MalInt x, MalInt y ] -> Eval.succeed <| MalInt (fn x y) _ -> Eval.fail "unsupported arguments" in Dict.fromList [ ( "+", makeFn <| binaryOp (+) ) , ( "-", makeFn <| binaryOp (-) ) , ( "*", makeFn <| binaryOp (*) ) , ( "/", makeFn <| binaryOp (//) ) ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Input (Ok (LineRead (Just line))) -> let ( result, newEnv) = rep model.env line in ( { model | env = newEnv }, writeLine (makeOutput result) ) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) makeOutput : Result String String -> String makeOutput result = case result of Ok str -> str Err msg -> "Error: " ++ msg prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString eval : ReplEnv -> MalExpr -> ( Result String MalExpr, ReplEnv ) eval env ast = -- let -- _ = Debug.log ("EVAL: " ++ printStr env True ast) () -- -- The output ends with an ugly ": ()", but that does not hurt. -- in case ast of MalList _ [] -> ( Ok ast, env ) MalList _ list -> case evalList env list [] of ( Ok newList, newEnv ) -> case newList of [] -> ( Err "can't happen", newEnv ) (MalFunction (CoreFunc _ fn)) :: args -> case Eval.runSimple (fn args) of Ok res -> ( Ok res, newEnv ) Err msg -> ( Err (print msg), newEnv ) fn :: _ -> ( Err ((print fn) ++ " is not a function"), newEnv ) ( Err msg, newEnv ) -> ( Err msg, newEnv ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. case Dict.get sym env of Just val -> ( Ok val, env ) Nothing -> ( Err ("symbol '" ++ sym ++ "' not found"), env ) MalVector _ vec -> evalList env (Array.toList vec) [] |> mapFirst (Result.map (Array.fromList >> MalVector Nothing)) MalMap _ map -> evalList env (Dict.values map) [] |> mapFirst (Result.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) ) _ -> ( Ok ast, env ) evalList : ReplEnv -> List MalExpr -> List MalExpr -> ( Result String (List MalExpr), ReplEnv ) evalList env list acc = case list of [] -> ( Ok (List.reverse acc), env ) x :: rest -> case eval env x of ( Ok val, newEnv ) -> evalList newEnv rest (val :: acc) ( Err msg, newEnv ) -> ( Err msg, newEnv ) {-| Try to map a list with a fn that can return a Err. Maps the list from left to right. As soon as a error occurs it will not process any more elements and return the error. -} tryMapList : (a -> Result e b) -> List a -> Result e (List b) tryMapList fn list = let go x = Result.andThen (\acc -> case fn x of Ok val -> Ok (val :: acc) Err msg -> Err msg ) in List.foldl go (Ok []) list |> Result.map List.reverse print : MalExpr -> String print = printStr True {-| Read-Eval-Print -} rep : ReplEnv -> String -> ( Result String String, ReplEnv ) rep env input = let evalPrint = eval env >> mapFirst (Result.map print) in case readString input of Err msg -> ( Err msg, env ) Ok ast -> evalPrint ast ================================================ FILE: impls/elm/src/Step3_env.elm ================================================ module Step3_env exposing (..) import Array import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Tuple exposing (mapFirst, mapSecond, second) import Types exposing (..) import Utils exposing (maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type alias Model = { args : List String , env : Env } type Msg = Input (Result String IO) init : Flags -> ( Model, Cmd Msg ) init { args } = ( { args = args, env = initReplEnv }, readLine prompt ) initReplEnv : Env initReplEnv = let makeFn = CoreFunc Nothing >> MalFunction binaryOp fn args = case args of [ MalInt x, MalInt y ] -> Eval.succeed <| MalInt (fn x y) _ -> Eval.fail "unsupported arguments" in Env.global |> Env.set "+" (makeFn <| binaryOp (+)) |> Env.set "-" (makeFn <| binaryOp (-)) |> Env.set "*" (makeFn <| binaryOp (*)) |> Env.set "/" (makeFn <| binaryOp (//)) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Input (Ok (LineRead (Just line))) -> let ( result, newEnv) = rep model.env line in ( { model | env = newEnv }, writeLine (makeOutput result) ) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) makeOutput : Result String String -> String makeOutput result = case result of Ok str -> str Err msg -> "Error: " ++ msg prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString eval : Env -> MalExpr -> ( Result String MalExpr, Env ) eval env ast = let _ = case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. in case ast of MalList _ [] -> ( Ok ast, env ) MalList _ ((MalSymbol "def!") :: args) -> evalDef env args MalList _ ((MalSymbol "let*") :: args) -> evalLet env args MalList _ list -> case evalList env list [] of ( Ok newList, newEnv ) -> case newList of [] -> ( Err "can't happen", newEnv ) (MalFunction (CoreFunc _ fn)) :: args -> case Eval.runSimple (fn args) of Ok res -> ( Ok res, newEnv ) Err msg -> ( Err (print msg), newEnv ) fn :: _ -> ( Err ((print fn) ++ " is not a function"), newEnv ) ( Err msg, newEnv ) -> ( Err msg, newEnv ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. case Env.get sym env of Ok val -> ( Ok val, env ) Err msg -> ( Err msg, env ) MalVector _ vec -> evalList env (Array.toList vec) [] |> mapFirst (Result.map (Array.fromList >> MalVector Nothing)) MalMap _ map -> evalList env (Dict.values map) [] |> mapFirst (Result.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) ) _ -> ( Ok ast, env ) evalList : Env -> List MalExpr -> List MalExpr -> ( Result String (List MalExpr), Env ) evalList env list acc = case list of [] -> ( Ok (List.reverse acc), env ) x :: rest -> case eval env x of ( Ok val, newEnv ) -> evalList newEnv rest (val :: acc) ( Err msg, newEnv ) -> ( Err msg, newEnv ) evalDef : Env -> List MalExpr -> ( Result String MalExpr, Env ) evalDef env args = case args of [ MalSymbol name, uneValue ] -> case eval env uneValue of ( Ok value, newEnv ) -> ( Ok value, Env.set name value newEnv ) err -> err _ -> ( Err "def! expected two args: name and value", env ) evalLet : Env -> List MalExpr -> ( Result String MalExpr, Env ) evalLet env args = let evalBinds env2 binds = case binds of (MalSymbol name) :: expr :: rest -> case eval env2 expr of ( Ok value, newEnv ) -> let newEnv2 = Env.set name value env2 in if List.isEmpty rest then Ok newEnv2 else evalBinds newEnv2 rest ( Err msg, _ ) -> Err msg _ -> Err "let* expected an even number of binds (symbol expr ..)" go binds body = case evalBinds (Env.push env) binds of Ok newEnv -> eval newEnv body |> mapSecond (\_ -> Env.pop newEnv) Err msg -> ( Err msg, env ) in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> ( Err "let* expected two args: binds and a body", env ) {-| Try to map a list with a fn that can return a Err. Maps the list from left to right. As soon as a error occurs it will not process any more elements and return the error. -} tryMapList : (a -> Result e b) -> List a -> Result e (List b) tryMapList fn list = let go x = Result.andThen (\acc -> case fn x of Ok val -> Ok (val :: acc) Err msg -> Err msg ) in List.foldl go (Ok []) list |> Result.map List.reverse print : MalExpr -> String print = printString Env.global True {-| Read-Eval-Print -} rep : Env -> String -> ( Result String String, Env ) rep env input = let evalPrint = eval env >> mapFirst (Result.map print) in case readString input of Err msg -> ( Err msg, env ) Ok ast -> evalPrint ast ================================================ FILE: impls/elm/src/Step4_if_fn_do.elm ================================================ module Step4_if_fn_do exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type Model = InitIO Env (IO -> Eval MalExpr) | InitError | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) init : Flags -> ( Model, Cmd Msg ) init { args } = let initEnv = Core.ns evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of InitError -> -- ignore all ( model, Cmd.none ) InitIO env cont -> case msg of Input (Ok io) -> runInit env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay, start REPL. ( ReplActive env, readLine prompt ) ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( InitError, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString eval : MalExpr -> Eval MalExpr eval ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ list -> evalList list |> Eval.andThen (\newList -> case newList of [] -> Eval.fail "can't happen" (MalFunction (CoreFunc _ fn)) :: args -> fn args (MalFunction (UserFunc { eagerFn })) :: args -> eagerFn args fn :: _ -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (\env -> case Env.get sym env of Ok val -> Eval.succeed val Err msg -> Eval.fail msg ) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> eval body) |> Eval.andThen (\res -> Eval.modifyEnv Env.pop |> Eval.map (\_ -> res) ) in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = let returnLast list = case last list of Just value -> Eval.succeed value Nothing -> Eval.fail "do expected at least one arg" in evalList args |> Eval.andThen returnLast evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> eval (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let fn args = case binder args of Ok bound -> Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (always (eval body)) |> Eval.finally Env.leave ) Err msg -> Eval.fail msg in UserFunc { frameId = frameId , lazyFn = fn , eagerFn = fn , isMacro = False , meta = Nothing } go bindsList body = case extractAndParse bindsList of Ok binder -> Eval.modifyEnv Env.ref -- reference the current frame. |> Eval.andThen (\_ -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) Err msg -> Eval.fail msg in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Step5_tco.elm ================================================ module Step5_tco exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Flags = { args : List String } type Model = InitIO Env (IO -> Eval MalExpr) | InitError | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) init : Flags -> ( Model, Cmd Msg ) init { args } = let initEnv = Core.ns evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of InitError -> -- ignore all ( model, Cmd.none ) InitIO env cont -> case msg of Input (Ok io) -> runInit env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay, start REPL. ( ReplActive env, readLine prompt ) ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( InitError, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ list -> evalList list |> Eval.andThen (\newList -> case newList of [] -> Eval.fail "can't happen" (MalFunction (CoreFunc _ fn)) :: args -> fn args (MalFunction (UserFunc { lazyFn })) :: args -> lazyFn args fn :: _ -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (\env -> case Env.get sym env of Ok val -> Eval.succeed val Err msg -> Eval.fail msg ) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.andThen (\res -> Eval.modifyEnv Env.pop |> Eval.map (\_ -> res) ) in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn args = case binder args of Ok bound -> Eval.succeed <| MalApply { frameId = frameId , bound = bound , body = body } Err msg -> Eval.fail msg in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = case extractAndParse bindsList of Ok binder -> Eval.modifyEnv Env.ref -- reference the current frame. |> Eval.andThen (\_ -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) Err msg -> Eval.fail msg in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Step6_file.elm ================================================ module Step6_file exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Args = List String type alias Flags = { args : Args } type Model = InitIO Args Env (IO -> Eval MalExpr) | ScriptIO Env (IO -> Eval MalExpr) | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) | Stopped init : Flags -> ( Model, Cmd Msg ) init { args } = let makeFn = CoreFunc Nothing >> MalFunction initEnv = Core.ns |> Env.set "eval" (makeFn malEval) |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit args initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" , """(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of Stopped -> ( model, Cmd.none ) InitIO args env cont -> case msg of Input (Ok io) -> runInit args env (cont io) Input (Err msg2) -> Debug.todo msg2 ScriptIO env cont -> case msg of Input (Ok io) -> runScriptLoop env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit args env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay. case args of -- If we got no args: start REPL. [] -> ( ReplActive env, readLine prompt ) -- Run the script in the first argument. -- Put the rest of the arguments as *ARGV*. filename :: argv -> runScript filename argv env ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO args env cont, cmd ) runScript : String -> List String -> Env -> ( Model, Cmd Msg ) runScript filename argv env = let malArgv = MalList Nothing (List.map MalString argv) newEnv = env |> Env.set "*ARGV*" malArgv program = MalList Nothing [ MalSymbol "load-file" , MalString filename ] in runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runScriptLoop env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( Stopped, Cmd.none ) ( env, EvalErr msg ) -> ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ScriptIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr malEval args = case args of [ expr ] -> Eval.inGlobal (eval expr) _ -> Eval.fail "unsupported arguments" evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ list -> evalList list |> Eval.andThen (\newList -> case newList of [] -> Eval.fail "can't happen" (MalFunction (CoreFunc _ fn)) :: args -> fn args (MalFunction (UserFunc { lazyFn })) :: args -> lazyFn args fn :: _ -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (\env -> case Env.get sym env of Ok val -> Eval.succeed val Err msg -> Eval.fail msg ) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.andThen (\res -> Eval.modifyEnv Env.pop |> Eval.map (\_ -> res) ) in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn args = case binder args of Ok bound -> Eval.succeed <| MalApply { frameId = frameId , bound = bound , body = body } Err msg -> Eval.fail msg in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = case extractAndParse bindsList of Ok binder -> Eval.modifyEnv Env.ref -- reference the current frame. |> Eval.andThen (\_ -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) Err msg -> Eval.fail msg in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Step7_quote.elm ================================================ module Step7_quote exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Args = List String type alias Flags = { args : Args } type Model = InitIO Args Env (IO -> Eval MalExpr) | ScriptIO Env (IO -> Eval MalExpr) | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) | Stopped init : Flags -> ( Model, Cmd Msg ) init { args } = let makeFn = CoreFunc Nothing >> MalFunction initEnv = Core.ns |> Env.set "eval" (makeFn malEval) |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit args initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" , """(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of Stopped -> ( model, Cmd.none ) InitIO args env cont -> case msg of Input (Ok io) -> runInit args env (cont io) Input (Err msg2) -> Debug.todo msg2 ScriptIO env cont -> case msg of Input (Ok io) -> runScriptLoop env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit args env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay. case args of -- If we got no args: start REPL. [] -> ( ReplActive env, readLine prompt ) -- Run the script in the first argument. -- Put the rest of the arguments as *ARGV*. filename :: argv -> runScript filename argv env ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO args env cont, cmd ) runScript : String -> List String -> Env -> ( Model, Cmd Msg ) runScript filename argv env = let malArgv = MalList Nothing (List.map MalString argv) newEnv = env |> Env.set "*ARGV*" malArgv program = MalList Nothing [ MalSymbol "load-file" , MalString filename ] in runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runScriptLoop env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( Stopped, Cmd.none ) ( env, EvalErr msg ) -> ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ScriptIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr malEval args = case args of [ expr ] -> Eval.inGlobal (eval expr) _ -> Eval.fail "unsupported arguments" evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ ((MalSymbol "quote") :: args) -> evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> -- TCO. evalNoApply (evalQuasiQuote expr) _ -> Eval.fail "unsupported arguments" MalList _ list -> evalList list |> Eval.andThen (\newList -> case newList of [] -> Eval.fail "can't happen" (MalFunction (CoreFunc _ fn)) :: args -> fn args (MalFunction (UserFunc { lazyFn })) :: args -> lazyFn args fn :: _ -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (Env.get sym >> Eval.fromResult) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn = binder >> Eval.fromResult >> Eval.map (\bound -> MalApply { frameId = frameId , bound = bound , body = body } ) in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = extractAndParse bindsList |> Eval.fromResult -- reference the current frame. |> Eval.ignore (Eval.modifyEnv Env.ref) |> Eval.andThen (\binder -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr evalQuote args = case args of [ expr ] -> Eval.succeed expr _ -> Eval.fail "unsupported arguments" evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let qq_loop : MalExpr -> MalExpr -> MalExpr qq_loop elt acc = case elt of (MalList _ [MalSymbol "splice-unquote", form]) -> makeCall "concat" [ form, acc ] _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in case expr of MalList _ [MalSymbol "unquote", form] -> form MalList _ xs -> List.foldr qq_loop (MalList Nothing []) xs MalVector _ xs -> makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] MalSymbol _ -> makeCall "quote" [ expr ] MalMap _ _ -> makeCall "quote" [ expr ] _ -> expr print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Step8_macros.elm ================================================ module Step8_macros exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Args = List String type alias Flags = { args : Args } type Model = InitIO Args Env (IO -> Eval MalExpr) | ScriptIO Env (IO -> Eval MalExpr) | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) | Stopped init : Flags -> ( Model, Cmd Msg ) init { args } = let makeFn = CoreFunc Nothing >> MalFunction initEnv = Core.ns |> Env.set "eval" (makeFn malEval) |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit args initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" , """(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""" , """(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)))))))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of Stopped -> ( model, Cmd.none ) InitIO args env cont -> case msg of Input (Ok io) -> runInit args env (cont io) Input (Err msg2) -> Debug.todo msg2 ScriptIO env cont -> case msg of Input (Ok io) -> runScriptLoop env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit args env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay. case args of -- If we got no args: start REPL. [] -> ( ReplActive env, readLine prompt ) -- Run the script in the first argument. -- Put the rest of the arguments as *ARGV*. filename :: argv -> runScript filename argv env ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO args env cont, cmd ) runScript : String -> List String -> Env -> ( Model, Cmd Msg ) runScript filename argv env = let malArgv = MalList Nothing (List.map MalString argv) newEnv = env |> Env.set "*ARGV*" malArgv program = MalList Nothing [ MalSymbol "load-file" , MalString filename ] in runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runScriptLoop env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( Stopped, Cmd.none ) ( env, EvalErr msg ) -> ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ScriptIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr malEval args = case args of [ expr ] -> Eval.inGlobal (eval expr) _ -> Eval.fail "unsupported arguments" evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ ((MalSymbol "quote") :: args) -> evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> -- TCO. evalNoApply (evalQuasiQuote expr) _ -> Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> evalDefMacro args MalList _ (a0 :: rest) -> eval a0 |> Eval.andThen (\f -> case f of MalFunction (CoreFunc _ fn) -> let args = evalList rest in Eval.andThen fn args MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> if isMacro then Eval.andThen evalNoApply (eagerFn rest) else let args = evalList rest in Eval.andThen lazyFn args fn -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (Env.get sym >> Eval.fromResult) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalDefMacro : List MalExpr -> Eval MalExpr evalDefMacro args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> case value of MalFunction (UserFunc fn) -> let macroFn = MalFunction (UserFunc { fn | isMacro = True }) in Eval.modifyEnv (Env.set name macroFn) |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" ) _ -> Eval.fail "defmacro! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn = binder >> Eval.fromResult >> Eval.map (\bound -> MalApply { frameId = frameId , bound = bound , body = body } ) in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = extractAndParse bindsList |> Eval.fromResult -- reference the current frame. |> Eval.ignore (Eval.modifyEnv Env.ref) |> Eval.andThen (\binder -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr evalQuote args = case args of [ expr ] -> Eval.succeed expr _ -> Eval.fail "unsupported arguments" evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let qq_loop : MalExpr -> MalExpr -> MalExpr qq_loop elt acc = case elt of (MalList _ [MalSymbol "splice-unquote", form]) -> makeCall "concat" [ form, acc ] _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in case expr of MalList _ [MalSymbol "unquote", form] -> form MalList _ xs -> List.foldr qq_loop (MalList Nothing []) xs MalVector _ xs -> makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] MalSymbol _ -> makeCall "quote" [ expr ] MalMap _ _ -> makeCall "quote" [ expr ] _ -> expr print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Step9_try.elm ================================================ module Step9_try exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Args = List String type alias Flags = { args : Args } type Model = InitIO Args Env (IO -> Eval MalExpr) | ScriptIO Env (IO -> Eval MalExpr) | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) | Stopped init : Flags -> ( Model, Cmd Msg ) init { args } = let makeFn = CoreFunc Nothing >> MalFunction initEnv = Core.ns |> Env.set "eval" (makeFn malEval) |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit args initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" , """(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""" , """(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)))))))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of Stopped -> ( model, Cmd.none ) InitIO args env cont -> case msg of Input (Ok io) -> runInit args env (cont io) Input (Err msg2) -> Debug.todo msg2 ScriptIO env cont -> case msg of Input (Ok io) -> runScriptLoop env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit args env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay. case args of -- If we got no args: start REPL. [] -> ( ReplActive env, readLine prompt ) -- Run the script in the first argument. -- Put the rest of the arguments as *ARGV*. filename :: argv -> runScript filename argv env ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO args env cont, cmd ) runScript : String -> List String -> Env -> ( Model, Cmd Msg ) runScript filename argv env = let malArgv = MalList Nothing (List.map MalString argv) newEnv = env |> Env.set "*ARGV*" malArgv program = MalList Nothing [ MalSymbol "load-file" , MalString filename ] in runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runScriptLoop env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( Stopped, Cmd.none ) ( env, EvalErr msg ) -> ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ScriptIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr malEval args = case args of [ expr ] -> Eval.inGlobal (eval expr) _ -> Eval.fail "unsupported arguments" evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ ((MalSymbol "quote") :: args) -> evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> -- TCO. evalNoApply (evalQuasiQuote expr) _ -> Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> evalDefMacro args MalList _ ((MalSymbol "try*") :: args) -> evalTry args MalList _ (a0 :: rest) -> eval a0 |> Eval.andThen (\f -> case f of MalFunction (CoreFunc _ fn) -> let args = evalList rest in Eval.andThen fn args MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> if isMacro then Eval.andThen evalNoApply (eagerFn rest) else let args = evalList rest in Eval.andThen lazyFn args fn -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (Env.get sym >> Eval.fromResult) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> go rest (val :: acc) ) in go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalDefMacro : List MalExpr -> Eval MalExpr evalDefMacro args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> case value of MalFunction (UserFunc fn) -> let macroFn = MalFunction (UserFunc { fn | isMacro = True }) in Eval.modifyEnv (Env.set name macroFn) |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" ) _ -> Eval.fail "defmacro! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn = binder >> Eval.fromResult >> Eval.map (\bound -> MalApply { frameId = frameId , bound = bound , body = body } ) in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = extractAndParse bindsList |> Eval.fromResult -- reference the current frame. |> Eval.ignore (Eval.modifyEnv Env.ref) |> Eval.andThen (\binder -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr evalQuote args = case args of [ expr ] -> Eval.succeed expr _ -> Eval.fail "unsupported arguments" evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let qq_loop : MalExpr -> MalExpr -> MalExpr qq_loop elt acc = case elt of (MalList _ [MalSymbol "splice-unquote", form]) -> makeCall "concat" [ form, acc ] _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in case expr of MalList _ [MalSymbol "unquote", form] -> form MalList _ xs -> List.foldr qq_loop (MalList Nothing []) xs MalVector _ xs -> makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] MalSymbol _ -> makeCall "quote" [ expr ] MalMap _ _ -> makeCall "quote" [ expr ] _ -> expr evalTry : List MalExpr -> Eval MalExpr evalTry args = case args of [ body ] -> eval body [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> eval body |> Eval.catchError (\ex -> Eval.modifyEnv Env.push |> Eval.andThen (\_ -> Eval.modifyEnv (Env.set sym ex) ) |> Eval.andThen (\_ -> eval handler) |> Eval.finally Env.pop ) _ -> Eval.fail "try* expected a body a catch block" print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/StepA_mal.elm ================================================ module StepA_mal exposing (..) import Array import Core import Dict exposing (Dict) import Env import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) import Platform exposing (worker) import Printer exposing (printString) import Reader exposing (readString) import Types exposing (..) import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = worker { init = init , update = update , subscriptions = \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) } type alias Args = List String type alias Flags = { args : Args } type Model = InitIO Args Env (IO -> Eval MalExpr) | ScriptIO Env (IO -> Eval MalExpr) | ReplActive Env | ReplIO Env (IO -> Eval MalExpr) | Stopped init : Flags -> ( Model, Cmd Msg ) init { args } = let makeFn = CoreFunc Nothing >> MalFunction initEnv = Core.ns |> Env.set "eval" (makeFn malEval) |> Env.set "*ARGV*" (MalList Nothing (args |> List.map MalString)) |> Env.set "*host-language*" (MalString "elm") evalMalInit = malInit |> List.map rep |> List.foldl (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in runInit args initEnv evalMalInit malInit : List String malInit = [ """(def! not (fn* (a) (if a false true)))""" , """(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""" , """(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)))))))""" ] update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case model of Stopped -> ( model, Cmd.none ) InitIO args env cont -> case msg of Input (Ok io) -> runInit args env (cont io) Input (Err msg2) -> Debug.todo msg2 ScriptIO env cont -> case msg of Input (Ok io) -> runScriptLoop env (cont io) Input (Err msg2) -> Debug.todo msg2 ReplActive env -> case msg of Input (Ok (LineRead (Just line))) -> run env (rep line) Input (Ok LineWritten) -> ( model, readLine prompt ) Input (Ok (LineRead Nothing)) -> -- Ctrl+D = The End. ( model, Cmd.none ) Input (Ok io) -> Debug.todo "unexpected IO received: " io Input (Err msg2) -> Debug.todo msg2 ReplIO env cont -> case msg of Input (Ok io) -> run env (cont io) Input (Err msg2) -> Debug.todo msg2 ( model, Cmd.none ) runInit : Args -> Env -> Eval MalExpr -> ( Model, Cmd Msg ) runInit args env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> -- Init went okay. case args of -- If we got no args: start REPL. [] -> ( ReplActive env, readLine prompt ) -- Run the script in the first argument. -- Put the rest of the arguments as *ARGV*. filename :: argv -> runScript filename argv env ( env, EvalErr msg ) -> -- Init failed, don't start REPL. ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> -- IO in init. ( InitIO args env cont, cmd ) runScript : String -> List String -> Env -> ( Model, Cmd Msg ) runScript filename argv env = let malArgv = MalList Nothing (List.map MalString argv) newEnv = env |> Env.set "*ARGV*" malArgv program = MalList Nothing [ MalSymbol "load-file" , MalString filename ] in runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) runScriptLoop env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( Stopped, Cmd.none ) ( env, EvalErr msg ) -> ( Stopped, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ScriptIO env cont, cmd ) run : Env -> Eval MalExpr -> ( Model, Cmd Msg ) run env0 expr0 = case Eval.run env0 expr0 of ( env, EvalOk expr ) -> ( ReplActive env, writeLine (print env expr) ) ( env, EvalErr msg ) -> ( ReplActive env, writeLine (printError env msg) ) ( env, EvalIO cmd cont ) -> ( ReplIO env cont, cmd ) prompt : String prompt = "user> " read : String -> Result String MalExpr read = readString debug : String -> (Env -> a) -> Eval b -> Eval b debug msg f e = Eval.withEnv (\env -> Env.debug env msg (f env) |> always e ) eval : MalExpr -> Eval MalExpr eval ast = let apply expr env = case expr of MalApply app -> Left (debug "evalApply" (\env2 -> printString env2 True expr) (evalApply app) ) _ -> Right expr in evalNoApply ast |> Eval.andThen (Eval.runLoop apply) |> Eval.gcPass malEval : List MalExpr -> Eval MalExpr malEval args = case args of [ expr ] -> Eval.inGlobal (eval expr) _ -> Eval.fail "unsupported arguments" evalApply : ApplyRec -> Eval MalExpr evalApply { frameId, bound, body } = Eval.withEnv (\env -> Eval.modifyEnv (Env.enter frameId bound) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.leave |> Eval.gcPass ) evalNoApply : MalExpr -> Eval MalExpr evalNoApply ast = Eval.withEnv (\env -> Eval.succeed <| case Env.get "DEBUG-EVAL" env of Err _ -> () Ok MalNil -> () Ok (MalBool False) -> () _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> evalDef args MalList _ ((MalSymbol "let*") :: args) -> evalLet args MalList _ ((MalSymbol "do") :: args) -> evalDo args MalList _ ((MalSymbol "if") :: args) -> evalIf args MalList _ ((MalSymbol "fn*") :: args) -> evalFn args MalList _ ((MalSymbol "quote") :: args) -> evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> -- TCO. evalNoApply (evalQuasiQuote expr) _ -> Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> evalDefMacro args MalList _ ((MalSymbol "try*") :: args) -> evalTry args MalList _ (a0 :: rest) -> eval a0 |> Eval.andThen (\f -> case f of MalFunction (CoreFunc _ fn) -> let args = evalList rest in Eval.andThen fn args MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> if isMacro then Eval.andThen evalNoApply (eagerFn rest) else let args = evalList rest in Eval.andThen lazyFn args fn -> Eval.withEnv (\env -> Eval.fail (printString env True fn ++ " is not a function") ) ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. Eval.withEnv (Env.get sym >> Eval.fromResult) MalVector _ vec -> evalList (Array.toList vec) |> Eval.map (Array.fromList >> MalVector Nothing) MalMap _ map -> evalList (Dict.values map) |> Eval.map (zip (Dict.keys map) >> Dict.fromList >> MalMap Nothing ) _ -> Eval.succeed ast ) |> Eval.andThen (\res -> debug "evalNoApply" (\env -> (printString env True ast) ++ " = " ++ (printString env True res)) (Eval.succeed res) ) evalList : List MalExpr -> Eval (List MalExpr) evalList list = let go lst acc = case lst of [] -> Eval.succeed (List.reverse acc) x :: rest -> eval x |> Eval.andThen (\val -> Eval.pushRef val <| go rest (val :: acc) ) in Eval.withStack <| go list [] evalDef : List MalExpr -> Eval MalExpr evalDef args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> Eval.succeed value) ) _ -> Eval.fail "def! expected two args: name and value" evalDefMacro : List MalExpr -> Eval MalExpr evalDefMacro args = case args of [ MalSymbol name, uneValue ] -> eval uneValue |> Eval.andThen (\value -> case value of MalFunction (UserFunc fn) -> let macroFn = MalFunction (UserFunc { fn | isMacro = True }) in Eval.modifyEnv (Env.set name macroFn) |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" ) _ -> Eval.fail "defmacro! expected two args: name and value" evalLet : List MalExpr -> Eval MalExpr evalLet args = let evalBinds binds = case binds of (MalSymbol name) :: expr :: rest -> eval expr |> Eval.andThen (\value -> Eval.modifyEnv (Env.set name value) |> Eval.andThen (\_ -> if List.isEmpty rest then Eval.succeed () else evalBinds rest ) ) _ -> Eval.fail "let* expected an even number of binds (symbol expr ..)" go binds body = Eval.modifyEnv Env.push |> Eval.andThen (\_ -> evalBinds binds) |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in case args of [ MalList _ binds, body ] -> go binds body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr evalDo args = case List.reverse args of last :: rest -> evalList (List.reverse rest) |> Eval.andThen (\_ -> evalNoApply last) [] -> Eval.fail "do expected at least one arg" evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition |> Eval.andThen (\cond -> evalNoApply (if isTruthy cond then trueExpr else falseExpr ) ) in case args of [ condition, trueExpr ] -> go condition trueExpr MalNil [ condition, trueExpr, falseExpr ] -> go condition trueExpr falseExpr _ -> Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr evalFn parms = let {- Extract symbols from the binds list and verify their uniqueness -} extractSymbols acc list = case list of [] -> Ok (List.reverse acc) (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" else extractSymbols (name :: acc) rest _ -> Err "all binds in fn* must be a symbol" parseBinds list = case List.reverse list of var :: "&" :: rest -> Ok <| bindVarArgs (List.reverse rest) var _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" else Ok <| bindArgs list extractAndParse = extractSymbols [] >> Result.andThen parseBinds bindArgs binds args = let numBinds = List.length binds in if List.length args /= numBinds then Err <| "function expected " ++ String.fromInt numBinds ++ " arguments" else Ok <| zip binds args bindVarArgs binds var args = let minArgs = List.length binds varArgs = MalList Nothing (List.drop minArgs args) in if List.length args < minArgs then Err <| "function expected at least " ++ String.fromInt minArgs ++ " arguments" else Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| let lazyFn = binder >> Eval.fromResult >> Eval.map (\bound -> MalApply { frameId = frameId , bound = bound , body = body } ) in UserFunc { frameId = frameId , lazyFn = lazyFn , eagerFn = lazyFn >> Eval.andThen eval , isMacro = False , meta = Nothing } go bindsList body = extractAndParse bindsList |> Eval.fromResult -- reference the current frame. |> Eval.ignore (Eval.modifyEnv Env.ref) |> Eval.andThen (\binder -> Eval.withEnv (\env -> Eval.succeed (makeFn env.currentFrameId binder body) ) ) in case parms of [ MalList _ bindsList, body ] -> go bindsList body [ MalVector _ bindsVec, body ] -> go (Array.toList bindsVec) body _ -> Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr evalQuote args = case args of [ expr ] -> Eval.succeed expr _ -> Eval.fail "unsupported arguments" evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let qq_loop : MalExpr -> MalExpr -> MalExpr qq_loop elt acc = case elt of (MalList _ [MalSymbol "splice-unquote", form]) -> makeCall "concat" [ form, acc ] _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in case expr of MalList _ [MalSymbol "unquote", form] -> form MalList _ xs -> List.foldr qq_loop (MalList Nothing []) xs MalVector _ xs -> makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] MalSymbol _ -> makeCall "quote" [ expr ] MalMap _ _ -> makeCall "quote" [ expr ] _ -> expr evalTry : List MalExpr -> Eval MalExpr evalTry args = case args of [ body ] -> eval body [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> eval body |> Eval.catchError (\ex -> Eval.modifyEnv Env.push |> Eval.andThen (\_ -> Eval.modifyEnv (Env.set sym ex) ) |> Eval.andThen (\_ -> eval handler) |> Eval.finally Env.pop ) _ -> Eval.fail "try* expected a body a catch block" print : Env -> MalExpr -> String print env = printString env True printError : Env -> MalExpr -> String printError env expr = "Error: " ++ printString env False expr {-| Read-Eval-Print. Doesn't actually run the Eval but returns the monad. -} rep : String -> Eval MalExpr rep input = case readString input of Err msg -> Eval.fail msg Ok ast -> eval ast ================================================ FILE: impls/elm/src/Types.elm ================================================ module Types exposing (..) import Array exposing (Array) import Dict exposing (Dict) import IO exposing (IO) type Either a b = Left a | Right b type Msg = Input (Result String IO) type alias Frame = { outerId : Maybe Int , exitId : Maybe Int , data : Dict String MalExpr , refCnt : Int } type alias Env = { frames : Dict Int Frame , nextFrameId : Int , currentFrameId : Int , atoms : Dict Int MalExpr , nextAtomId : Int , debug : Bool , gcInterval : Int , gcCounter : Int , stack : List MalExpr , keepFrames : List Int } type alias EvalCont a = IO -> Eval a type EvalResult res = EvalErr MalExpr | EvalOk res | EvalIO (Cmd Msg) (EvalCont res) type alias EvalContext res = ( Env, EvalResult res ) type alias Eval res = Env -> EvalContext res type alias MalFn = List MalExpr -> Eval MalExpr type MalFunction = CoreFunc (Maybe MalExpr) MalFn | UserFunc { frameId : Int , lazyFn : MalFn , eagerFn : MalFn , isMacro : Bool , meta : Maybe MalExpr } type alias ApplyRec = { frameId : Int, bound : Bound, body : MalExpr } type alias TcoFn = () -> Eval MalExpr type alias Bound = List ( String, MalExpr ) type MalExpr = MalNil | MalBool Bool | MalInt Int | MalString String | MalKeyword String | MalSymbol String | MalList (Maybe MalExpr) (List MalExpr) | MalVector (Maybe MalExpr) (Array MalExpr) | MalMap (Maybe MalExpr) (Dict String MalExpr) | MalFunction MalFunction | MalApply ApplyRec | MalAtom Int {-| Keywords are prefixed by this char for usage in a MalMap. Elm doesn't support user defined types as keys in a Dict. The unicode char is: '\\x029e' -} keywordPrefix : Char keywordPrefix = 'ʞ' ================================================ FILE: impls/elm/src/Utils.elm ================================================ module Utils exposing ( decodeString , encodeString , flip , justValues , last , makeCall , maybeToList , wrap , zip ) import Regex import Types exposing (MalExpr(..)) decodeString : String -> String decodeString = let unescape { match } = case match of "\\n" -> "\n" "\\\"" -> "\"" "\\\\" -> "\\" other -> other in String.slice 1 -1 >> Regex.replace (regex "\\\\[\\\"\\\\n]") unescape -- helps replace all the encodes found into a string regex : String -> Regex.Regex regex str = case Regex.fromString str of Nothing -> Debug.todo "invalid regex" Just r -> r encodeString : String -> String encodeString = let escape { match } = case match of "\n" -> "\\n" "\"" -> "\\\"" "\\" -> "\\\\" other -> other in wrap "\"" "\"" << Regex.replace (regex "[\\n\\\"\\\\]") escape makeCall : String -> List MalExpr -> MalExpr makeCall symbol args = MalList Nothing <| MalSymbol symbol :: args wrap : String -> String -> String -> String wrap prefix suffix str = prefix ++ str ++ suffix maybeToList : Maybe a -> List a maybeToList m = case m of Just x -> [ x ] Nothing -> [] zip : List a -> List b -> List ( a, b ) zip a b = case ( a, b ) of ( [], _ ) -> [] ( _, [] ) -> [] ( x :: xs, y :: ys ) -> ( x, y ) :: zip xs ys last : List a -> Maybe a last list = case list of [] -> Nothing [ x ] -> Just x x :: xs -> last xs justValues : List (Maybe a) -> List a justValues list = case list of [] -> [] (Just x) :: rest -> x :: justValues rest Nothing :: rest -> justValues rest flip : (a -> b -> c) -> (b -> a -> c) flip f b a = f a b ================================================ FILE: impls/erlang/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install erlang rebar ================================================ FILE: impls/erlang/Makefile ================================================ ##################### SOURCES_BASE = src/atom.erl src/printer.erl src/reader.erl SOURCES_LISP = src/core.erl src/env.erl src/types.erl src/stepA_mal.erl SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) ##################### SRCS = step0_repl.erl step1_read_print.erl step2_eval.erl step3_env.erl step4_if_fn_do.erl \ step5_tco.erl step6_file.erl step7_quote.erl step8_macros.erl step9_try.erl stepA_mal.erl BINS = $(SRCS:%.erl=%) ##################### .PHONY: all dist clean all: $(BINS) dist: mal mal: $(SOURCES) sed 's/stepA_mal/mal/' src/stepA_mal.erl > src/mal.erl MAL_STEP=mal rebar compile escriptize rm src/mal.erl define dep_template .PHONY: $(1) $(1): src/$(1).erl MAL_STEP=$(1) rebar compile escriptize endef $(foreach b,$(BINS),$(eval $(call dep_template,$(b)))) clean: rebar clean rm -f mal ================================================ FILE: impls/erlang/rebar.config ================================================ %% %% rebar configuration file (https://github.com/rebar/rebar) %% {erl_opts, [debug_info, fail_on_warning]}. {clean_files, [ "ebin", "src/*.beam", "mal", "step0_repl", "step1_read_print", "step2_eval", "step3_env", "step4_if_fn_do", "step5_tco", "step6_file", "step7_quote", "step8_macros", "step9_try", "stepA_mal" ]}. ================================================ FILE: impls/erlang/rebar.config.script ================================================ %% %% rebar dynamic configuration file %% (https://github.com/rebar/rebar/wiki/Dynamic-configuration) %% case os:getenv("MAL_STEP") of false -> CONFIG; % env var not defined [] -> CONFIG; % env var set to empty string Step -> CONFIG ++ [{escript_name, Step}]; mal -> CONFIG ++ [{escript_name, mal}] end. ================================================ FILE: impls/erlang/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/erlang/src/atom.erl ================================================ %%% %%% Atom %%% %%% Atoms in MAL represent mutable data, which is not native to Erlang. The %%% lightweight technique for representing mutable data in Erlang is with a %%% lightweight process. %%% -module(atom). -behavior(gen_server). -export([new/1, deref/1, reset/2]). -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {atom}). %% %% Public API %% -spec new(Atom) -> Pid when Atom :: term(), Pid :: pid(). new(Atom) -> case gen_server:start(?MODULE, [Atom], []) of {ok, Pid} -> Pid; {error, Reason} -> error(Reason) end. -spec deref(Pid) -> Value when Pid :: pid(), Value :: term(). deref(Pid) -> gen_server:call(Pid, deref). -spec reset(Pid, Value) -> ok when Pid :: pid(), Value :: term(). reset(Pid, Value) -> gen_server:call(Pid, {reset, Value}). %% %% gen_server callbacks %% init([]) -> init([nil]); init([Value]) -> {ok, #state{atom=Value}}. handle_call(deref, _From, State) -> {reply, State#state.atom, State}; handle_call({reset, Value}, _From, _State) -> {reply, Value, #state{atom=Value}}; handle_call(terminate, _From, State) -> {stop, normal, ok, State}. handle_cast(_Msg, State) -> {noreply, State}. handle_info(Msg, State) -> error_logger:info_msg("unexpected message: ~p~n", [Msg]), {noreply, State}. terminate(_Reason, _State) -> ok. code_change(_OldVsn, State, _Extra) -> {ok, State}. ================================================ FILE: impls/erlang/src/core.erl ================================================ %%% %%% Core functions %%% -module(core). -compile(export_all). nil_p([Arg]) -> Arg == nil; nil_p(_) -> {error, "nil? takes a single argument"}. true_p([Arg]) -> Arg == true; true_p(_) -> {error, "true? takes a single argument"}. false_p([Arg]) -> Arg == false; false_p(_) -> {error, "false? takes a single argument"}. number_p([{integer, _}]) -> true; number_p([_]) -> false; number_p(_) -> {error, "number? takes a single argument"}. fn_p([{function, _, _}]) -> true; fn_p([{closure, _, _, _, _, _}]) -> true; fn_p([_]) -> false; fn_p(_) -> {error, "fn? takes a single argument"}. macro_p([{macro, _, _, _, _}]) -> true; macro_p([_]) -> false; macro_p(_) -> {error, "macro? takes a single argument"}. count([{Type, List, _Meta}]) when Type == list orelse Type == vector -> {integer, length(List)}; count([nil]) -> {integer, 0}; count([_]) -> {error, "count called on non-sequence"}; count([]) -> {error, "count called with no arguments"}; count(_) -> {error, "count expects one list argument"}. empty_q([{Type, List, _Meta}]) when Type == list orelse Type == vector -> length(List) == 0; empty_q([_]) -> {error, "empty? called on non-sequence"}; empty_q([]) -> {error, "empty? called with no arguments"}; empty_q(_) -> {error, "empty? expects one list argument"}. nth([{Type, List, _Meta}, {integer, Index}]) when Type == list orelse Type == vector -> try lists:nth(Index+1, List) of Result -> Result catch error:_Error -> % raise rather than returning an {error} error("nth: index out of range") end; nth([_]) -> {error, "nth expects two arguments"}. first([{Type, [First|_Rest], _Meta}]) when Type == list orelse Type == vector -> First; first([{Type, [], _Meta}]) when Type == list orelse Type == vector -> nil; first([nil]) -> nil; first([_]) -> {error, "first called on non-sequence"}; first([]) -> {error, "first called with no arguments"}; first(_) -> {error, "first expects one list argument"}. rest([{Type, [_First|Rest], _Meta}]) when Type == list orelse Type == vector -> {list, Rest, nil}; rest([{Type, [], _Meta}]) when Type == list orelse Type == vector -> {list, [], nil}; rest([nil]) -> {list, [], nil}; rest([_]) -> {error, "rest called on non-sequence"}; rest([]) -> {error, "rest called with no arguments"}; rest(_) -> {error, "rest expects one list argument"}. seq([{list, [], _Meta}]) -> nil; seq([{list, List, _Meta}]) -> {list, List, nil}; seq([{vector, [], _Meta}]) -> nil; seq([{vector, List, _Meta}]) -> {list, List, nil}; seq([{string, []}]) -> nil; seq([{string, S}]) -> {list, lists:map(fun(C) -> {string, [C]} end, S), nil}; seq([nil]) -> nil; seq(_) -> {error, "seq expects one list/vector/string/nil argument"}. equal_q(Args) -> case Args of [nil, nil] -> true; [true, true] -> true; [false, false] -> true; [{integer, I}, {integer, J}] -> I == J; [{string, S}, {string, T}] -> S == T; [{keyword, K}, {keyword, J}] -> K == J; [{symbol, S}, {symbol, T}] -> S == T; [{list, L1, _M1}, {list, L2, _M2}] -> equal_seqs(L1, L2); [{vector, L1, _M1}, {vector, L2, _M2}] -> equal_seqs(L1, L2); [{list, L1, _M1}, {vector, L2, _M2}] -> equal_seqs(L1, L2); [{vector, L1, _M1}, {list, L2, _M2}] -> equal_seqs(L1, L2); [{map, M1, _M1}, {map, M2, _M2}] -> equal_maps(M1, M2); [_A, _B] -> false; _ -> {error, "equal? expects two arguments"} end. equal_seqs([], []) -> true; equal_seqs([X|Xs], [Y|Ys]) -> equal_q([X, Y]) andalso equal_seqs(Xs, Ys); equal_seqs(_, _) -> false. equal_maps(M1, M2) -> maps:size(M1) == maps:size(M2) andalso equal_maps_for_keys(maps:keys(M1), M1, M2). equal_maps_for_keys([], _M1, _M2) -> true; equal_maps_for_keys([K|Ks], M1, M2) -> equal_values_for_key(K, M1, M2) andalso equal_maps_for_keys(Ks, M1, M2). equal_values_for_key(K, M1, M2) -> case [maps:find(K, M1), maps:find(K, M2)] of [{ok, V1}, {ok, V2}] -> equal_q([V1, V2]); _ -> false end. int_op(F, [A0,A1]) -> case A0 of {integer, I0} -> case A1 of {integer, I1} -> {integer, F(I0, I1)}; _ -> {error, "second argument must be an integer"} end; _ -> {error, "first argument must be an integer"} end; int_op(_F, _L) -> {error, "must have two arguments"}. int_add(Args) -> int_op(fun(I, J) -> I + J end, Args). int_sub(Args) -> int_op(fun(I, J) -> I - J end, Args). int_mul(Args) -> int_op(fun(I, J) -> I * J end, Args). int_div(Args) -> int_op(fun(I, J) -> I div J end, Args). bool_op(F, [A0,A1]) -> case A0 of {integer, I0} -> case A1 of {integer, I1} -> % the true or false is our return value F(I0, I1); _ -> {error, "second argument must be an integer"} end; _ -> {error, "first argument must be an integer"} end; bool_op(_F, _L) -> {error, "must have two arguments"}. bool_lt(Args) -> bool_op(fun(I, J) -> I < J end, Args). bool_lte(Args) -> bool_op(fun(I, J) -> I =< J end, Args). bool_gt(Args) -> bool_op(fun(I, J) -> I > J end, Args). bool_gte(Args) -> bool_op(fun(I, J) -> I >= J end, Args). pr_str(Args) -> {string, printer:pr_list(Args, "", "", " ", true)}. str(Args) -> {string, printer:pr_list(Args, "", "", "", false)}. prn(Args) -> io:format("~s~n", [printer:pr_list(Args, "", "", " ", true)]), nil. println(Args) -> io:format("~s~n", [printer:pr_list(Args, "", "", " ", false)]), nil. read_string([{string, Input}]) -> case reader:read_str(Input) of {ok, none} -> nil; {ok, AST} -> AST; {error, Reason} -> {error, Reason} end; read_string(_) -> {error, "read-string expects a single string argument"}. slurp([{string, Filepath}]) -> case file:read_file(Filepath) of {ok, Binary} -> {string, binary_to_list(Binary)}; {error, Reason} -> {error, Reason} end; slurp(_) -> {error, "slurp called with non-string"}. cons([Elem, {Type, List, _Meta}]) when Type == list orelse Type == vector -> {list, [Elem|List], nil}; cons([_,_]) -> {error, "second argument to cons must be a sequence"}; cons(_) -> {error, "cons expects two arguments"}. conj([{Type, _List, _Meta}]) when Type == list orelse Type == vector -> {error, "conj expects additional arguments"}; conj([{list, List, _Meta}|Args]) -> {list, lists:foldl(fun(Elem, AccIn) -> [Elem|AccIn] end, List, Args), nil}; conj([{vector, List, _Meta}|Args]) -> % why is vector backward from list? {vector, List ++ Args, nil}; conj(_) -> {error, "conj expects a list and one or more arguments"}. concat(Args) -> PushAll = fun(Elem, AccIn) -> case Elem of {Type, List, _Meta} when Type == list orelse Type == vector -> AccIn ++ List; _ -> error("concat called with non-sequence") end end, try lists:foldl(PushAll, [], Args) of Result -> {list, Result, nil} catch 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(_) -> {error, "throw expects a list with one argument"}. map_f([{closure, Eval, Binds, Body, CE, _M1}, {Type, Args, _M2}]) when Type == list orelse Type == vector -> Apply = fun(Arg) -> NewEnv = env:new(CE), env:bind(NewEnv, Binds, [Arg]), Eval(Body, NewEnv) end, {list, lists:map(Apply, Args), nil}; map_f([{function, F, _M}, {Type, Args, _Meta}]) when Type == list orelse Type == vector -> {list, [erlang:apply(F, [[Arg]]) || Arg <- Args], nil}; map_f(_) -> {error, "map expects a function and list argument"}. flatten_args(Args) -> % Convert the apply arguments into a flat list, such that no element % consists of {list,...} or {vector,...} (i.e. just [A, B, C, ...]). Delist = fun(Elem) -> case Elem of {T, L, _M} when T == list orelse T == vector -> L; _ -> Elem end end, lists:flatten(lists:map(Delist, lists:flatten(Args))). apply_f([{closure, Eval, Binds, Body, CE, _M1}|Args]) -> NewEnv = env:new(CE), env:bind(NewEnv, Binds, flatten_args(Args)), Eval(Body, NewEnv); apply_f([{macro, Eval, Binds, Body, CE}|Args]) -> NewEnv = env:new(CE), env:bind(NewEnv, Binds, flatten_args(Args)), Eval(Body, NewEnv); apply_f([{function, F, _M}|Args]) -> erlang:apply(F, [flatten_args(Args)]); apply_f(_) -> {error, "apply expects a function followed by arguments"}. readline([{string, Prompt}]) -> case io:get_line(standard_io, Prompt) of % When user presses Ctrl-d it seems like io:get_line/2 cannot be % called again, and we seem unable to signal to MAL to terminate, % so just error out. eof -> exit(goodbye); {error, Reason} -> {error, Reason}; Line -> {string, string:strip(Line, both, $\n)} end; readline(_) -> {error, "readline expects a string argument"}. time_ms(_) -> {Mega, Sec, Micro} = os:timestamp(), {integer, Mega * 1000000000 + Sec * 1000 + Micro div 1000}. ns() -> Builtins = #{ "*" => fun int_mul/1, "+" => fun int_add/1, "-" => fun int_sub/1, "/" => fun int_div/1, "<" => fun bool_lt/1, "<=" => fun bool_lte/1, "=" => fun equal_q/1, ">" => fun bool_gt/1, ">=" => fun bool_gte/1, "apply" => fun apply_f/1, "assoc" => fun types:assoc/1, "atom" => fun types:atom/1, "atom?" => fun types:atom_p/1, "concat" => fun concat/1, "conj" => fun conj/1, "cons" => fun cons/1, "contains?" => fun types:contains_p/1, "count" => fun count/1, "deref" => fun types:deref/1, "dissoc" => fun types:dissoc/1, "empty?" => fun empty_q/1, "false?" => fun false_p/1, "first" => fun first/1, "fn?" => fun fn_p/1, "get" => fun types:map_get/1, "hash-map" => fun types:hash_map/1, "keys" => fun types:map_keys/1, "keyword" => fun types:keyword/1, "keyword?" => fun types:keyword_p/1, "list" => fun types:list/1, "list?" => fun types:list_p/1, "macro?" => fun macro_p/1, "map" => fun map_f/1, "map?" => fun types:map_p/1, "meta" => fun types:meta/1, "nil?" => fun nil_p/1, "nth" => fun nth/1, "number?" => fun number_p/1, "pr-str" => fun pr_str/1, "println" => fun println/1, "prn" => fun prn/1, "read-string" => fun read_string/1, "readline" => fun readline/1, "reset!" => fun types:reset/1, "rest" => fun rest/1, "seq" => fun seq/1, "sequential?" => fun types:sequential_p/1, "slurp" => fun slurp/1, "str" => fun str/1, "string?" => fun types:string_p/1, "swap!" => fun types:swap/1, "symbol" => fun types:symbol/1, "symbol?" => fun types:symbol_p/1, "throw" => fun mal_throw/1, "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 }, Env = env:new(undefined), SetEnv = fun(K, V) -> env:set(Env, {symbol, K}, types:func(V)) end, maps:map(SetEnv, Builtins), Env. ================================================ FILE: impls/erlang/src/env.erl ================================================ %%% %%% Environment %%% %%% We need an "object" to represent the environment: something whose state can %%% change over time, while keeping a single, unchanging reference to that %%% object. This is done in Erlang using lightweight processes. Fortunately, OTP %%% makes this easy. %%% -module(env). -behavior(gen_server). -export([new/1, bind/3, find/2, get/2, set/3, root/1]). -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {outer, data}). %% %% Public API %% -spec new(Outer) -> Pid when Outer :: #state{}, Pid :: pid(). % @doc Pass 'undefined' for Outer if no parent environment. new(Outer) -> case gen_server:start(?MODULE, [Outer], []) of {ok, Pid} -> Pid; {error, Reason} -> error(Reason) end. -spec bind(Pid, Names, Values) -> ok when Pid :: pid(), Names :: [term()], Values :: [term()]. bind(Pid, Names, Values) -> gen_server:call(Pid, {bind, Names, Values}). -spec find(Pid1, Key) -> Pid2 when Pid1 :: pid(), Key :: {symbol, string()}, Pid2 :: pid() | nil. find(Pid, {symbol, Name}) -> gen_server:call(Pid, {find_pid, Name}). -spec get(Pid, Key) -> Value when Pid :: pid(), Key :: {symbol, string()}, Value :: term(). get(Pid, {symbol, Name}) -> case gen_server:call(Pid, {get, Name}) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end; get(_Pid, _Key) -> error("env:get/2 called with non-symbol key"). -spec set(Pid, Key, Value) -> ok when Pid :: pid(), Key :: {symbol, string()}, Value :: term(). set(Pid, {symbol, Name}, Value) -> gen_server:call(Pid, {set, Name, Value}); set(_Env, _Key, _Value) -> error("env:set/3 called with non-symbol key"). -spec root(Pid1) -> Pid2 when Pid1 :: pid(), Pid2 :: pid(). root(Pid) -> gen_server:call(Pid, root). %% %% gen_server callbacks %% init([]) -> init([undefined]); init([Outer]) -> {ok, #state{outer=Outer, data=#{}}}. handle_call({bind, Names, Values}, _From, State) -> NewEnv = env_bind(State, Names, Values), {reply, ok, NewEnv}; handle_call({find_env, Name}, _From, State) -> {reply, env_find(State, Name), State}; handle_call({find_pid, Name}, _From, State) -> {reply, pid_find(State, Name), State}; handle_call({get, Name}, _From, State) -> {reply, env_get(State, Name), State}; handle_call({set, Name, Value}, _From, State) -> {reply, ok, env_set(State, Name, Value)}; handle_call(root, _From, State) -> {reply, env_root(State), State}; handle_call(terminate, _From, State) -> {stop, normal, ok, State}. handle_cast(_Msg, State) -> {noreply, State}. handle_info(Msg, State) -> error_logger:info_msg("unexpected message: ~p~n", [Msg]), {noreply, State}. terminate(_Reason, _State) -> ok. code_change(_OldVsn, State, _Extra) -> {ok, State}. %% %% Internal functions %% pid_find(Env, Name) -> case maps:is_key(Name, Env#state.data) of true -> self(); false -> case Env#state.outer of undefined -> nil; Outer -> gen_server:call(Outer, {find_pid, Name}) end end. env_find(Env, Name) -> case maps:is_key(Name, Env#state.data) of true -> Env; false -> case Env#state.outer of undefined -> nil; Outer -> gen_server:call(Outer, {find_env, Name}) end end. -spec env_bind(Env1, Names, Values) -> Env2 when Env1 :: #state{}, Names :: [term()], Values :: [term()], Env2 :: #state{}. env_bind(Env, [], []) -> Env; env_bind(Env, [{symbol, "&"}, {symbol, Name}], Values) -> env_set(Env, Name, {list, Values, nil}); env_bind(Env, [{symbol, Name}|Ntail], [Value|Vtail]) -> env_bind(env_set(Env, Name, Value), Ntail, Vtail). -spec env_get(Env, Key) -> {ok, Value} | {error, string()} when Env :: #state{}, Key :: {symbol, string()}, Value :: term(). env_get(Env, Name) -> case env_find(Env, Name) of nil -> {error, io_lib:format("'~s' not found", [Name])}; E -> {ok, maps:get(Name, E#state.data)} end. -spec env_set(Env1, Key, Value) -> Env2 when Env1 :: #state{}, Key :: {symbol, string()}, Value :: term(), Env2 :: #state{}. env_set(Env, Name, Value) -> Map = maps:put(Name, Value, Env#state.data), #state{outer=Env#state.outer, data=Map}. -spec env_root(Env1) -> Env2 when Env1 :: #state{}, Env2 :: #state{}. env_root(Env) -> case Env#state.outer of undefined -> self(); Outer -> gen_server:call(Outer, root) end. ================================================ FILE: impls/erlang/src/mal.app.src ================================================ {application, mal, [ {description, "Make-a-Lisp Erlang"}, {vsn, "1"}, {registered, []}, {applications, [ kernel, stdlib ]}, {mod, {mal_app, []}}, {env, []} ]}. ================================================ FILE: impls/erlang/src/printer.erl ================================================ %%% %%% Printer %%% -module(printer). -export([pr_str/2, pr_list/5]). -spec pr_str(term(), true|false) -> string(). pr_str(Value, Readably) -> case Value of nil -> "nil"; true -> "true"; false -> "false"; {atom, Atom} -> AtomStr = pr_str(atom:deref(Atom), Readably), io_lib:format("(atom ~s)", [AtomStr]); {integer, Num} -> integer_to_list(Num); {string, String} when Readably == true -> escape_str(String); {string, String} when Readably == false -> String; {keyword, Keyword} -> [$:|Keyword]; {symbol, Symbol} -> Symbol; {list, List, _Meta} -> pr_list(List, "(", ")", " ", Readably); {vector, Vector, _Meta} -> pr_list(Vector, "[", "]", " ", Readably); {map, Map, _Meta} -> pr_map(Map, Readably); {closure, _Eval, Binds, Body, _Env, _Meta} -> BindsStr = pr_str({list, Binds, nil}, Readably), BodyStr = pr_str(Body, Readably), io_lib:format("(fn* ~s ~s)", [BindsStr, BodyStr]); {function, _Func, _Meta} -> "#"; {macro, _Eval, _Binds, _Body, _Env} -> "#"; {error, Reason} -> io_lib:format("error: ~s", [Reason]) end. -spec pr_list([term()], string(), string(), string(), boolean()) -> string(). pr_list(Seq, Start, End, Join, Readably) -> Print = fun(Elem) -> pr_str(Elem, Readably) end, L = string:join(lists:map(Print, Seq), Join), Start ++ L ++ End. pr_map(Map, Readably) -> AppendKV = fun({Key, Value}, AccIn) -> AccIn ++ [Key, Value] end, Elements = lists:foldl(AppendKV, [], maps:to_list(Map)), pr_list(Elements, "{", "}", " ", Readably). escape_str(String) -> Escape = fun(C, AccIn) -> case C of $" -> [C, $\\|AccIn]; $\\ -> [C, $\\|AccIn]; $\n -> [$n, $\\|AccIn]; _ -> [C|AccIn] end end, "\"" ++ lists:reverse(lists:foldl(Escape, [], String)) ++ "\"". ================================================ FILE: impls/erlang/src/reader.erl ================================================ %%% %%% Reader %%% -module(reader). -export([read_str/1, list_to_map/1]). -record(reader, { tokens=[], % the input tokens remaining tree % the subtree parsed by a read_* function }). -spec read_str(string()) -> {ok, term()} | {error, term()}. read_str(Input) -> case tokenize(Input) of {ok, []} -> {ok, none}; {ok, Tokens} -> case read_form(#reader{tokens=Tokens}) of % extract the final result of parsing {ok, Reader} -> {ok, Reader#reader.tree}; {error, Reason} -> {error, Reason} end; {error, Reason} -> {error, Reason} end. -spec read_form(#reader{}) -> {ok, #reader{}} | {error, term()}. read_form(Reader) -> Token = peek(Reader), case Token of close_list -> {error, "unexected ')'"}; close_vector -> {error, "unexected ']'"}; close_map -> {error, "unexected '}'"}; open_list -> read_list(Reader); open_vector -> read_vector(Reader); open_map -> read_map(Reader); quote -> read_quoted(Reader, Token); quasiquote -> read_quoted(Reader, Token); unquote -> read_quoted(Reader, Token); 'splice-unquote' -> read_quoted(Reader, Token); deref -> read_quoted(Reader, Token); 'with-meta' -> read_meta(Reader); _ -> read_atom(Reader) end. read_list(Reader) -> read_seq(Reader, $), open_list, close_list, list). read_vector(Reader) -> % Erlang has no array/vector type, so just use list read_seq(Reader, $], open_vector, close_vector, vector). read_map(Reader) -> case read_seq(Reader, $}, open_map, close_map, map) of {ok, Reader1} -> {map, Map, Meta} = Reader1#reader.tree, case list_to_map(Map) of {error, Reason} -> {error, Reason}; NewMap -> Tokens = Reader1#reader.tokens, {ok, #reader{tokens=Tokens, tree={map, NewMap, Meta}}} end; {error, Reason} -> {error, Reason} end. read_seq(Reader, CloseChar, OpenDelim, CloseDelim, Type) -> {First, Reader1} = next(Reader), case First of OpenDelim -> case read_seq_tail(Reader1, CloseChar, CloseDelim, []) of {ok, Reader2} -> % prepend our type tag to the result Result = {Type, Reader2#reader.tree, nil}, Reader3 = #reader{tokens=Reader2#reader.tokens, tree=Result}, {ok, Reader3}; {error, Reason} -> {error, Reason} end; Bogey -> {error, io_lib:format("error in read_seq, expected ~p but got ~p", [OpenDelim, Bogey])} end. read_seq_tail(Reader, CloseChar, CloseDelim, AccIn) -> Token = peek(Reader), case Token of [] -> {error, io_lib:format("expected '~c', got EOF", [CloseChar])}; CloseDelim -> {_Token, Reader1} = next(Reader), Reader2 = #reader{tokens=Reader1#reader.tokens, tree=lists:reverse(AccIn)}, {ok, Reader2}; _ -> case read_form(Reader) of {ok, Reader3} -> read_seq_tail(Reader3, CloseChar, CloseDelim, [Reader3#reader.tree|AccIn]); {error, Reason} -> {error, Reason} end end. % Convert a list of key/value pairs into a map. The elements are not % tuples; the keys are the odd numbered members, and the values are the % even numbered members. Fails if list has an odd number of members. list_to_map(L) -> list_to_map(L, #{}). list_to_map([], AccIn) -> AccIn; list_to_map([_H], _AccIn) -> {error, "odd number of hash-map keys/values"}; list_to_map([K,V|T], AccIn) -> list_to_map(T, maps:put(K, V, AccIn)). % Convert syntactic sugar into normalized form (e.g. ` => (quasiquote)). read_quoted(Reader, Token) -> % discard the quoted token {_T, Reader1} = next(Reader), case read_form(Reader1) of {ok, Reader2} -> Result = {list, [{symbol, atom_to_list(Token)}, Reader2#reader.tree], nil}, {ok, #reader{tokens=Reader2#reader.tokens, tree=Result}}; {error, Reason} -> {error, Reason} end. read_meta(Reader) -> % discard the meta token {_T, Reader1} = next(Reader), case read_form(Reader1) of {ok, Reader2} -> M = Reader2#reader.tree, case read_form(Reader2) of {ok, Reader3} -> X = Reader3#reader.tree, Result = {list, [{symbol, "with-meta"}, X, M], nil}, {ok, #reader{tokens=Reader3#reader.tokens, tree=Result}}; {error, Reason} -> {error, Reason} end; {error, Reason} -> {error, Reason} end. read_atom(Reader) -> {Token, Reader1} = next(Reader), Result = case Token of {integer, Value} -> {integer, list_to_integer(Value)}; {string, _String} -> Token; {keyword, _Keyword} -> Token; {symbol, Symbol} -> case Symbol of "true" -> true; "false" -> false; "nil" -> nil; _ -> Token end end, {ok, #reader{tokens=Reader1#reader.tokens, tree=Result}}. peek(Reader) -> case Reader#reader.tokens of [] -> []; [H|_T] -> H end. next(Reader) -> [H|NewTokens] = Reader#reader.tokens, {H, #reader{tokens=NewTokens}}. -spec tokenize(string()) -> {ok, [term()]} | {error, term()}. tokenize(Input) -> tokenize(Input, []). -spec tokenize(string(), [term()]) -> {ok, [term()]} | {error, term()}. tokenize(Input, Tokens) -> case lex_single(Input) of eof -> {ok, lists:reverse(Tokens)}; {error, Reason} -> {error, Reason}; {ignored, Rest} -> tokenize(Rest, Tokens); {Token, Rest} -> tokenize(Rest, [Token|Tokens]) end. lex_single([]) -> eof; lex_single([Char|Rest]) -> case Char of $( -> {open_list, Rest}; $) -> {close_list, Rest}; $[ -> {open_vector, Rest}; $] -> {close_vector, Rest}; ${ -> {open_map, Rest}; $} -> {close_map, Rest}; $" -> lex_string(Rest, []); $; -> lex_comment(Rest); $: -> lex_symbol(Rest, keyword); $' -> {quote, Rest}; $` -> {quasiquote, Rest}; $~ -> lex_unquote(Rest); $@ -> {deref, Rest}; $^ -> {'with-meta', Rest}; N when N >= $0, N =< $9 -> lex_number(Rest, [Char]); S when S == $- -> lex_minus_word(Char, Rest); S when S == 32; S == $,; S == $\r; S == $\n; S == $\t -> lex_spaces(Rest); $\\ -> {error, io_lib:format("bare escape literal ~c~c", [Char, hd(Rest)])}; $. -> {error, "bare dot (.) not supported"}; _ -> lex_symbol([Char|Rest], symbol) end. lex_comment([]) -> {ignored, []}; lex_comment([C|Rest]) when C == $\r; C == $\n -> {ignored, Rest}; lex_comment([_C|Rest]) -> lex_comment(Rest). lex_spaces([C|Rest]) when C == 32; C == $,; C == $\r; C == $\n; C == $\t -> lex_spaces(Rest); lex_spaces(Rest) -> {ignored, Rest}. lex_string([], _String) -> {error, "expected '\"', got EOF"}; lex_string([$\\,Escaped|Rest], String) -> % unescape the string while building it case Escaped of [] -> {error, "end of string reached in escape"}; $n -> lex_string(Rest, [$\n|String]); _ -> lex_string(Rest, [Escaped|String]) end; lex_string([$"|Rest], String) -> {{string, lists:reverse(String)}, Rest}; lex_string([C|Rest], String) -> lex_string(Rest, [C|String]). lex_number([N|Rest], Number) when N >= $0, N =< $9 -> lex_number(Rest, [N|Number]); lex_number(Rest, Number) -> {{integer, lists:reverse(Number)}, Rest}. lex_minus_word(Minus, [N|Rest]) when N >= $0, N =< $9 -> lex_number([N|Rest], [Minus]); lex_minus_word(Minus, Rest) -> lex_symbol([Minus|Rest], symbol). % Lex the remainder of either a keyword or a symbol. The Type is used as % the tag for the returned tuple (e.g. the atoms keyword or symbol). lex_symbol(Input, Type) -> IsSymbol = fun(C) -> is_letter(C) orelse is_digit(C) orelse is_symbol(C) end, Symbol = lists:takewhile(IsSymbol, Input), case Symbol of [] -> {error, io_lib:format("invalid symbol: ~10s", [Input])}; _ -> {{Type, Symbol}, lists:sublist(Input, length(Symbol) + 1, length(Input))} end. is_digit(C) -> C >= $0 andalso C =< $9. is_letter(C) -> C >= $a andalso C =< $z orelse C >= $A andalso C =< $Z. is_symbol(C) -> lists:member(C, "!#$%&*+-/:<=>?@^_|\~"). lex_unquote([$@|Rest]) -> {'splice-unquote', Rest}; lex_unquote(Rest) -> {unquote, Rest}. ================================================ FILE: impls/erlang/src/step0_repl.erl ================================================ %%% %%% Step 0: REPL %%% -module(step0_repl). -export([main/1]). main(_) -> case io:get_line(standard_io, "user> ") of eof -> % break out of the loop io:format("~n"), ok; {error, Reason} -> io:format("Error reading input: ~p~n", [Reason]), exit(ioerr); Line -> io:format("~s~n", [print(eval(read(string:strip(Line, both, $\n))))]), main("") end. read(String) -> String. eval(String) -> String. print(String) -> String. ================================================ FILE: impls/erlang/src/step1_read_print.erl ================================================ %%% %%% Step 1: read/print %%% -module(step1_read_print). -export([main/1]). main(_) -> case io:get_line(standard_io, "user> ") of eof -> % break out of the loop io:format("~n"), ok; {error, Reason} -> io:format("Error reading input: ~s~n", [Reason]), exit(ioerr); Line -> print(eval(read(string:strip(Line, both, $\n)))), main("") end. read(String) -> case reader:read_str(String) of {ok, Value} -> Value; {error, Reason} -> io:format("error: ~s~n", [Reason]), nil end. eval(Value) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [printer:pr_str(Value, true)]). ================================================ FILE: impls/erlang/src/step2_eval.erl ================================================ %%% %%% Step 2: eval %%% -module(step2_eval). -export([main/1]). main(_) -> Env = #{ "+" => fun core:int_add/1, "-" => fun core:int_sub/1, "*" => fun core:int_mul/1, "/" => fun core:int_div/1 }, loop(Env). loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> % break out of the loop io:format("~n"), ok; {error, Reason} -> io:format("Error reading input: ~s~n", [Reason]), exit(ioerr); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> AST = read(Input), try eval(AST, Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(String) -> case reader:read_str(String) of {ok, Value} -> Value; {error, Reason} -> io:format("error: ~s~n", [Reason]), nil end. eval({list, [], _Meta}=AST, _Env) -> AST; eval({list, List, _Meta}, Env) -> case lists:map(fun(Elem) -> eval(Elem, Env) end, List) of [F|Args] -> erlang:apply(F, [Args]); _ -> {error, "expected a list"} end; eval({symbol, Sym}, Env) -> case maps:is_key(Sym, Env) of true -> maps:get(Sym, Env); false -> error(io_lib:format("'~s' not found", [Sym])) end; eval({vector, V, Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, V), Meta}; eval({map, M, Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), Meta}; eval(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). ================================================ FILE: impls/erlang/src/step3_env.erl ================================================ %%% %%% Step 3: env %%% -module(step3_env). -export([main/1]). main(_) -> loop(core:ns()). loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> % (let* (p (+ 2 3) q (+ 2 p)) (+ p q)) % ;=>12 Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). ================================================ FILE: impls/erlang/src/step4_if_fn_do.erl ================================================ %%% %%% Step 4: if, fn, do %%% -module(step4_if_fn_do). -export([main/1]). main(_) -> Env = core:ns(), % define the not function using mal itself eval(read("(def! not (fn* (a) (if a false true)))"), Env), loop(Env). loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). ================================================ FILE: impls/erlang/src/step5_tco.erl ================================================ %%% %%% Step 5: Tail call optimization %%% -module(step5_tco). -export([main/1]). main(_) -> Env = core:ns(), % define the not function using mal itself eval(read("(def! not (fn* (a) (if a false true)))"), Env), loop(Env). loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). ================================================ FILE: impls/erlang/src/step6_file.erl ================================================ %%% %%% Step 6: File and evil %%% -module(step6_file). -export([main/1]). main([File|Args]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), rep("(load-file \"" ++ File ++ "\")", Env); main([]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), loop(Env). init() -> Env = core:ns(), % define the load-file and not functions using mal itself eval(read("(def! not (fn* (a) (if a false true)))"), Env), eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), Env. loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). ================================================ FILE: impls/erlang/src/step7_quote.erl ================================================ %%% %%% Step 7: Quoting %%% -module(step7_quote). -export([main/1]). main([File|Args]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), rep("(load-file \"" ++ File ++ "\")", Env); main([]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), loop(Env). init() -> Env = core:ns(), % define the load-file and not functions using mal itself eval(read("(def! not (fn* (a) (if a false true)))"), Env), eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), Env. loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); 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, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> error("quasiquote requires 1 argument"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). 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"}; 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. ================================================ FILE: impls/erlang/src/step8_macros.erl ================================================ %%% %%% Step 8: Macros %%% -module(step8_macros). -export([main/1]). main([File|Args]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), rep("(load-file \"" ++ File ++ "\")", Env); main([]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), loop(Env). init() -> Env = core:ns(), eval(read("(def! not (fn* (a) (if a false true)))"), Env), eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), eval(read("(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)))))))"), Env), Env. loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), case Result of {error, _R1} -> Result; _ -> env:set(Env, {symbol, A1}, Result), Result end; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); 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, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> error("quasiquote requires 1 argument"); eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> case eval(A2, Env) of {closure, _Eval, Binds, Body, CE, _M1} -> Result = {macro, fun eval/2, Binds, Body, CE}, env:set(Env, {symbol, A1}, Result), Result; Result -> env:set(Env, {symbol, A1}, Result), Result end, Result; eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> error("defmacro! called with non-symbol"); eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> error("defmacro! requires exactly two arguments"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {macro, _Eval, Binds, Body, ME} -> NewEnv = env:new(ME), env:bind(NewEnv, Binds, lists:flatten([Args])), NewAst = eval(Body, NewEnv), eval(NewAst, Env); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). 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"}; 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. ================================================ FILE: impls/erlang/src/step9_try.erl ================================================ %%% %%% Step 9: Try %%% -module(step9_try). -export([main/1]). main([File|Args]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), rep("(load-file \"" ++ File ++ "\")", Env); main([]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), loop(Env). init() -> Env = core:ns(), eval(read("(def! not (fn* (a) (if a false true)))"), Env), eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), eval(read("(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)))))))"), Env), Env. loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true); throw:Reason -> printer:pr_str({error, printer:pr_str(Reason, true)}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), case Result of {error, _R1} -> Result; _ -> env:set(Env, {symbol, A1}, Result), Result end; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); 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, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> error("quasiquote requires 1 argument"); eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> case eval(A2, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> Result = {macro, fun eval/2, Binds, Body, CE}, env:set(Env, {symbol, A1}, Result), Result; Result -> env:set(Env, {symbol, A1}, Result), Result end, Result; eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> error("defmacro! called with non-symbol"); eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> error("defmacro! requires exactly two arguments"); eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> try eval(A, Env) of Result -> Result catch error:Reason -> NewEnv = env:new(Env), env:bind(NewEnv, [B], [{string, Reason}]), eval(C, NewEnv); throw:Reason -> NewEnv = env:new(Env), env:bind(NewEnv, [B], [Reason]), eval(C, NewEnv) end; eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> eval(AST, Env); eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> error("try*/catch* must be of the form (try* A (catch* B C))"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {macro, _Eval, Binds, Body, ME} -> NewEnv = env:new(ME), env:bind(NewEnv, Binds, lists:flatten([Args])), NewAst = eval(Body, NewEnv), eval(NewAst, Env); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). 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"}; 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. ================================================ FILE: impls/erlang/src/stepA_mal.erl ================================================ %%% %%% Step A: Mutation, Self-hosting and Interop %%% -module(stepA_mal). -export([main/1]). main([File|Args]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}), rep("(load-file \"" ++ File ++ "\")", Env); main([]) -> Env = init(), env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}), eval(read("(println (str \"Mal [\" *host-language* \"]\"))"), Env), loop(Env). init() -> Env = core:ns(), eval(read("(def! *host-language* \"Erlang\")"), Env), eval(read("(def! not (fn* (a) (if a false true)))"), Env), eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env), eval(read("(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)))))))"), Env), Env. loop(Env) -> case io:get_line(standard_io, "user> ") of eof -> io:format("~n"); {error, Reason} -> exit(Reason); Line -> print(rep(string:strip(Line, both, $\n), Env)), loop(Env) end. rep(Input, Env) -> try eval(read(Input), Env) of none -> none; Result -> printer:pr_str(Result, true) catch error:Reason -> printer:pr_str({error, Reason}, true); throw:Reason -> printer:pr_str({error, printer:pr_str(Reason, true)}, true) end. read(Input) -> case reader:read_str(Input) of {ok, Value} -> Value; {error, Reason} -> error(Reason) end. eval(Value, Env) -> case env:find(Env, {symbol, "DEBUG-EVAL"}) of nil -> none; Env2 -> case env:get(Env2, {symbol, "DEBUG-EVAL"}) of Cond when Cond == false orelse Cond == nil -> none; _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) end end, eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), case Result of {error, _R1} -> Result; _ -> env:set(Env, {symbol, A1}, Result), Result end; eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of [] -> nil; [A] -> eval(A, Env); _ -> error("if takes 2 or 3 arguments") end; _ -> eval(Consequent, Env) end; eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); 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, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> error("quasiquote requires 1 argument"); eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) -> case eval(A2, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> Result = {macro, fun eval/2, Binds, Body, CE}, env:set(Env, {symbol, A1}, Result), Result; Result -> env:set(Env, {symbol, A1}, Result), Result end, Result; eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> error("defmacro! called with non-symbol"); eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> error("defmacro! requires exactly two arguments"); eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> try eval(A, Env) of Result -> Result catch error:Reason -> NewEnv = env:new(Env), env:bind(NewEnv, [B], [{string, Reason}]), eval(C, NewEnv); throw:Reason -> NewEnv = env:new(Env), env:bind(NewEnv, [B], [Reason]), eval(C, NewEnv) end; eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> eval(AST, Env); eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> error("try*/catch* must be of the form (try* A (catch* B C))"); eval_list({list, [A0 | Args], _Meta}, Env) -> case eval(A0, Env) of {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); {function, F, _MF} -> A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), erlang:apply(F, [A]); {macro, _Eval, Binds, Body, ME} -> NewEnv = env:new(ME), env:bind(NewEnv, Binds, lists:flatten([Args])), NewAst = eval(Body, NewEnv), eval(NewAst, Env); {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); eval_ast({list, Seq, Meta}, Env) -> eval_list({list, Seq, Meta}, Env); eval_ast({vector, Seq, _Meta}, Env) -> {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> Value. print(none) -> % if nothing meaningful was entered, print nothing at all ok; print(Value) -> io:format("~s~n", [Value]). let_star(Env, Bindings) -> Bind = fun({Name, Expr}) -> case Name of {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env)); _ -> error("let* with non-symbol binding") end end, case Bindings of {Type, Binds, _Meta} when Type == list orelse Type == vector -> case list_to_proplist(Binds) of {error, Reason} -> error(Reason); Props -> lists:foreach(Bind, Props) end; _ -> error("let* with non-list bindings") end. list_to_proplist(L) -> list_to_proplist(L, []). list_to_proplist([], AccIn) -> lists:reverse(AccIn); list_to_proplist([_H], _AccIn) -> {error, "mismatch in let* name/value bindings"}; list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). 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"}; 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. ================================================ FILE: impls/erlang/src/types.erl ================================================ %%% %%% Types and their functions %%% -module(types). -compile(export_all). list(Args) -> {list, Args, nil}. list_p([Args]) -> case Args of {list, _L, _M} -> true; _ -> false end; list_p([]) -> {error, "list? called with no arguments"}; list_p(_) -> {error, "list? expects one list argument"}. func(Func) -> {function, Func, nil}. symbol_p([{symbol, _S}]) -> true; symbol_p([_A]) -> false; symbol_p(_) -> {error, "symbol? takes a single argument"}. symbol([{string, Name}]) -> {symbol, Name}; symbol(_) -> {error, "symbol expects a single string argument"}. string_p([{string, _S}]) -> true; string_p([_A]) -> false; string_p(_) -> {error, "string? takes a single argument"}. keyword_p([{keyword, _K}]) -> true; keyword_p([_A]) -> false; keyword_p(_) -> {error, "keyword? takes a single argument"}. keyword([{string, Name}]) -> {keyword, Name}; keyword([{keyword, Name}]) -> {keyword, Name}; keyword([_]) -> {error, "keyword: expectst a keyword or string."}; keyword(_) -> {error, "keyword: takes a single argument."}. vector_p([{vector, _V, _Meta}]) -> true; vector_p([_]) -> false; vector_p(_) -> {error, "vector? takes a single argument"}. vector(Args) -> {vector, Args, nil}. hash_map(Args) -> {map, reader:list_to_map(Args), nil}. map_p([{map, _M, _Meta}]) -> true; map_p([_]) -> false; map_p(_) -> {error, "map? takes a single argument"}. assoc([{map, Map, Meta}|Args]) -> case reader:list_to_map(Args) of {error, Reason} -> {error, Reason}; Addend -> {map, maps:merge(Map, Addend), Meta} end; assoc(_) -> {error, "assoc expects a map argument followed by pairs"}. dissoc([{map, Map, Meta}|Keys]) -> {map, lists:foldl(fun(Key, AccIn) -> maps:remove(Key, AccIn) end, Map, Keys), Meta}; dissoc(_) -> {error, "dissoc expects a map argument followed by keys"}. map_get([{map, Map, _Meta}, Key]) -> maps:get(Key, Map, nil); map_get([_Thing1, _Thing2]) -> nil; map_get(_) -> {error, "get expects a map argument followed by key"}. contains_p([{map, Map, _Meta}, Key]) -> maps:is_key(Key, Map); contains_p(_) -> {error, "contains? expects a map argument followed by key"}. map_keys([{map, Map, _Meta}]) -> {list, maps:keys(Map), nil}; map_keys(_) -> {error, "keys expects a map argument"}. map_values([{map, Map, _Meta}]) -> {list, maps:values(Map), nil}; map_values(_) -> {error, "vals expects a map argument"}. sequential_p([{Type, _L, _M}]) when Type == list orelse Type == vector -> true; sequential_p([_]) -> false; sequential_p(_) -> {error, "sequential? expects a single argument"}. atom([Atom]) -> {atom, atom:new(Atom)}; atom(_) -> {error, "atom expects a single argument"}. atom_p([{atom, _A}]) -> true; atom_p([_]) -> false; atom_p(_) -> {error, "atom? expects a single argument"}. deref([{atom, Atom}]) -> atom:deref(Atom); deref(_) -> {error, "deref expects a single atom argument"}. reset([{atom, Atom}, Value]) -> atom:reset(Atom, Value); reset(_) -> {error, "reset expects an atom and a value"}. swap([{atom, Atom}, {closure, Eval, Binds, Body, Env, _MC}|Args]) -> NewEnv = env:new(Env), Values = [atom:deref(Atom) | Args], env:bind(NewEnv, Binds, Values), atom:reset(Atom, Eval(Body, NewEnv)); swap([{atom, Atom}, {function, F, _MF}|Args]) -> atom:reset(Atom, erlang:apply(F, [[atom:deref(Atom) | Args]])); swap(_) -> {error, "atom expects an atom, function, and optional arguments"}. meta([{T, _List, Meta}]) when T == list orelse T == vector orelse T == map -> Meta; meta([{closure, _Eval, _Binds, _Body, _Env, Meta}]) -> Meta; meta([{function, _Func, Meta}]) -> Meta; meta(_) -> {error, "meta expects a single collection or function argument"}. with_meta([{T, Seq, _M}, Meta]) when T == list orelse T == vector orelse T == map -> {T, Seq, Meta}; with_meta([{closure, Eval, Binds, Body, Env, _M}, Meta]) -> {closure, Eval, Binds, Body, Env, Meta}; with_meta([{function, Func, _Meta}, Meta]) -> {function, Func, Meta}. ================================================ FILE: impls/erlang/tests/step5_tco.mal ================================================ ;; Erlang: skipping non-TCO recursion ;; Reason: Erlang has TCO, test always completes. ================================================ FILE: impls/es6/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm ENV NPM_CONFIG_CACHE /mal/.npm ================================================ FILE: impls/es6/Makefile ================================================ SOURCES_BASE = node_readline.js types.mjs reader.mjs printer.mjs SOURCES_LISP = env.mjs core.mjs stepA_mal.mjs SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) STEPS = step0_repl.mjs step1_read_print.mjs step2_eval.mjs step3_env.mjs \ step4_if_fn_do.mjs step5_tco.mjs step6_file.mjs \ step7_quote.mjs step8_macros.mjs step9_try.mjs stepA_mal.mjs all: node_modules dist: mal.js mal node_modules: npm install $(STEPS): node_modules mal.js: $(SOURCES) cat $+ | sed 's/^export //' | grep -v "^import " >> $@ mal: mal.js echo "#!/usr/bin/env node" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.js mal rm -rf node_modules ================================================ FILE: impls/es6/core.mjs ================================================ import { _equal_Q, _clone, _keyword, _keyword_Q } from './types.mjs' import { _list_Q, Vector, _assoc_BANG, Atom } from './types.mjs' import { pr_str } from './printer.mjs' import rl from './node_readline.mjs' const readline = rl.readline import { read_str } from './reader.mjs' import { readFileSync } from 'fs' function _error(e) { throw new Error(e) } // String functions function slurp(f) { if (typeof process !== 'undefined') { return readFileSync(f, 'utf-8') } else { var req = new XMLHttpRequest() req.open('GET', f, false) req.send() if (req.status !== 200) { _error(`Failed to slurp file: ${f}`) } return req.responseText } } // Sequence functions function seq(obj) { if (_list_Q(obj)) { return obj.length > 0 ? obj : null } else if (obj instanceof Vector) { return obj.length > 0 ? Array.from(obj.slice(0)) : null } else if (typeof obj === "string" && !_keyword_Q(obj)) { return obj.length > 0 ? obj.split('') : null } else if (obj === null) { return null } else { _error('seq: called on non-sequence') } } // core_ns is namespace of type functions export const core_ns = new Map([ ['=', _equal_Q], ['throw', a => { throw a }], ['nil?', a => a === null], ['true?', a => a === true], ['false?', a => a === false], ['number?', a => typeof a === 'number'], ['string?', a => typeof a === "string" && !_keyword_Q(a)], ['symbol', a => Symbol.for(a)], ['symbol?', a => typeof a === 'symbol'], ['keyword', _keyword], ['keyword?', _keyword_Q], ['fn?', a => typeof a === 'function' && !a.ismacro ], ['macro?', a => typeof a === 'function' && !!a.ismacro ], ['pr-str', (...a) => a.map(e => pr_str(e,1)).join(' ')], ['str', (...a) => a.map(e => pr_str(e,0)).join('')], ['prn', (...a) => console.log(...a.map(e => pr_str(e,1))) || null], ['println', (...a) => console.log(...a.map(e => pr_str(e,0))) || null], ['read-string', read_str], ['readline', readline], ['slurp', slurp], ['<' , (a,b) => a' , (a,b) => a>b], ['>=', (a,b) => a>=b], ['+' , (a,b) => a+b], ['-' , (a,b) => a-b], ['*' , (a,b) => a*b], ['/' , (a,b) => a/b], ["time-ms", () => new Date().getTime()], ['list', (...a) => a], ['list?', _list_Q], ['vector', (...a) => Vector.from(a)], ['vector?', a => a instanceof Vector], ['hash-map', (...a) => _assoc_BANG(new Map(), ...a)], ['map?', a => a instanceof Map], ['assoc', (m,...a) => _assoc_BANG(_clone(m), ...a)], ['dissoc', (m,...a) => { let n = _clone(m); a.forEach(k => n.delete(k)); return n}], ['get', (m,a) => m === null ? null : m.has(a) ? m.get(a) : null], ['contains?', (m,a) => m.has(a)], ['keys', a => Array.from(a.keys())], ['vals', a => Array.from(a.values())], ['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))], ['empty?', a => a.length === 0], ['count', a => a === null ? 0 : a.length], ['apply', (f,...a) => f(...a.slice(0, -1).concat(a[a.length-1]))], ['map', (f,a) => Array.from(a.map(x => f(x)))], ['conj', (s,...a) => _list_Q(s) ? a.reverse().concat(s) : Vector.from(s.concat(a))], ['seq', seq], ['meta', a => 'meta' in a ? a['meta'] : null], ['with-meta', (a,b) => { let c = _clone(a); c.meta = b; return c }], ['atom', a => new Atom(a)], ['atom?', a => a instanceof Atom], ['deref', atm => atm.val], ['reset!', (atm,a) => atm.val = a], ['swap!', (atm,f,...args) => atm.val = f(...[atm.val].concat(args))] ]) ================================================ FILE: impls/es6/env.mjs ================================================ export function new_env(outer={}, binds=[], exprs=[]) { var e = Object.setPrototypeOf({}, outer) // Bind symbols in binds to values in exprs for (var i=0; i { if (sym in env) { return env[sym] } throw Error(`'${Symbol.keyFor(sym)}' not found`) } export const env_set = (env, sym, val) => env[sym] = val ================================================ FILE: impls/es6/node_readline.mjs ================================================ // IMPORTANT: choose one const RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL //const RL_LIB = "libedit.so.2"; import path from 'path'; import fs from 'fs'; const koffiCjs = await import('koffi'); const koffi = koffiCjs.default || koffiCjs; const HISTORY_FILE = path.join(process.env.HOME, '.mal-history'); const rllib = koffi.load(RL_LIB); const readlineFunc = rllib.func('char *readline(char *)'); const addHistoryFunc = rllib.func('int add_history(char *)'); var rl_history_loaded = false; function readline(prompt) { prompt = prompt || "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i pr_str(e,_r)).join(' ') + ")" } else if (obj instanceof Vector) { return "[" + obj.map(e => pr_str(e,_r)).join(' ') + "]" } else if (obj instanceof Map) { var ret = [] for (let [k,v] of obj) { ret.push(pr_str(k,_r), pr_str(v,_r)) } return "{" + ret.join(' ') + "}" } else if (typeof obj === "string") { if (_keyword_Q(obj)) { return ':' + obj.slice(1) } else if (_r) { return '"' + obj.replace(/\\/g, "\\\\") .replace(/"/g, '\\"') .replace(/\n/g, "\\n") + '"' } else { return obj } } else if (typeof obj === 'symbol') { return Symbol.keyFor(obj) } else if (obj === null) { return "nil" } else if (obj instanceof Atom) { return "(atom " + pr_str(obj.val,_r) + ")" } else { return obj.toString() } } ================================================ FILE: impls/es6/reader.mjs ================================================ import { _keyword, _assoc_BANG, Vector } from './types.mjs'; export class BlankException extends Error {} class Reader { constructor(tokens) { this.tokens = tokens this.position = 0 } next() { return this.tokens[this.position++] } peek() { return this.tokens[this.position] } } function tokenize(str) { const re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g let match = null let results = [] while ((match = re.exec(str)[1]) != '') { if (match[0] === ';') { continue } results.push(match) } return results } function read_atom (reader) { const token = reader.next() //console.log("read_atom:", token) if (token.match(/^-?[0-9]+$/)) { return parseInt(token,10) // integer } else if (token.match(/^-?[0-9][0-9.]*$/)) { return parseFloat(token,10) // float } else if (token.match(/^"(?:\\.|[^\\"])*"$/)) { return token.slice(1,token.length-1) .replace(/\\(.)/g, (_, c) => c === "n" ? "\n" : c) } else if (token[0] === "\"") { throw new Error("expected '\"', got EOF"); } else if (token[0] === ":") { return _keyword(token.slice(1)) } else if (token === "nil") { return null } else if (token === "true") { return true } else if (token === "false") { return false } else { return Symbol.for(token) // symbol } } // read list of tokens function read_list(reader, start, end) { start = start || '(' end = end || ')' var ast = [] var token = reader.next() if (token !== start) { throw new Error("expected '" + start + "'") } while ((token = reader.peek()) !== end) { if (!token) { throw new Error("expected '" + end + "', got EOF") } ast.push(read_form(reader)) } reader.next() return ast } // read vector of tokens function read_vector(reader) { return Vector.from(read_list(reader, '[', ']')); } // read hash-map key/value pairs function read_hash_map(reader) { return _assoc_BANG(new Map(), ...read_list(reader, '{', '}')) } function read_form(reader) { var token = reader.peek() switch (token) { // reader macros/transforms case ';': return null // Ignore comments case '\'': reader.next() return [Symbol.for('quote'), read_form(reader)] case '`': reader.next() return [Symbol.for('quasiquote'), read_form(reader)] case '~': reader.next() return [Symbol.for('unquote'), read_form(reader)] case '~@': reader.next() return [Symbol.for('splice-unquote'), read_form(reader)] case '^': reader.next() var meta = read_form(reader) return [Symbol.for('with-meta'), read_form(reader), meta] case '@': reader.next() return [Symbol.for('deref'), read_form(reader)] // list case ')': throw new Error("unexpected ')'") case '(': return read_list(reader) // vector case ']': throw new Error("unexpected ']'") case '[': return read_vector(reader) // hash-map case '}': throw new Error("unexpected '}'") case '{': return read_hash_map(reader) // atom default: return read_atom(reader) } } export function read_str(str) { var tokens = tokenize(str) if (tokens.length === 0) { throw new BlankException() } return read_form(new Reader(tokens)) } ================================================ FILE: impls/es6/run ================================================ #!/usr/bin/env bash exec node $(dirname $0)/${STEP:-stepA_mal}.mjs "${@}" ================================================ FILE: impls/es6/step0_repl.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline // read const READ = str => str // eval const EVAL = (ast, env) => ast // print const PRINT = exp => exp // repl const REP = str => PRINT(EVAL(READ(str), {})) while (true) { let line = readline('user> ') if (line == null) break if (line) { console.log(REP(line)) } } ================================================ FILE: impls/es6/step1_read_print.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' // read const READ = str => read_str(str) // eval const EVAL = (ast, env) => ast // print const PRINT = exp => pr_str(exp, true) // repl const REP = str => PRINT(EVAL(READ(str), {})) while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step2_eval.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' // read const READ = str => read_str(str) // eval const EVAL = (ast, env) => { // console.log('EVAL:', pr_str(ast, true)) if (typeof ast === 'symbol') { if (ast in env) { return env[ast] } else { throw Error(`'${Symbol.keyFor(ast)}' not found`) } } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [f, ...args] =ast.map(x => EVAL(x, env)) return f(...args) } // print const PRINT = exp => pr_str(exp, true) // repl var repl_env = {[Symbol.for('+')]: (a,b) => a+b, [Symbol.for('-')]: (a,b) => a-b, [Symbol.for('*')]: (a,b) => a*b, [Symbol.for('/')]: (a,b) => a/b} const REP = str => PRINT(EVAL(READ(str), repl_env)) while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step3_env.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' // read const READ = str => read_str(str) // eval const dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } return EVAL(a2, let_env) default: const [f, ...args] = ast.map(x => EVAL(x, env)) return f(...args) } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() env_set(repl_env, Symbol.for('+'), (a,b) => a+b) env_set(repl_env, Symbol.for('-'), (a,b) => a-b) env_set(repl_env, Symbol.for('*'), (a,b) => a*b) env_set(repl_env, Symbol.for('/'), (a,b) => a/b) const REP = str => PRINT(EVAL(READ(str), repl_env)) while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step4_if_fn_do.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval const dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } return EVAL(a2, let_env) case 'do': return ast.slice(1).map(x => EVAL(x, env))[ast.length-2] case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { return typeof a3 !== 'undefined' ? EVAL(a3, env) : null } else { return EVAL(a2, env) } case 'fn*': return (...args) => EVAL(a2, new_env(env, a1, args)) default: const [f, ...args] = ast.map(x => EVAL(x, env)) return f(...args) } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step5_tco.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval const dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step6_file.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval const dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) env_set(repl_env, Symbol.for('*ARGV*'), []) // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if (process.argv.length > 2) { env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) REP(`(load-file "${process.argv[2]}")`) process.exit(0) } while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step7_quote.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval 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 (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 dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'quote': return a1 case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const [f, ...args] = ast.map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) env_set(repl_env, Symbol.for('*ARGV*'), []) // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if (process.argv.length > 2) { env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) REP(`(load-file "${process.argv[2]}")`) process.exit(0) } while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step8_macros.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval 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 (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 dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'quote': return a1 case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop case 'defmacro!': let func = _clone(EVAL(a2, env)) func.ismacro = true return env_set(env, a1, func) case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const f = EVAL(a0, env) if (f.ismacro) { ast = f(...ast.slice(1)) break // continue TCO loop } const args = ast.slice(1).map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) env_set(repl_env, Symbol.for('*ARGV*'), []) // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') if (process.argv.length > 2) { env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) REP(`(load-file "${process.argv[2]}")`) process.exit(0) } while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${exc}`) } } } ================================================ FILE: impls/es6/step9_try.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval 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 (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 dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'quote': return a1 case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop case 'defmacro!': let func = _clone(EVAL(a2, env)) func.ismacro = true return env_set(env, a1, func) case 'try*': try { return EVAL(a1, env) } catch (exc) { if (a2 && a2[0] === Symbol.for('catch*')) { if (exc instanceof Error) { exc = exc.message } return EVAL(a2[2], new_env(env, [a2[1]], [exc])) } else { throw exc } } case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const f = EVAL(a0, env) if (f.ismacro) { ast = f(...ast.slice(1)) break // continue TCO loop } const args = ast.slice(1).map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) env_set(repl_env, Symbol.for('*ARGV*'), []) // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))') REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') if (process.argv.length > 2) { env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) REP(`(load-file "${process.argv[2]}")`) process.exit(0) } while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${pr_str(exc, true)}`) } } } ================================================ FILE: impls/es6/stepA_mal.mjs ================================================ import rl from './node_readline.mjs' const readline = rl.readline import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types.mjs' import { BlankException, read_str } from './reader.mjs' import { pr_str } from './printer.mjs' import { new_env, env_set, env_get } from './env.mjs' import { core_ns } from './core.mjs' // read const READ = str => read_str(str) // eval 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 (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 dbgevalsym = Symbol.for("DEBUG-EVAL") const EVAL = (ast, env) => { while (true) { if (dbgevalsym in env) { const dbgeval = env_get(env, dbgevalsym) if (dbgeval !== null && dbgeval !== false) { console.log('EVAL:', pr_str(ast, true)) } } if (typeof ast === 'symbol') { return env_get(env, ast) } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm } else if (!_list_Q(ast)) { return ast } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast switch (typeof a0 === 'symbol' ? Symbol.keyFor(a0) : Symbol(':default')) { case 'def!': return env_set(env, a1, EVAL(a2, env)) case 'let*': let let_env = new_env(env) for (let i=0; i < a1.length; i+=2) { env_set(let_env, a1[i], EVAL(a1[i+1], let_env)) } env = let_env ast = a2 break // continue TCO loop case 'quote': return a1 case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop case 'defmacro!': let func = _clone(EVAL(a2, env)) func.ismacro = true return env_set(env, a1, func) case 'try*': try { return EVAL(a1, env) } catch (exc) { if (a2 && a2[0] === Symbol.for('catch*')) { if (exc instanceof Error) { exc = exc.message } return EVAL(a2[2], new_env(env, [a2[1]], [exc])) } else { throw exc } } case 'do': ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': let cond = EVAL(a1, env) if (cond === null || cond === false) { ast = (typeof a3 !== 'undefined') ? a3 : null } else { ast = a2 } break // continue TCO loop case 'fn*': return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: const f = EVAL(a0, env) if (f.ismacro) { ast = f(...ast.slice(1)) break // continue TCO loop } const args = ast.slice(1).map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast break // continue TCO loop } else { return f(...args) } } } } // print const PRINT = exp => pr_str(exp, true) // repl let repl_env = new_env() const REP = str => PRINT(EVAL(READ(str), repl_env)) // core.EXT: defined using ES6 for (let [k, v] of core_ns) { env_set(repl_env, Symbol.for(k), v) } env_set(repl_env, Symbol.for('eval'), a => EVAL(a, repl_env)) env_set(repl_env, Symbol.for('*ARGV*'), []) // core.mal: defined using language itself REP('(def! *host-language* "ecmascript6")') REP('(def! not (fn* (a) (if a false true)))') REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list \'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons \'cond (rest (rest xs)))))))') if (process.argv.length > 2) { env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3)) REP(`(load-file "${process.argv[2]}")`) process.exit(0) } REP('(println (str "Mal [" *host-language* "]"))') while (true) { let line = readline('user> ') if (line == null) break try { if (line) { console.log(REP(line)) } } catch (exc) { if (exc instanceof BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn(`Error: ${pr_str(exc, true)}`) } } } ================================================ FILE: impls/es6/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/es6/types.mjs ================================================ // General functions export function _equal_Q (a, b) { if (Array.isArray(a) && Array.isArray(b)) { if (a.length !== b.length) { return false } for (let i=0; i obj.apply(f, a) // new function instance new_obj = Object.assign(f, obj) // copy original properties } else { throw Error('Unsupported type for clone') } if (typeof new_meta !== 'undefined') { new_obj.meta = new_meta } return new_obj } // Functions export function _malfunc(f, ast, env, params, meta=null, ismacro=false) { return Object.assign(f, {ast, env, params, meta, ismacro}) } export const _malfunc_Q = f => f.ast ? true : false // Keywords export const _keyword = obj => _keyword_Q(obj) ? obj : '\u029e' + obj export const _keyword_Q = obj => typeof obj === 'string' && obj[0] === '\u029e' // Lists export const _list_Q = obj => Array.isArray(obj) && !(obj instanceof Vector) // Vectors export class Vector extends Array { } // Maps export function _assoc_BANG(hm, ...args) { if (args.length % 2 === 1) { throw new Error('Odd number of assoc arguments') } for (let i=0; i ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install ca-certificates curl libgtkglext1-dev libreadline-dev RUN curl https://downloads.factorcode.org/releases/0.98/factor-linux-x86-64-0.98.tar.gz | tar -xzC/opt ENV PATH /opt/factor:$PATH # Allow /mal/factor to create the $HOME/.cache directory. ENV HOME /mal ================================================ FILE: impls/factor/Makefile ================================================ SOURCES_BASE = lib/types/types.factor lib/reader/reader.factor lib/printer/printer.factor SOURCES_LISP = lib/env/env.factor lib/core/core.factor stepA_mal/stepA_mal.factor SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.factor mal # dependency order (env must come before types) ORDERED_SOURCES = $(filter %env.factor,$(SOURCES)) $(filter-out %env.factor,$(SOURCES)) mal.factor: $(ORDERED_SOURCES) cat $+ | sed '/^USING:/,/;/ s/ *lib.[a-z]*//g' > $@ mal: mal.factor echo '#!/usr/bin/env factor' > $@ cat $< >> $@ chmod +x $@ # TODO: standalone compiled app #mal.factor: $(SOURCES) # mkdir -p dist_tmp; \ # FDIR=$$(dirname $$(readlink -f $$(which factor))); \ # for f in $${FDIR}/*; do ln -sf $$f dist_tmp/; done; \ # rm dist_tmp/factor; \ # cp $${FDIR}/factor dist_tmp/factor; \ # HOME=/mal FACTOR_ROOTS=. dist_tmp/factor dist.factor # #cat $+ | sed 's///' >> $@ clean: rm -f mal.factor ================================================ FILE: impls/factor/lib/core/core-tests.factor ================================================ USING: assocs effects kernel sequences stack-checker tools.test ; IN: lib.core { t } [ ns values [ infer ( x -- * ) ( x -- x ) [ effect= ] bi-curry@ bi or ] all? ] unit-test ================================================ FILE: impls/factor/lib/core/core.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit fry grouping hash-sets hashtables io io.encodings.utf8 io.files kernel lists lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences sets strings system vectors ; IN: lib.core SYMBOL: mal-apply : pr-str-stack ( exprs readably? glue -- str ) [ '[ _ (pr-str) ] map ] dip join ; CONSTANT: empty-env T{ malenv f f H{ } } CONSTANT: ns H{ { "+" [ first2 + ] } { "-" [ first2 - ] } { "*" [ first2 * ] } { "/" [ first2 / ] } { "list" [ >array ] } { "list?" [ first array? ] } { "empty?" [ first empty? ] } { "count" [ first dup nil? [ drop 0 ] [ length ] if ] } { "=" [ first2 mal= ] } { "<" [ first2 < ] } { ">" [ first2 > ] } { ">=" [ first2 >= ] } { "<=" [ first2 <= ] } { "pr-str" [ t " " pr-str-stack ] } { "str" [ f "" pr-str-stack ] } { "prn" [ t " " pr-str-stack print flush nil ] } { "println" [ f " " pr-str-stack print flush nil ] } { "read-string" [ first read-str ] } { "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 ] } { "throw" [ first throw ] } { "apply" [ unclip [ unclip-last append ] dip mal-apply get call( args fn -- maltype ) ] } { "map" [ first2 swap '[ 1array _ mal-apply get call( args fn -- maltype ) ] map { } like ] } { "nil?" [ first nil? ] } { "true?" [ first t = ] } { "false?" [ first f = ] } { "symbol" [ first ] } { "symbol?" [ first malsymbol? ] } { "string?" [ first string? ] } { "keyword" [ first dup string? [ ] when ] } { "keyword?" [ first malkeyword? ] } { "number?" [ first number? ] } { "fn?" [ first { [ callable? ] [ { [ malfn? ] [ macro?>> not ] } 1&& ] } 1|| ] } { "macro?" [ first { [ malfn? ] [ macro?>> ] } 1&& ] } { "vector" [ >vector ] } { "vector?" [ first vector? ] } { "hash-map" [ 2 group parse-hashtable ] } { "map?" [ first hashtable? ] } { "assoc" [ unclip swap 2 group parse-hashtable assoc-union ] } { "dissoc" [ unclip swap >hash-set '[ drop _ in? not ] assoc-filter ] } { "get" [ first2 swap dup nil? [ nip ] [ ?at [ drop nil ] unless ] if ] } { "contains?" [ first2 swap dup nil? [ nip ] [ at* nip ] if ] } { "keys" [ first keys ] } { "vals" [ first values ] } { "sequential?" [ first { [ vector? ] [ array? ] } 1|| ] } { "readline" [ first readline ] } { "meta" [ first dup malfn? [ meta>> ] [ drop f ] if [ nil ] unless* ] } { "with-meta" [ first2 over malfn? [ [ clone ] dip >>meta ] [ drop ] if ] } { "atom" [ first ] } { "atom?" [ first malatom? ] } { "deref" [ first val>> ] } { "reset!" [ first2 >>val val>> ] } { "swap!" [ { [ first ] [ second ] [ 2 tail ] [ first val>> ] } cleave prefix swap mal-apply get call( args fn -- maltype ) >>val val>> ] } { "conj" [ unclip swap over array? [ reverse prepend ] [ append ] if ] } { "seq" [ first { { [ dup nil? ] [ drop nil ] } { [ dup empty? ] [ drop nil ] } { [ dup array? ] [ ] } { [ dup vector? ] [ >array ] } { [ dup string? ] [ [ 1string ] { } map-as ] } } cond ] } { "time-ms" [ drop nano-count 1,000,000 /i ] } } ================================================ FILE: impls/factor/lib/env/env-tests.factor ================================================ USING: assocs kernel lib.types tools.test ; IN: lib.env { "1" } [ T{ malsymbol { name "foo" } } T{ malenv { outer T{ malenv f f H{ { "foo" "2" } } } } { data H{ { "foo" "1" } } } } env-get ] unit-test { "2" } [ T{ malsymbol { name "foo" } } T{ malenv { outer T{ malenv f f H{ { "foo" "2" } } } } { data H{ { "bar" "1" } } } } env-get ] unit-test { "3" } [ T{ malsymbol { name "foo" } } T{ malenv { outer f } { data H{ } } } [ [ "3" ] 2dip env-set ] [ env-get ] 2bi ] unit-test [ T{ malsymbol { name "baz" } } T{ malenv { outer T{ malenv f f H{ { "foo" "2" } } } } { data H{ { "bar" "1" } } } } env-get ] must-fail ================================================ FILE: impls/factor/lib/env/env.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs formatting hashtables kernel math sequences typed ; IN: lib.env TUPLE: malenv { outer read-only } { data hashtable read-only } ; ! set outer to f if top level env C: malenv : new-env ( outer -- malenv ) H{ } clone malenv boa ; TYPED: env-find ( key malenv: malenv -- value/f ? ) 2dup [ name>> ] [ data>> ] bi* at* [ [ 2drop ] 2dip ] [ drop outer>> [ env-find ] [ drop f f ] if* ] if* ; TYPED: env-set ( value key malenv: malenv -- ) [ name>> ] [ data>> ] bi* set-at ; : env-get ( key assoc -- value ) dupd env-find [ nip ] [ drop name>> "'%s' not found" sprintf throw ] if ; ================================================ FILE: impls/factor/lib/printer/printer-tests.factor ================================================ USING: lists lib.types tools.test ; IN: lib.printer { "(atom \"foo\")" } [ T{ malatom { val "foo" } } pr-str ] unit-test { "#" } [ T{ malfn } pr-str ] unit-test { ":foo" } [ T{ malkeyword { name "foo" } } pr-str ] unit-test { "foo" } [ T{ malsymbol { name "foo" } } pr-str ] unit-test { "14" } [ 14 pr-str ] unit-test { "\"\\\\foo\\\"\"" } [ "\\foo\"" pr-str ] unit-test { "(1 2 3 4)" } [ { 1 2 3 4 } pr-str ] unit-test { "[1 2 3 4]" } [ V{ 1 2 3 4 } pr-str ] unit-test { "{1 2}" } [ H{ { 1 2 } } pr-str ] unit-test { "true" } [ t pr-str ] unit-test { "false" } [ f pr-str ] unit-test { "nil" } [ +nil+ pr-str ] unit-test ================================================ FILE: impls/factor/lib/printer/printer.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry hashtables kernel lists lib.types math math.parser sequences splitting strings summary vectors ; IN: lib.printer GENERIC#: (pr-str) 1 ( maltype readably? -- str ) M: object (pr-str) drop summary ; M: malatom (pr-str) [ val>> ] dip (pr-str) "(atom " ")" surround ; M: malfn (pr-str) 2drop "#" ; M: malkeyword (pr-str) drop name>> ":" prepend ; M: malsymbol (pr-str) drop name>> ; M: number (pr-str) drop number>string ; M: string (pr-str) [ "\\" "\\\\" replace "\"" "\\\"" replace "\n" "\\n" replace "\"" dup surround ] when ; M: array (pr-str) '[ _ (pr-str) ] map " " join "(" ")" surround ; M: vector (pr-str) '[ _ (pr-str) ] map " " join "[" "]" surround ; M: hashtable (pr-str) [ unzip ] dip '[ [ _ (pr-str) ] bi@ " " glue ] 2map " " join "{" "}" surround ; M: t (pr-str) 2drop "true" ; M: f (pr-str) 2drop "false" ; M: +nil+ (pr-str) 2drop "nil" ; : pr-str ( maltype -- str ) t (pr-str) ; ================================================ FILE: impls/factor/lib/reader/reader-tests.factor ================================================ USING: lists lib.types tools.test ; IN: lib.reader { "foo" } [ "\"foo\"" read-atom ] unit-test { T{ malkeyword { name "foo" } } } [ ":foo" read-atom ] unit-test { f } [ "false" read-atom ] unit-test { t } [ "true" read-atom ] unit-test { +nil+ } [ "nil" read-atom ] unit-test { T{ malsymbol { name "foo" } } } [ "foo" read-atom ] unit-test { 14 } [ "14" read-atom ] unit-test { 1.5 } [ "1.5" read-atom ] unit-test { 2/3 } [ "2/3" read-atom ] unit-test ================================================ FILE: impls/factor/lib/reader/reader.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: arrays combinators grouping hashtables kernel lists locals make lib.types math.parser regexp sequences splitting strings ; IN: lib.reader CONSTANT: token-regex R/ (~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)~^@]+)/ DEFER: read-form : (read-string) ( str -- maltype ) ! dup last CHAR: " = [ dup R/ ^"(?:\\.|[^\\"])*"$/ matches? [ rest but-last R/ \\./ [ { { [ dup >string "\\\\" = ] [ drop "\\" ] } { [ dup >string "\\n" = ] [ drop "\n" ] } { [ dup >string "\\\"" = ] [ drop "\"" ] } [ ] } cond ] re-replace-with ] [ "expected '\"', got EOF" throw ] if ; : (read-atom) ( str -- maltype ) { { [ dup first CHAR: " = ] [ (read-string) ] } { [ dup first CHAR: : = ] [ rest ] } { [ dup "false" = ] [ drop f ] } { [ dup "true" = ] [ drop t ] } { [ dup "nil" = ] [ drop nil ] } [ ] } cond ; : read-atom ( str -- maltype ) dup string>number [ nip ] [ (read-atom) ] if* ; :: read-sequence ( seq closer exemplar -- seq maltype ) seq [ [ [ "expected '" closer "', got EOF" append append throw ] [ dup first closer = ] if-empty ] [ read-form , ] until rest ] exemplar make ; : read-list ( seq -- seq maltype ) ")" { } read-sequence ; : read-vector ( seq -- seq maltype ) "]" V{ } read-sequence ; : read-hashmap ( seq -- seq maltype ) "}" V{ } read-sequence 2 group parse-hashtable ; : consume-next-into-list ( seq symname -- seq maltype ) [ read-form ] dip swap 2array ; : read-form ( seq -- seq maltype ) unclip { { "(" [ read-list ] } { "[" [ read-vector ] } { "{" [ read-hashmap ] } { "'" [ "quote" consume-next-into-list ] } { "`" [ "quasiquote" consume-next-into-list ] } { "~" [ "unquote" consume-next-into-list ] } { "~@" [ "splice-unquote" consume-next-into-list ] } { "^" [ read-form [ read-form ] dip 2array "with-meta" prefix ] } { "@" [ "deref" consume-next-into-list ] } [ read-atom ] } case ; : tokenize ( str -- seq ) token-regex all-matching-subseqs [ first CHAR: ; = not ] filter ; : read-str ( str -- maltype ) tokenize [ " " throw ] [ read-form nip ] if-empty ; ================================================ FILE: impls/factor/lib/types/types.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators.short-circuit hashtables kernel locals lib.env sequences strings ; IN: lib.types TUPLE: malsymbol { name string read-only } ; C: malsymbol : symeq? ( string other -- ? ) dup malsymbol? [ name>> = ] [ 2drop f ] if ; TUPLE: malfn { env malenv read-only } { binds sequence read-only } { exprs read-only } { macro? boolean read-only } { meta assoc } ; : malmacro ( fn -- fn ) [ env>> ] [ binds>> ] [ exprs>> ] tri t f malfn boa ; : ( env binds exprs -- fn ) f f malfn boa ; TUPLE: malatom { val } ; C: malatom TUPLE: malkeyword { name string read-only } ; C: malkeyword DEFER: mal= : mal-sequence= ( seq1 seq2 -- ? ) 2dup [ length ] bi@ = [ [ mal= ] 2all? ] [ 2drop f ] if ; :: mal-hashtable= ( h1 h2 -- ? ) h1 assoc-size h2 assoc-size = [ h1 [| k1 v1 | k1 h2 at* drop v1 mal= ] assoc-all? ] [ f ] if ; : mal= ( obj1 obj2 -- ? ) 2dup [ hashtable? ] bi@ and [ mal-hashtable= ] [ 2dup [ { [ ] [ sequence? ] [ string? not ] } 1&& ] bi@ and [ mal-sequence= ] [ = ] if ] if ; ================================================ FILE: impls/factor/run ================================================ #!/usr/bin/env bash exec factor $(dirname $0)/${STEP:-stepA_mal}/${STEP:-stepA_mal}.factor "${@}" ================================================ FILE: impls/factor/step0_repl/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step0_repl" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step0_repl/step0_repl.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: io kernel readline sequences ; IN: step0_repl : READ ( x -- x ) ; : EVAL ( x -- x ) ; : PRINT ( x -- x ) ; : REP ( x -- x ) READ EVAL PRINT ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; MAIN: REPL ================================================ FILE: impls/factor/step1_read_print/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step1_read_print" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step1_read_print/step1_read_print.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: continuations io kernel lib.printer lib.reader readline sequences ; IN: step1_read_print : READ ( str -- maltype ) read-str ; : EVAL ( maltype -- maltype ) ; : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; MAIN: REPL ================================================ FILE: impls/factor/step2_eval/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step2_eval" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step2_eval/step2_eval.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit continuations fry hashtables io kernel math lib.printer lib.reader lib.types quotations readline sequences vectors ; IN: step2_eval CONSTANT: repl-env H{ { "+" [ + ] } { "-" [ - ] } { "*" [ * ] } { "/" [ / ] } } DEFER: EVAL : READ ( str -- maltype ) read-str ; : apply ( maltype env -- maltype ) dup quotation? [ drop "not a fn" throw ] unless with-datastack first ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch '[ _ EVAL ] map dup empty? [ unclip apply ] unless ; M: malsymbol EVAL-switch [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) ! "EVAL: " pick pr-str append print flush EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; MAIN: REPL ================================================ FILE: impls/factor/step3_env/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step3_env" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step3_env/step3_env.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit continuations fry grouping hashtables io kernel lists locals lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences vectors ; IN: step3_env CONSTANT: repl-bindings H{ { "+" [ + ] } { "-" [ - ] } { "*" [ * ] } { "/" [ / ] } } SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep EVAL ; : READ ( str -- maltype ) read-str ; : apply ( maltype env -- maltype ) dup quotation? [ drop "not a fn" throw ] unless with-datastack first ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! ] } { "let*" [ [ rest first2 ] dip eval-let* ] } [ drop '[ _ EVAL ] map unclip apply ] } case ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) f repl-bindings repl-env set [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; MAIN: REPL ================================================ FILE: impls/factor/step4_if_fn_do/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step4_if_fn_do" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step4_if_fn_do/step4_if_fn_do.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences splitting vectors ; IN: step4_if_fn_do SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep EVAL ; :: eval-if ( params env -- maltype ) params first env EVAL { f +nil+ } index not [ params second env EVAL ] [ params length 2 > [ params third env EVAL ] [ nil ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri EVAL ; M: callable apply call( x -- y ) ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! ] } { "let*" [ [ rest first2 ] dip eval-let* ] } { "do" [ [ rest ] dip '[ _ EVAL ] map last ] } { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* ] } [ drop '[ _ EVAL ] map unclip apply ] } case ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; f ns repl-env set-global "(def! not (fn* (a) (if a false true)))" REP drop MAIN: REPL ================================================ FILE: impls/factor/step5_tco/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step5_tco" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step5_tco/step5_tco.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences splitting vectors ; IN: step5_tco SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "let*" [ [ rest first2 ] dip eval-let* ] } { "do" [ [ rest ] dip eval-do ] } { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; f ns repl-env set-global "(def! not (fn* (a) (if a false true)))" REP drop MAIN: REPL ================================================ FILE: impls/factor/step6_file/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step6_file" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step6_file/step6_file.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. 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 vectors ; IN: step6_file SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "let*" [ [ rest first2 ] dip eval-let* ] } { "do" [ [ rest ] dip eval-do ] } { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; : main ( -- ) command-line get [ REPL ] [ first "(load-file \"" "\")" surround REP drop ] if-empty ; f ns clone [ first repl-env get EVAL ] "eval" pick set-at command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at repl-env set-global " (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) " string-lines harvest [ REP drop ] each MAIN: main ================================================ FILE: impls/factor/step7_quote/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step7_quote" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step7_quote/step7_quote.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. 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 vectors ; IN: step7_quote SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; DEFER: quasiquote : 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: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "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 ] } { "quasiquote" [ [ second quasiquote ] dip ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; : main ( -- ) command-line get [ REPL ] [ first "(load-file \"" "\")" surround REP drop ] if-empty ; f ns clone [ first repl-env get EVAL ] "eval" pick set-at command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at repl-env set-global " (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) " string-lines harvest [ REP drop ] each MAIN: main ================================================ FILE: impls/factor/step8_macros/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step8_macros" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step8_macros/step8_macros.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. 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 vectors ; IN: step8_macros SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; :: eval-defmacro! ( key value env -- maltype ) value env EVAL malmacro [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; DEFER: quasiquote : 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: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } { "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 ] } { "quasiquote" [ [ second quasiquote ] dip ] } [ drop swap ! env ast unclip ! env rest first pick EVAL ! env rest fn dup { [ malfn? ] [ macro?>> ] } 1&& [ apply ! env maltype newenv EVAL swap ] [ [ swap '[ _ EVAL ] map ] dip ! args fn apply ] if ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; : main ( -- ) command-line get [ REPL ] [ first "(load-file \"" "\")" surround REP drop ] if-empty ; f ns clone [ first repl-env get EVAL ] "eval" pick set-at command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at repl-env set-global " (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) (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))))))) " string-lines harvest [ REP drop ] each MAIN: main ================================================ FILE: impls/factor/step9_try/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "step9_try" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/step9_try/step9_try.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. 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 vectors ; IN: step9_try SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; :: eval-defmacro! ( key value env -- maltype ) value env EVAL malmacro [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; :: eval-try* ( params env -- maltype ) [ params first env EVAL ] [ params length 1 > [ params second second env new-env [ env-set ] keep params second third swap EVAL ] [ throw ] if ] recover ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; DEFER: quasiquote : 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: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } { "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 ] } { "quasiquote" [ [ second quasiquote ] dip ] } { "try*" [ [ rest ] dip eval-try* f ] } [ drop swap ! env ast unclip ! env rest first pick EVAL ! env rest fn dup { [ malfn? ] [ macro?>> ] } 1&& [ apply ! env maltype newenv EVAL swap ] [ [ swap '[ _ EVAL ] map ] dip ! args fn apply ] if ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; : main ( -- ) command-line get [ REPL ] [ first "(load-file \"" "\")" surround REP drop ] if-empty ; f ns clone [ first repl-env get EVAL ] "eval" pick set-at command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at repl-env set-global " (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) (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))))))) " string-lines harvest [ REP drop ] each MAIN: main ================================================ FILE: impls/factor/stepA_mal/deploy.factor ================================================ USING: tools.deploy.config ; H{ { deploy-c-types? f } { deploy-help? f } { deploy-name "stepA_mal" } { "stop-after-last-window?" t } { deploy-unicode? f } { deploy-console? t } { deploy-io 3 } { deploy-reflection 1 } { deploy-ui? f } { deploy-word-defs? f } { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } } ================================================ FILE: impls/factor/stepA_mal/stepA_mal.factor ================================================ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. 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 vectors ; IN: stepA_mal SYMBOL: repl-env DEFER: EVAL :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; :: eval-defmacro! ( key value env -- maltype ) value env EVAL malmacro [ key env env-set ] keep ; : eval-let* ( bindings body env -- maltype env ) [ swap 2 group ] [ new-env ] bi* [ dup '[ first2 _ EVAL swap _ env-set ] each ] keep ; :: eval-do ( exprs env -- lastform env/f ) exprs [ { } f ] [ unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) params first env EVAL { f +nil+ } index not [ params second env ] [ params length 2 > [ params third env ] [ nil f ] if ] if ; :: eval-fn* ( params env -- maltype ) env params first [ name>> ] map params second ; :: eval-try* ( params env -- maltype ) [ params first env EVAL ] [ params length 1 > [ params second second env new-env [ env-set ] keep params second third swap EVAL ] [ throw ] if ] recover ; : args-split ( bindlist -- bindlist restbinding/f ) { "&" } split1 ?first ; : make-bindings ( args bindlist restbinding/f -- bindingshash ) swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] [ env>> nip ] [ binds>> args-split make-bindings ] 2tri ; M: callable apply call( x -- y ) f ; DEFER: quasiquote : 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: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; : READ ( str -- maltype ) read-str ; GENERIC#: EVAL-switch 1 ( maltype env -- maltype ) M: array EVAL-switch over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } { "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 ] } { "quasiquote" [ [ second quasiquote ] dip ] } { "try*" [ [ rest ] dip eval-try* f ] } [ drop swap ! env ast unclip ! env rest first pick EVAL ! env rest fn dup { [ malfn? ] [ macro?>> ] } 1&& [ apply ! env maltype newenv EVAL swap ] [ [ swap '[ _ EVAL ] map ] dip ! args fn apply ] if ] } case [ EVAL ] when* ] if ; M: malsymbol EVAL-switch env-get ; M: vector EVAL-switch '[ _ EVAL ] map ; M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; M: object EVAL-switch drop ; : EVAL ( maltype env -- maltype ) "DEBUG-EVAL" over env-find [ { f +nil+ } index not [ "EVAL: " pick pr-str append print flush ] when ] [ drop ] if EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global : PRINT ( maltype -- str ) pr-str ; : REP ( str -- str ) [ READ repl-env get EVAL PRINT ] [ nip pr-str "Error: " swap append ] recover ; : REPL ( -- ) "(println (str \"Mal [\" *host-language* \"]\"))" REP drop [ "user> " readline [ [ REP print flush ] unless-empty ] keep ] loop ; : main ( -- ) command-line get [ REPL ] [ first "(load-file \"" "\")" surround REP drop ] if-empty ; f ns clone [ first repl-env get EVAL ] "eval" pick set-at command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at repl-env set-global " (def! *host-language* \"factor\") (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\"))))) (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))))))) " string-lines harvest [ READ repl-env get EVAL drop ] each MAIN: main ================================================ FILE: impls/factor/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/fantom/Dockerfile ================================================ FROM ubuntu:bionic MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Java and Unzip RUN apt-get -y install openjdk-8-jdk unzip # Fantom and JLine RUN cd /tmp && curl -sfLO https://github.com/fantom-lang/fantom/releases/download/v1.0.75/fantom-1.0.75.zip \ && unzip -q fantom-1.0.75.zip \ && rm fantom-1.0.75.zip \ && mv fantom-1.0.75 /opt/fantom \ && cd /opt/fantom \ && bash adm/unixsetup \ && curl -sfL -o /opt/fantom/lib/java/jline.jar https://repo1.maven.org/maven2/jline/jline/2.14.6/jline-2.14.6.jar \ && sed -i '/java.options/ s/^\/\/ *\(.*\)$/\1 -Djline.expandevents=false/' /opt/fantom/etc/sys/config.props ENV PATH /opt/fantom/bin:$PATH ENV HOME /mal ================================================ FILE: impls/fantom/Makefile ================================================ all: dist dist: lib/fan/mal.pod lib/fan: mkdir -p $@ lib/fan/mal.pod: lib/fan/stepA_mal.pod cp -a $< $@ lib/fan/step%.pod: src/step%/build.fan src/step%/fan/*.fan lib/fan/mallib.pod FAN_ENV=util::PathEnv FAN_ENV_PATH=. fan $< lib/fan/mallib.pod: src/mallib/build.fan src/mallib/fan/*.fan lib/fan FAN_ENV=util::PathEnv FAN_ENV_PATH=. fan $< clean: rm -rf lib ================================================ FILE: impls/fantom/run ================================================ #!/usr/bin/env bash export FAN_ENV=util::PathEnv export FAN_ENV_PATH="$(dirname $0)" exec fan ${STEP:-stepA_mal} "$@" ================================================ FILE: impls/fantom/src/mallib/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "mallib" summary = "mal library pod" depends = ["sys 1.0", "compiler 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/mallib/fan/core.fan ================================================ class Core { static private MalVal prn(MalVal[] a) { echo(a.join(" ") { it.toString(true) }) return MalNil.INSTANCE } static private MalVal println(MalVal[] a) { echo(a.join(" ") { it.toString(false) }) return MalNil.INSTANCE } static private MalVal readline(MalVal[] a) { line := Env.cur.prompt((a[0] as MalString).value) return line == null ? MalNil.INSTANCE : MalString.make(line) } static private MalVal concat(MalVal[] a) { return MalList(a.reduce(MalVal[,]) |MalVal[] r, MalSeq v -> MalVal[]| { r.addAll(v.value) }) } static private MalVal apply(MalVal[] a) { f := a[0] as MalFunc args := a[1..-2] args.addAll(((MalSeq)a[-1]).value) return f.call(args) } static private MalVal swap_bang(MalVal[] a) { atom := a[0] as MalAtom MalVal[] args := [atom.value] args.addAll(a[2..-1]) f := a[1] as MalFunc return atom.set(f.call(args)) } static Str:MalFunc ns() { return [ "=": MalFunc { MalTypes.toMalBool(it[0] == it[1]) }, "throw": MalFunc { throw MalException(it[0]) }, "nil?": MalFunc { MalTypes.toMalBool(it[0] is MalNil) }, "true?": MalFunc { MalTypes.toMalBool(it[0] is MalTrue) }, "false?": MalFunc { MalTypes.toMalBool(it[0] is MalFalse) }, "string?": MalFunc { MalTypes.toMalBool(it[0] is MalString && !((MalString)it[0]).isKeyword) }, "symbol": MalFunc { MalSymbol.makeFromVal(it[0]) }, "symbol?": MalFunc { MalTypes.toMalBool(it[0] is MalSymbol) }, "keyword": MalFunc { MalString.makeKeyword((it[0] as MalString).value) }, "keyword?": MalFunc { MalTypes.toMalBool(it[0] is MalString && ((MalString)it[0]).isKeyword) }, "number?": MalFunc { MalTypes.toMalBool(it[0] is MalInteger) }, "fn?": MalFunc { MalTypes.toMalBool(it[0] is MalFunc && !((it[0] as MalUserFunc)?->isMacro ?: false)) }, "macro?": MalFunc { MalTypes.toMalBool(it[0] is MalUserFunc && ((MalUserFunc)it[0]).isMacro) }, "pr-str": MalFunc { MalString.make(it.join(" ") |MalVal e -> Str| { e.toString(true) }) }, "str": MalFunc { MalString.make(it.join("") |MalVal e -> Str| { e.toString(false) }) }, "prn": MalFunc(#prn.func), "println": MalFunc(#println.func), "read-string": MalFunc { Reader.read_str((it[0] as MalString).value) }, "readline": MalFunc(#readline.func), "slurp": MalFunc { MalString.make(File((it[0] as MalString).value.toUri).readAllStr) }, "<": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value < (it[1] as MalInteger).value) }, "<=": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value <= (it[1] as MalInteger).value) }, ">": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value > (it[1] as MalInteger).value) }, ">=": MalFunc { MalTypes.toMalBool((it[0] as MalInteger).value >= (it[1] as MalInteger).value) }, "+": MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }, "-": MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }, "*": MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }, "/": MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) }, "time-ms": MalFunc { MalInteger(DateTime.nowTicks / 1000000) }, "list": MalFunc { MalList(it) }, "list?": MalFunc { MalTypes.toMalBool(it[0] is MalList) }, "vector": MalFunc { MalVector(it) }, "vector?": MalFunc { MalTypes.toMalBool(it[0] is MalVector) }, "hash-map": MalFunc { MalHashMap.fromList(it) }, "map?": MalFunc { MalTypes.toMalBool(it[0] is MalHashMap) }, "assoc": MalFunc { (it[0] as MalHashMap).assoc(it[1..-1]) }, "dissoc": MalFunc { (it[0] as MalHashMap).dissoc(it[1..-1]) }, "get": MalFunc { it[0] is MalNil ? MalNil.INSTANCE : (it[0] as MalHashMap).get2((MalString)it[1], MalNil.INSTANCE) }, "contains?": MalFunc { MalTypes.toMalBool((it[0] as MalHashMap).containsKey((MalString)it[1])) }, "keys": MalFunc { MalList((it[0] as MalHashMap).keys) }, "vals": MalFunc { MalList((it[0] as MalHashMap).vals) }, "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([,]) }, "empty?": MalFunc { MalTypes.toMalBool((it[0] as MalSeq).isEmpty) }, "count": MalFunc { MalInteger(it[0].count) }, "apply": MalFunc(#apply.func), "map": MalFunc { (it[1] as MalSeq).map(it[0]) }, "conj": MalFunc { (it[0] as MalSeq).conj(it[1..-1]) }, "seq": MalFunc { it[0].seq }, "meta": MalFunc { it[0].meta() }, "with-meta": MalFunc { it[0].with_meta(it[1]) }, "atom": MalFunc { MalAtom(it[0]) }, "atom?": MalFunc { MalTypes.toMalBool(it[0] is MalAtom) }, "deref": MalFunc { (it[0] as MalAtom).value }, "reset!": MalFunc { (it[0] as MalAtom).set(it[1]) }, "swap!": MalFunc(#swap_bang.func), "fantom-eval": MalFunc { Interop.fantomEvaluate((it[0] as MalString).value) } ] } } ================================================ FILE: impls/fantom/src/mallib/fan/env.fan ================================================ class MalEnv { private Str:MalVal data := [:] private MalEnv? outer new make(MalEnv? outer := null, MalSeq? binds := null, MalSeq? exprs := null) { this.outer = outer if (binds != null && exprs != null) { for (i := 0; i < binds.count; i++) { if ((binds[i] as MalSymbol).value == "&") { set(binds[i + 1], MalList(exprs[i..-1])) break } else set(binds[i], exprs[i]) } } } MalVal set(MalSymbol key, MalVal value) { data[key.value] = value return value } MalVal? get(Str key) { return data.containsKey(key) ? data[key] : outer?.get(key) } } ================================================ FILE: impls/fantom/src/mallib/fan/interop.fan ================================================ using compiler internal class Interop { static Pod? compile(Str innerBody) { ci := CompilerInput { podName = "mal_fantom_interop_${DateTime.nowUnique}" summary = "" isScript = true version = Version.defVal log.level = LogLevel.silent output = CompilerOutputMode.transientPod mode = CompilerInputMode.str srcStr = "class InteropDummyClass {\nstatic Obj? _evalfunc() {\n $innerBody \n}\n}" srcStrLoc = Loc("mal_fantom_interop") } try return Compiler(ci).compile.transientPod catch (CompilerErr e) return null } static Obj? evaluate(Str line) { p := compile(line) if (p == null) p = compile("return $line") if (p == null) p = compile("$line\nreturn null") if (p == null) return null method := p.types.first.method("_evalfunc") try return method.call() catch (Err e) return null } static MalVal fantomToMal(Obj? obj) { if (obj == null) return MalNil.INSTANCE else if (obj is Bool) return MalTypes.toMalBool((Bool)obj) else if (obj is Int) return MalInteger((Int)obj) else if (obj is List) return MalList((obj as List).map |Obj? e -> MalVal| { fantomToMal(e) }) else if (obj is Map) { m := [Str:MalVal][:] (obj as Map).each |v, k| { m.set(k.toStr, fantomToMal(v)) } return MalHashMap.fromMap(m) } else return MalString.make(obj.toStr) } static MalVal fantomEvaluate(Str line) { return fantomToMal(evaluate(line)) } } ================================================ FILE: impls/fantom/src/mallib/fan/reader.fan ================================================ internal class TokenReader { const Str[] tokens private Int position := 0 new make(Str[] new_tokens) { tokens = new_tokens } Str? peek() { if (position >= tokens.size) return null return tokens[position] } Str next() { return tokens[position++] } } class Reader { private static Str[] tokenize(Str s) { r := Regex <|[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)|> m := r.matcher(s) tokens := Str[,] while (m.find()) { token := m.group(1) if (token.isEmpty || token[0] == ';') continue tokens.add(m.group(1)) } return tokens } private static Str unescape_str(Str s) { return s.replace("\\\\", "\u029e").replace("\\\"", "\"").replace("\\n", "\n").replace("\u029e", "\\") } private static MalVal read_atom(TokenReader reader) { token := reader.next intRegex := Regex <|^-?\d+$|> strRegex := Regex <|^"(?:\\.|[^\\"])*"|> strBadRegex := Regex <|^".*|> if (token == "nil") return MalNil.INSTANCE if (token == "true") return MalTrue.INSTANCE if (token == "false") return MalFalse.INSTANCE if (intRegex.matches(token)) return MalInteger(token.toInt) if (strRegex.matches(token)) return MalString.make(unescape_str(token[1..-2])) if (strBadRegex.matches(token)) throw Err("expected '\"', got EOF") if (token[0] == '"') return MalString.make(unescape_str(token[1..-2])) if (token[0] == ':') return MalString.makeKeyword(token[1..-1]) return MalSymbol(token) } private static MalVal[] read_seq(TokenReader reader, Str open, Str close) { reader.next values := MalVal[,] token := reader.peek while (token != close) { if (token == null) throw Err("expected '$close', got EOF") values.add(read_form(reader)) token = reader.peek } if (token != close) throw Err("Missing '$close'") reader.next return values } private static MalVal read_form(TokenReader reader) { switch (reader.peek) { case "\'": reader.next return MalList([MalSymbol("quote"), read_form(reader)]) case "`": reader.next return MalList([MalSymbol("quasiquote"), read_form(reader)]) case "~": reader.next return MalList([MalSymbol("unquote"), read_form(reader)]) case "~@": reader.next return MalList([MalSymbol("splice-unquote"), read_form(reader)]) case "^": reader.next meta := read_form(reader) return MalList([MalSymbol("with-meta"), read_form(reader), meta]) case "@": reader.next return MalList([MalSymbol("deref"), read_form(reader)]) case "(": return MalList(read_seq(reader, "(", ")")) case ")": throw Err("unexpected ')'") case "[": return MalVector(read_seq(reader, "[", "]")) case "]": throw Err("unexpected ']'") case "{": return MalHashMap.fromList(read_seq(reader, "{", "}")) case "}": throw Err("unexpected '}'") default: return read_atom(reader) } } static MalVal read_str(Str s) { return read_form(TokenReader(tokenize(s))); } } ================================================ FILE: impls/fantom/src/mallib/fan/types.fan ================================================ mixin MalVal { virtual Str toString(Bool readable) { return toStr } virtual Int count() { throw Err("count not implemented") } virtual MalVal seq() { throw Err("seq not implemented") } abstract MalVal meta() abstract MalVal with_meta(MalVal newMeta) } const mixin MalValNoMeta : MalVal { override MalVal meta() { return MalNil.INSTANCE } override MalVal with_meta(MalVal newMeta) { return this } } const mixin MalFalseyVal { } const class MalNil : MalValNoMeta, MalFalseyVal { static const MalNil INSTANCE := MalNil() override Bool equals(Obj? that) { return that is MalNil } override Str toString(Bool readable) { return "nil" } override Int count() { return 0 } override MalVal seq() { return this } } const class MalTrue : MalValNoMeta { static const MalTrue INSTANCE := MalTrue() override Bool equals(Obj? that) { return that is MalTrue } override Str toString(Bool readable) { return "true" } } const class MalFalse : MalValNoMeta, MalFalseyVal { static const MalFalse INSTANCE := MalFalse() override Bool equals(Obj? that) { return that is MalFalse } override Str toString(Bool readable) { return "false" } } const class MalInteger : MalValNoMeta { const Int value new make(Int v) { value = v } override Bool equals(Obj? that) { return that is MalInteger && (that as MalInteger).value == value } override Str toString(Bool readable) { return value.toStr } } abstract class MalValBase : MalVal { private MalVal? metaVal := null override Str toString(Bool readable) { return toStr } override Int count() { throw Err("count not implemented") } override MalVal seq() { throw Err("seq not implemented") } abstract This dup() override MalVal meta() { return metaVal ?: MalNil.INSTANCE } override MalVal with_meta(MalVal newMeta) { v := dup v.metaVal = newMeta return v } } class MalSymbol : MalValBase { const Str value new make(Str v) { value = v } new makeFromVal(MalVal v) { if (v is MalSymbol) return v value = (v as MalString).value } override Bool equals(Obj? that) { return that is MalSymbol && (that as MalSymbol).value == value } override Str toString(Bool readable) { return value } override This dup() { return make(value) } } class MalString : MalValBase { const Str value new make(Str v) { value = v } new makeKeyword(Str v) { value = v[0] == '\u029e' ? v : "\u029e$v" } override Bool equals(Obj? that) { return that is MalString && (that as MalString).value == value } override Str toString(Bool readable) { if (isKeyword) return ":${value[1..-1]}" if (readable) return "\"${escapeStr(value)}\"" else return value } Bool isKeyword() { return !value.isEmpty && value[0] == '\u029e' } static Str escapeStr(Str s) { return s.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") } override MalVal seq() { if (value.size == 0) return MalNil.INSTANCE return MalList(value.chars.map |Int c -> MalString| { MalString.make(Str.fromChars([c])) }) } override This dup() { return make(value) } } abstract class MalSeq : MalValBase { MalVal[] value { protected set } new make(MalVal[] v) { value = v.ro } override Bool equals(Obj? that) { return that is MalSeq && (that as MalSeq).value == value } Bool isEmpty() { return value.isEmpty } override Int count() { return value.size } @Operator MalVal get(Int index) { return value[index] } @Operator MalVal[] getRange(Range range) { return value[range] } protected Str serialize(Bool readable) { return value.join(" ") { it.toString(readable) } } abstract MalSeq drop(Int n) MalVal nth(Int index) { return index < count ? get(index) : throw Err("nth: index out of range") } MalVal first() { return isEmpty ? MalNil.INSTANCE : value[0] } MalList rest() { return MalList(isEmpty ? [,] : value[1..-1]) } MalList map(MalFunc f) { return MalList(value.map |MalVal v -> MalVal| { f.call([v]) } ) } abstract MalSeq conj(MalVal[] args) } class MalList : MalSeq { new make(MalVal[] v) : super.make(v) {} override Str toString(Bool readable) { return "(${serialize(readable)})" } override MalList drop(Int n) { return make(value[n..-1]) } override MalVal seq() { return isEmpty ? MalNil.INSTANCE : this } override MalList conj(MalVal[] args) { return MalList(value.rw.insertAll(0, args.reverse)) } override This dup() { return make(value) } } class MalVector : MalSeq { new make(MalVal[] v) : super.make(v) {} override Str toString(Bool readable) { return "[${serialize(readable)}]" } override MalVector drop(Int n) { return make(value[n..-1]) } override MalVal seq() { return isEmpty ? MalNil.INSTANCE : MalList(value) } override MalVector conj(MalVal[] args) { return MalVector(value.rw.addAll(args)) } override This dup() { return make(value) } } class MalHashMap : MalValBase { Str:MalVal value { private set } new fromList(MalVal[] lst) { m := [Str:MalVal][:] for (i := 0; i < lst.size; i += 2) m.add((lst[i] as MalString).value, (MalVal)lst[i + 1]) value = m.ro } new fromMap(Str:MalVal m) { value = m.ro } override Bool equals(Obj? that) { return that is MalHashMap && (that as MalHashMap).value == value } override Str toString(Bool readable) { elements := Str[,] value.each(|MalVal v, Str k| { elements.add(MalString.make(k).toString(readable)); elements.add(v.toString(readable)) }) s := elements.join(" ") return "{$s}" } override Int count() { return value.size } @Operator MalVal get(Str key) { return value[key] } MalVal get2(MalString key, MalVal? def := null) { return value.get(key.value, def) } Bool containsKey(MalString key) { return value.containsKey(key.value) } MalVal[] keys() { return value.keys.map |Str k -> MalVal| { MalString.make(k) } } MalVal[] vals() { return value.vals } MalHashMap assoc(MalVal[] args) { newValue := value.dup for (i := 0; i < args.size; i += 2) newValue.set((args[i] as MalString).value, args[i + 1]) return fromMap(newValue) } MalHashMap dissoc(MalVal[] args) { newValue := value.dup args.each { newValue.remove((it as MalString).value) } return fromMap(newValue) } override This dup() { return fromMap(value) } } class MalFunc : MalValBase { protected |MalVal[] a -> MalVal| f new make(|MalVal[] a -> MalVal| func) { f = func } MalVal call(MalVal[] a) { return f(a) } override Str toString(Bool readable) { return "" } override This dup() { return make(f) } } class MalUserFunc : MalFunc { MalVal ast { private set } private MalEnv env private MalSeq params Bool isMacro := false new make(MalVal ast, MalEnv env, MalSeq params, |MalVal[] a -> MalVal| func, Bool isMacro := false) : super.make(func) { this.ast = ast this.env = env this.params = params this.isMacro = isMacro } MalEnv genEnv(MalSeq args) { return MalEnv(env, params, args) } override Str toString(Bool readable) { return "" } override This dup() { return make(ast, env, params, f, isMacro) } } class MalAtom : MalValBase { MalVal value new make(MalVal v) { value = v } override Str toString(Bool readable) { return "(atom ${value.toString(readable)})" } override Bool equals(Obj? that) { return that is MalAtom && (that as MalAtom).value == value } MalVal set(MalVal v) { value = v; return value } override This dup() { return make(value) } } class MalTypes { static MalVal toMalBool(Bool cond) { return cond ? MalTrue.INSTANCE : MalFalse.INSTANCE } static Bool isPair(MalVal a) { return a is MalSeq && !(a as MalSeq).isEmpty } } const class MalException : Err { const Str serializedValue new make(MalVal v) : super.make("Mal exception") { serializedValue = v.toString(true) } MalVal getValue() { return Reader.read_str(serializedValue) } } ================================================ FILE: impls/fantom/src/step0_repl/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step0_repl" summary = "mal step0_repl pod" depends = ["sys 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step0_repl/fan/main.fan ================================================ class Main { static Str READ(Str s) { return s } static Str EVAL(Str ast, Str env) { return ast } static Str PRINT(Str exp) { return exp } static Str REP(Str s, Str env) { return PRINT(EVAL(READ(s), env)) } static Void main() { while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue echo(REP(line, "")) } } } ================================================ FILE: impls/fantom/src/step1_read_print/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step1_read_print" summary = "mal step1_read_print pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step1_read_print/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static MalVal EVAL(MalVal ast, Str env) { return ast } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, Str env) { return PRINT(EVAL(READ(s), env)) } static Void main() { while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, "")) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step2_eval/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step2_eval" summary = "mal step2_eval pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step2_eval/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static MalVal EVAL(MalVal ast, Str:MalVal env) { switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env[varName] ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } malfunc := f as MalFunc return malfunc.call(args) default: return ast } } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, Str:MalVal env) { return PRINT(EVAL(READ(s), env)) } static Void main() { repl_env := [ "+": MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }, "-": MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }, "*": MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }, "/": MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) } ] while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step3_env/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step3_env" summary = "mal step3_env pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step3_env/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) return EVAL(astList[2], let_env) default: f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } malfunc := f as MalFunc return malfunc.call(args) } default: return ast } } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main() { repl_env := MalEnv() repl_env.set(MalSymbol("+"), MalFunc { MalInteger((it[0] as MalInteger).value + (it[1] as MalInteger).value) }) repl_env.set(MalSymbol("-"), MalFunc { MalInteger((it[0] as MalInteger).value - (it[1] as MalInteger).value) }) repl_env.set(MalSymbol("*"), MalFunc { MalInteger((it[0] as MalInteger).value * (it[1] as MalInteger).value) }) repl_env.set(MalSymbol("/"), MalFunc { MalInteger((it[0] as MalInteger).value / (it[1] as MalInteger).value) }) while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step4_if_fn_do/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step4_if_fn_do" summary = "mal step4_if_fn_do pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step4_if_fn_do/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) return EVAL(astList[2], let_env) case "do": for (i:=1; i 3 ? EVAL(astList[3], env) : MalNil.INSTANCE else return EVAL(astList[2], env) case "fn*": return MalFunc { EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(it))) } default: f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } switch (f.typeof) { case MalFunc#: malfunc := f as MalFunc return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main() { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step5_tco/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step5_tco" summary = "mal step5_tco pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step5_tco/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main() { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step6_file/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step6_file" summary = "mal step6_file pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step6_file/fan/main.fan ================================================ using mallib class Main { static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main(Str[] args) { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if (!args.isEmpty) { REP("(load-file \"${args[0]}\")", repl_env) return } while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step7_quote/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step7_quote" summary = "mal step7_quote pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step7_quote/fan/main.fan ================================================ 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) { switch (ast.typeof) { 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 } } static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "quote": return astList[1] case "quasiquote": ast = quasiquote(astList[1]) // TCO case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1].map |MalVal v -> MalVal| { EVAL(v, env) } switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main(Str[] args) { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if (!args.isEmpty) { REP("(load-file \"${args[0]}\")", repl_env) return } while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step8_macros/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step8_macros" summary = "mal step8_macros pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step8_macros/fan/main.fan ================================================ 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) { switch (ast.typeof) { 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 } } static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "quote": return astList[1] case "quasiquote": ast = quasiquote(astList[1]) // TCO case "defmacro!": f := (EVAL(astList[2], env) as MalUserFunc).dup f.isMacro = true return env.set(astList[1], f) case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1] switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc if (user_fn.isMacro) { ast = user_fn.call(args) continue // TCO } args = args.map |MalVal v -> MalVal| { EVAL(v, env) } ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc args = args.map |MalVal v -> MalVal| { EVAL(v, env) } return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main(Str[] args) { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (!args.isEmpty) { REP("(load-file \"${args[0]}\")", repl_env) return } while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/step9_try/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "step9_try" summary = "mal step9_try pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/step9_try/fan/main.fan ================================================ 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) { switch (ast.typeof) { 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 } } static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "quote": return astList[1] case "quasiquote": ast = quasiquote(astList[1]) // TCO case "defmacro!": f := (EVAL(astList[2], env) as MalUserFunc).dup f.isMacro = true return env.set(astList[1], f) case "try*": if (astList.count < 3) return EVAL(astList[1], env) MalVal exc := MalNil.INSTANCE try return EVAL(astList[1], env) catch (MalException e) exc = e.getValue catch (Err e) exc = MalString.make(e.msg) catchClause := astList[2] as MalList return EVAL(catchClause[2], MalEnv(env, MalList([catchClause[1]]), MalList([exc]))) case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1] switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc if (user_fn.isMacro) { ast = user_fn.call(args) continue // TCO } args = args.map |MalVal v -> MalVal| { EVAL(v, env) } ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc args = args.map |MalVal v -> MalVal| { EVAL(v, env) } return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main(Str[] args) { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (!args.isEmpty) { REP("(load-file \"${args[0]}\")", repl_env) return } while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (MalException e) echo("Error: ${e.serializedValue}") catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/src/stepA_mal/build.fan ================================================ class Build : build::BuildPod { new make() { podName = "stepA_mal" summary = "mal stepA_mal pod" depends = ["sys 1.0", "mallib 1.0"] srcDirs = [`fan/`] outPodDir = `lib/fan/` } } ================================================ FILE: impls/fantom/src/stepA_mal/fan/main.fan ================================================ 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) { switch (ast.typeof) { 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 } } static MalVal READ(Str s) { return Reader.read_str(s) } static Void debug_eval(MalVal ast, MalEnv env) { value := env.get("DEBUG-EVAL") if ((value != null) && !(value is MalFalseyVal)) echo("EVAL: ${PRINT(ast)}") } static MalVal EVAL(MalVal ast, MalEnv env) { while (true) { debug_eval(ast, env) switch (ast.typeof) { case MalSymbol#: varName := (ast as MalSymbol).value return env.get(varName) ?: throw Err("'$varName' not found") case MalVector#: newElements := (ast as MalVector).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalVector(newElements) case MalHashMap#: newElements := (ast as MalHashMap).value.map |MalVal v -> MalVal| { EVAL(v, env) } return MalHashMap.fromMap(newElements) case MalList#: astList := ast as MalList if (astList.isEmpty) return ast switch ((astList[0] as MalSymbol)?.value) { case "def!": value := EVAL(astList[2], env) return env.set(astList[1], value) case "let*": let_env := MalEnv(env) varList := astList[1] as MalSeq for (i := 0; i < varList.count; i += 2) let_env.set(varList[i], EVAL(varList[i + 1], let_env)) env = let_env ast = astList[2] // TCO case "quote": return astList[1] case "quasiquote": ast = quasiquote(astList[1]) // TCO case "defmacro!": f := (EVAL(astList[2], env) as MalUserFunc).dup f.isMacro = true return env.set(astList[1], f) case "try*": if (astList.count < 3) return EVAL(astList[1], env) MalVal exc := MalNil.INSTANCE try return EVAL(astList[1], env) catch (MalException e) exc = e.getValue catch (Err e) exc = MalString.make(e.msg) catchClause := astList[2] as MalList return EVAL(catchClause[2], MalEnv(env, MalList([catchClause[1]]), MalList([exc]))) case "do": for (i:=1; i 3 ? astList[3] : MalNil.INSTANCE else ast = astList[2] // TCO case "fn*": f := |MalVal[] a -> MalVal| { return EVAL(astList[2], MalEnv(env, (astList[1] as MalSeq), MalList(a))) } return MalUserFunc(astList[2], env, (MalSeq)astList[1], f) default: f := EVAL(astList[0], env) args := astList.value[1..-1] switch (f.typeof) { case MalUserFunc#: user_fn := f as MalUserFunc if (user_fn.isMacro) { ast = user_fn.call(args) continue // TCO } args = args.map |MalVal v -> MalVal| { EVAL(v, env) } ast = user_fn.ast env = user_fn.genEnv(MalList(args)) // TCO case MalFunc#: malfunc := f as MalFunc args = args.map |MalVal v -> MalVal| { EVAL(v, env) } return malfunc.call(args) default: throw Err("Unknown type") } } default: return ast } } return MalNil.INSTANCE // never reached } static Str PRINT(MalVal exp) { return exp.toString(true) } static Str REP(Str s, MalEnv env) { return PRINT(EVAL(READ(s), env)) } static Void main(Str[] args) { repl_env := MalEnv() // core.fan: defined using Fantom Core.ns.each |MalFunc V, Str K| { repl_env.set(MalSymbol(K), V) } repl_env.set(MalSymbol("eval"), MalFunc { EVAL(it[0], repl_env) }) repl_env.set(MalSymbol("*ARGV*"), MalList((args.isEmpty ? args : args[1..-1]).map { MalString.make(it) })) // core.mal: defined using the language itself REP("(def! *host-language* \"fantom\")", repl_env) REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (!args.isEmpty) { REP("(load-file \"${args[0]}\")", repl_env) return } REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) while (true) { line := Env.cur.prompt("user> ") if (line == null) break if (line.isSpace) continue try echo(REP(line, repl_env)) catch (MalException e) echo("Error: ${e.serializedValue}") catch (Err e) echo("Error: $e.msg") } } } ================================================ FILE: impls/fantom/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/fantom/tests/stepA_mal.mal ================================================ ;; Testing basic fantom interop (fantom-eval "7") ;=>7 (fantom-eval "return 3 * 9") ;=>27 (fantom-eval "\"7\"") ;=>"7" (fantom-eval "\"abcd\".upper") ;=>"ABCD" (fantom-eval "[7,8,9]") ;=>(7 8 9) (= () (fantom-eval "[,]")) ;=>true (fantom-eval "[\"abc\": 789]") ;=>{"abc" 789} (= {} (fantom-eval "[:]")) ;=>true (fantom-eval "echo(\"hello\")") ;/hello ;=>nil (fantom-eval "[\"a\",\"b\",\"c\"].join(\" \") { \"X${it}Y\" }") ;=>"XaY XbY XcY" (fantom-eval "[1,2,3].map { 1 + it }") ;=>(2 3 4) (fantom-eval "Env.cur.runtime") ;=>"java" ================================================ FILE: impls/fennel/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ENV DEBIAN_FRONTEND=noninteractive ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # fennel RUN apt-get -y install gcc wget unzip libpcre3-dev # lua RUN \ wget http://www.lua.org/ftp/lua-5.4.1.tar.gz && \ tar -zxf lua-5.4.1.tar.gz && \ cd lua-5.4.1 && \ make linux test && \ make install # luarocks RUN \ wget https://luarocks.org/releases/luarocks-3.3.1.tar.gz && \ tar zxpf luarocks-3.3.1.tar.gz && \ cd luarocks-3.3.1 && \ ./configure && \ make && \ make install # fennel, lpeg RUN luarocks install fennel RUN luarocks install lpeg # luarocks .cache directory is relative to HOME ENV HOME /mal ================================================ FILE: impls/fennel/Makefile ================================================ all: true ================================================ FILE: impls/fennel/core.fnl ================================================ (local t (require :types)) (local u (require :utils)) (local printer (require :printer)) (local reader (require :reader)) (local fennel (require :fennel)) (local mal-list (t.make-fn (fn [asts] (t.make-list asts)))) (local mal-list? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "list? takes 1 argument"))) (t.make-boolean (t.list?* (. asts 1)))))) (local mal-empty? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "empty? takes 1 argument"))) (let [arg-ast (. asts 1)] (if (t.nil?* arg-ast) t.mal-true (t.make-boolean (t.empty?* arg-ast))))))) (local mal-count (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "count takes 1 argument"))) (let [arg-ast (. asts 1)] (if (t.nil?* arg-ast) (t.make-number 0) (t.make-number (length (t.get-value arg-ast)))))))) (local mal-= (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "= takes 2 arguments"))) (let [ast-1 (. asts 1) ast-2 (. asts 2)] (if (t.equals?* ast-1 ast-2) t.mal-true t.mal-false))))) (local mal-pr-str (t.make-fn (fn [asts] (local buf []) (when (> (length asts) 0) (each [i ast (ipairs asts)] (table.insert buf (printer.pr_str ast true)) (table.insert buf " ")) ;; remove extra space at end (table.remove buf)) (t.make-string (table.concat buf))))) (local mal-str (t.make-fn (fn [asts] (local buf []) (when (> (length asts) 0) (each [i ast (ipairs asts)] (table.insert buf (printer.pr_str ast false)))) (t.make-string (table.concat buf))))) (local mal-prn (t.make-fn (fn [asts] (local buf []) (when (> (length asts) 0) (each [i ast (ipairs asts)] (table.insert buf (printer.pr_str ast true)) (table.insert buf " ")) ;; remove extra space at end (table.remove buf)) (print (table.concat buf)) t.mal-nil))) (local mal-println (t.make-fn (fn [asts] (local buf []) (when (> (length asts) 0) (each [i ast (ipairs asts)] (table.insert buf (printer.pr_str ast false)) (table.insert buf " ")) ;; remove extra space at end (table.remove buf)) (print (table.concat buf)) t.mal-nil))) (local mal-read-string (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "read-string takes 1 argument"))) (let [res (reader.read_str (t.get-value (. asts 1)))] (if res res (u.throw* (t.make-string "No code content"))))))) (local mal-slurp (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "slurp takes 1 argument"))) (let [a-str (t.get-value (. asts 1))] ;; XXX: error handling? (with-open [f (io.open a-str)] ;; XXX: escaping? (t.make-string (f:read "*a"))))))) (local mal-atom (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "atom takes 1 argument"))) (t.make-atom (. asts 1))))) (local mal-atom? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "atom? takes 1 argument"))) (if (t.atom?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-deref (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "deref takes 1 argument"))) (let [ast (. asts 1)] (t.deref* ast))))) (local mal-reset! (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "reset! takes 2 arguments"))) (let [atom-ast (. asts 1) val-ast (. asts 2)] (t.reset!* atom-ast val-ast))))) (local mal-swap! (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "swap! takes at least 2 arguments"))) (let [atom-ast (. asts 1) fn-ast (. asts 2) args-asts (u.slice asts 3 -1) args-tbl [(t.deref* atom-ast) (table.unpack args-asts)]] (t.reset!* atom-ast ((t.get-value fn-ast) args-tbl)))))) (local mal-cons (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "cons takes 2 arguments"))) (let [head-ast (. asts 1) tail-ast (. asts 2)] (t.make-list [head-ast (table.unpack (t.get-value tail-ast))]))))) (local mal-concat (t.make-fn (fn [asts] (local acc []) (for [i 1 (length asts)] (each [j elt (ipairs (t.get-value (. asts i)))] (table.insert acc elt))) (t.make-list acc)))) (local mal-vec (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "vec takes 1 argument"))) (let [ast (. asts 1)] (if (t.vector?* ast) ast ;; (t.list?* ast) (t.make-vector (t.get-value ast)) ;; (t.nil?* ast) (t.make-vector []) ;; (u.throw* (t.make-string "vec takes a vector, list, or nil"))))))) (local mal-nth (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "nth takes 2 arguments"))) (let [elts (t.get-value (. asts 1)) i (t.get-value (. asts 2))] (if (< i (length elts)) (. elts (+ i 1)) (u.throw* (t.make-string (.. "Index out of range: " i)))))))) (local mal-first (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "first takes 1 argument"))) (let [coll-or-nil-ast (. asts 1)] (if (or (t.nil?* coll-or-nil-ast) (t.empty?* coll-or-nil-ast)) t.mal-nil (. (t.get-value coll-or-nil-ast) 1)))))) (local mal-rest (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "rest takes 1 argument"))) (let [coll-or-nil-ast (. asts 1)] (if (or (t.nil?* coll-or-nil-ast) (t.empty?* coll-or-nil-ast)) (t.make-list []) (t.make-list (u.slice (t.get-value coll-or-nil-ast) 2 -1))))))) (local mal-throw (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "throw takes 1 argument"))) (u.throw* (. asts 1))))) ;; (apply F A B [C D]) is equivalent to (F A B C D) (local mal-apply (t.make-fn (fn [asts] (let [n-asts (length asts)] (when (< n-asts 1) (u.throw* (t.make-string "apply takes at least 1 argument"))) (let [the-fn (t.get-value (. asts 1))] ; e.g. F (if (= n-asts 1) (the-fn []) (= n-asts 2) (the-fn [(table.unpack (t.get-value (. asts 2)))]) (let [args-asts (u.slice asts 2 -2) ; e.g. [A B] last-asts (t.get-value (u.last asts)) ; e.g. [C D] fn-args-tbl []] (each [i elt (ipairs args-asts)] (table.insert fn-args-tbl elt)) (each [i elt (ipairs last-asts)] (table.insert fn-args-tbl elt)) (the-fn fn-args-tbl)))))))) (local mal-map (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "map takes at least 2 arguments"))) (let [the-fn (t.get-value (. asts 1)) coll (t.get-value (. asts 2))] (t.make-list (u.map #(the-fn [$]) coll)))))) (local mal-nil? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "nil? takes 1 argument"))) (if (t.nil?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-true? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "true? takes 1 argument"))) (if (t.true?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-false? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "false? takes 1 argument"))) (if (t.false?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-symbol? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "symbol? takes 1 argument"))) (if (t.symbol?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-symbol (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "symbol takes 1 argument"))) ;; XXX: check that type is string? (t.make-symbol (t.get-value (. asts 1)))))) (local mal-keyword (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "keyword takes 1 argument"))) (let [arg-ast (. asts 1)] (if (t.keyword?* arg-ast) arg-ast ;; (t.string?* arg-ast) (t.make-keyword (.. ":" (t.get-value arg-ast))) ;; (u.throw* (t.make-string "Expected string"))))))) (local mal-keyword? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "keyword? takes 1 argument"))) (if (t.keyword?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-vector (t.make-fn (fn [asts] (t.make-vector asts)))) (local mal-vector? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "vector? takes 1 argument"))) (if (t.vector?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-sequential? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "sequential? takes 1 argument"))) (if (or (t.list?* (. asts 1)) (t.vector?* (. asts 1))) t.mal-true t.mal-false)))) (local mal-map? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "map? takes 1 argument"))) (if (t.hash-map?* (. asts 1)) t.mal-true t.mal-false)))) (local mal-hash-map (t.make-fn (fn [asts] (when (= 1 (% (length asts) 2)) (u.throw* (t.make-string "hash-map takes an even number of arguments"))) (t.make-hash-map asts)))) (local mal-assoc (t.make-fn (fn [asts] (when (< (length asts) 3) (u.throw* (t.make-string "assoc takes at least 3 arguments"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "assoc first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [item-tbl [] kv-asts (u.slice asts 2 -1) hash-items (t.get-value head-ast)] (for [i 1 (/ (length hash-items) 2)] (let [key (. hash-items (- (* 2 i) 1))] (var idx 1) (var found false) (while (and (not found) (<= idx (length kv-asts))) (if (t.equals?* key (. kv-asts idx)) (set found true) (set idx (+ idx 2)))) (if (not found) (do (table.insert item-tbl key) (table.insert item-tbl (. hash-items (* 2 i)))) (do (table.insert item-tbl key) (table.insert item-tbl (. kv-asts (+ idx 1))) (table.remove kv-asts (+ idx 1)) (table.remove kv-asts idx))))) (each [i elt (ipairs kv-asts)] (table.insert item-tbl elt)) (t.make-hash-map item-tbl))))))) (local mal-dissoc (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "dissoc takes at least 2 arguments"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "dissoc first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [item-tbl [] key-asts (u.slice asts 2 -1) hash-items (t.get-value head-ast)] (for [i 1 (/ (length hash-items) 2)] (let [key (. hash-items (- (* 2 i) 1))] (var idx 1) (var found false) (while (and (not found) (<= idx (length key-asts))) (if (t.equals?* key (. key-asts idx)) (set found true) (set idx (+ idx 1)))) (when (not found) (table.insert item-tbl key) (table.insert item-tbl (. hash-items (* 2 i)))))) (t.make-hash-map item-tbl))))))) (local mal-get (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "get takes 2 arguments"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "get first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [hash-items (t.get-value head-ast) key-ast (. asts 2)] (var idx 1) (var found false) (while (and (not found) (<= idx (length hash-items))) (if (t.equals?* key-ast (. hash-items idx)) (set found true) (set idx (+ idx 1)))) (if found (. hash-items (+ idx 1)) t.mal-nil))))))) (local mal-contains? (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "contains? takes 2 arguments"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "contains? first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [hash-items (t.get-value head-ast) key-ast (. asts 2)] (var idx 1) (var found false) (while (and (not found) (<= idx (length hash-items))) (if (t.equals?* key-ast (. hash-items idx)) (set found true) (set idx (+ idx 1)))) (if found t.mal-true t.mal-false))))))) (local mal-keys (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "keys takes 1 argument"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "keys first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [item-tbl [] hash-items (t.get-value head-ast)] (for [i 1 (/ (length hash-items) 2)] (let [key (. hash-items (- (* 2 i) 1))] (table.insert item-tbl key))) (t.make-list item-tbl))))))) (local mal-vals (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "vals takes 1 argument"))) (let [head-ast (. asts 1)] (when (not (or (t.hash-map?* head-ast) (t.nil?* head-ast))) (u.throw* (t.make-string "vals first argument should be a hash-map or nil"))) (if (t.nil?* head-ast) t.mal-nil (let [item-tbl [] hash-items (t.get-value head-ast)] (for [i 1 (/ (length hash-items) 2)] (let [value (. hash-items (* 2 i))] (table.insert item-tbl value))) (t.make-list item-tbl))))))) (local mal-readline (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "vals takes 1 argument"))) (let [prompt (t.get-value (. asts 1))] (io.write prompt) (io.flush) (let [input (io.read) trimmed (string.match input "^%s*(.-)%s*$")] (if (> (length trimmed) 0) (t.make-string trimmed) t.mal-nil)))))) (local mal-meta (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "meta takes 1 argument"))) (let [head-ast (. asts 1)] (if (or (t.list?* head-ast) (t.vector?* head-ast) (t.hash-map?* head-ast) (t.fn?* head-ast)) (t.get-md head-ast) t.mal-nil))))) (local mal-with-meta (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "with-meta takes 2 arguments"))) (let [target-ast (. asts 1) meta-ast (. asts 2)] (if (t.list?* target-ast) (t.make-list (t.get-value target-ast) meta-ast) ;; (t.vector?* target-ast) (t.make-vector (t.get-value target-ast) meta-ast) ;; (t.hash-map?* target-ast) (t.make-hash-map (t.get-value target-ast) meta-ast) ;; (t.fn?* target-ast) (t.clone-with-meta target-ast meta-ast) ;; (u.throw* (t.make-string "Expected list, vector, hash-map, or fn"))))))) (local mal-string? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "string? takes 1 argument"))) (t.make-boolean (t.string?* (. asts 1)))))) (local mal-number? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "number? takes 1 argument"))) (t.make-boolean (t.number?* (. asts 1)))))) (local mal-fn? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "fn? takes 1 argument"))) (let [target-ast (. asts 1)] (if (and (t.fn?* target-ast) (not (t.get-is-macro target-ast))) t.mal-true t.mal-false))))) (local mal-macro? (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "macro? requires 1 argument"))) (let [the-ast (. asts 1)] (if (t.macro?* the-ast) t.mal-true t.mal-false))))) (local mal-conj (t.make-fn (fn [asts] (when (< (length asts) 2) (u.throw* (t.make-string "conj takes at least 2 arguments"))) (let [coll-ast (. asts 1) item-asts (u.slice asts 2 -1)] (if (t.nil?* coll-ast) (t.make-list (u.reverse item-asts)) ;; (t.list?* coll-ast) (t.make-list (u.concat-two (u.reverse item-asts) (t.get-value coll-ast))) ;; (t.vector?* coll-ast) (t.make-vector (u.concat-two (t.get-value coll-ast) item-asts)) ;; (u.throw* (t.make-string "Expected list, vector, or nil"))))))) (local mal-seq (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "seq takes 1 argument"))) (let [arg-ast (. asts 1)] (if (t.list?* arg-ast) (if (t.empty?* arg-ast) t.mal-nil arg-ast) ;; (t.vector?* arg-ast) (if (t.empty?* arg-ast) t.mal-nil (t.make-list (t.get-value arg-ast))) ;; (t.string?* arg-ast) (let [a-str (t.get-value arg-ast) str-len (length a-str)] (if (= str-len 0) t.mal-nil (do (local str-tbl []) (for [i 1 (length a-str)] (table.insert str-tbl (t.make-string (string.sub a-str i i)))) (t.make-list str-tbl)))) ;; (t.nil?* arg-ast) arg-ast ;; (u.throw* (t.make-string "Expected list, vector, string, or nil"))))))) (local mal-time-ms (t.make-fn (fn [asts] (t.make-number (math.floor (* 1000000 (os.clock))))))) (fn fennel-eval* [fennel-val] (if (= "nil" (type fennel-val)) t.mal-nil (= "boolean" (type fennel-val)) (t.make-boolean fennel-val) (= "string" (type fennel-val)) (t.make-string fennel-val) (= "number" (type fennel-val)) (t.make-number fennel-val) (= "table" (type fennel-val)) (t.make-list (u.map fennel-eval* fennel-val)) (u.throw* (t.make-string (.. "Unsupported type: " (type fennel-val)))))) (local mal-fennel-eval (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "fennel-eval takes 1 argument"))) (let [head-ast (. asts 1)] (when (not (t.string?* head-ast)) (u.throw* (t.make-string "fennel-eval first argument should be a string"))) (let [(ok? result) (pcall fennel.eval (t.get-value head-ast))] (if ok? (fennel-eval* result) (u.throw* (t.make-string (.. "Eval failed: " result))))))))) {"+" (t.make-fn (fn [asts] (var total 0) (each [i val (ipairs asts)] (set total (+ total (t.get-value val)))) (t.make-number total))) "-" (t.make-fn (fn [asts] (var total 0) (let [n-args (length asts)] (if (= 0 n-args) (t.make-number 0) (= 1 n-args) (t.make-number (- 0 (t.get-value (. asts 1)))) (do (set total (t.get-value (. asts 1))) (for [idx 2 n-args] (let [cur (t.get-value (. asts idx))] (set total (- total cur)))) (t.make-number total)))))) "*" (t.make-fn (fn [asts] (var total 1) (each [i val (ipairs asts)] (set total (* total (t.get-value val)))) (t.make-number total))) "/" (t.make-fn (fn [asts] (var total 1) (let [n-args (length asts)] (if (= 0 n-args) (t.make-number 1) (= 1 n-args) (t.make-number (/ 1 (t.get-value (. asts 1)))) (do (set total (t.get-value (. asts 1))) (for [idx 2 n-args] (let [cur (t.get-value (. asts idx))] (set total (/ total cur)))) (t.make-number total)))))) "list" mal-list "list?" mal-list? "empty?" mal-empty? "count" mal-count "=" mal-= "<" (t.make-fn (fn [asts] (let [val-1 (t.get-value (. asts 1)) val-2 (t.get-value (. asts 2))] (t.make-boolean (< val-1 val-2))))) "<=" (t.make-fn (fn [asts] (let [val-1 (t.get-value (. asts 1)) val-2 (t.get-value (. asts 2))] (t.make-boolean (<= val-1 val-2))))) ">" (t.make-fn (fn [asts] (let [val-1 (t.get-value (. asts 1)) val-2 (t.get-value (. asts 2))] (t.make-boolean (> val-1 val-2))))) ">=" (t.make-fn (fn [asts] (let [val-1 (t.get-value (. asts 1)) val-2 (t.get-value (. asts 2))] (t.make-boolean (>= val-1 val-2))))) "pr-str" mal-pr-str "str" mal-str "prn" mal-prn "println" mal-println "read-string" mal-read-string "slurp" mal-slurp "atom" mal-atom "atom?" mal-atom? "deref" mal-deref "reset!" mal-reset! "swap!" mal-swap! "cons" mal-cons "concat" mal-concat "vec" mal-vec "nth" mal-nth "first" mal-first "rest" mal-rest "throw" mal-throw "apply" mal-apply "map" mal-map "nil?" mal-nil? "true?" mal-true? "false?" mal-false? "symbol?" mal-symbol? "symbol" mal-symbol "keyword" mal-keyword "keyword?" mal-keyword? "vector" mal-vector "vector?" mal-vector? "sequential?" mal-sequential? "map?" mal-map? "hash-map" mal-hash-map "assoc" mal-assoc "dissoc" mal-dissoc "get" mal-get "contains?" mal-contains? "keys" mal-keys "vals" mal-vals "readline" mal-readline "meta" mal-meta "with-meta" mal-with-meta "string?" mal-string? "number?" mal-number? "fn?" mal-fn? "macro?" mal-macro? "conj" mal-conj "seq" mal-seq "time-ms" mal-time-ms "fennel-eval" mal-fennel-eval } ================================================ FILE: impls/fennel/env.fnl ================================================ (local t (require :types)) (local u (require :utils)) (fn make-env [outer binds exprs] (local tbl {}) (when binds (local n-binds (length binds)) (var found-amp false) (var i 1) (while (and (not found-amp) (<= i n-binds)) (local c-bind (. binds i)) (if (= (t.get-value c-bind) "&") (set found-amp true) (set i (+ i 1)))) (if (not found-amp) (for [j 1 n-binds] (tset tbl (t.get-value (. binds j)) (. exprs j))) (do ; houston, there was an ampersand (for [j 1 (- i 1)] ; things before & (tset tbl (t.get-value (. binds j)) (. exprs j))) (tset tbl ; after &, put things in a list (t.get-value (. binds (+ i 1))) (t.make-list (u.slice exprs i -1)))))) {:outer outer :data tbl}) (fn env-set [env sym-ast val-ast] (tset (. env :data) (t.get-value sym-ast) val-ast) env) (fn env-get [env key] (or (. env :data key) (let [outer (. env :outer)] (when outer (env-get outer key))))) (comment (local test-env (make-env {})) (env-set test-env (t.make-symbol "fun") (t.make-number 1)) (env-get test-env (t.make-symbol "fun")) (local test-env-2 (make-env nil)) (env-set test-env-2 (t.make-symbol "smile") (t.make-keyword ":yay")) (env-get test-env-2 (t.make-symbol "smile")) (local test-env-3 (make-env nil)) (env-set test-env-3 (t.make-symbol "+") (fn [ast-1 ast-2] (t.make-number (+ (t.get-value ast-1) (t.get-value ast-2))))) (env-get test-env-3 (t.make-symbol "+")) ) {:make-env make-env :env-set env-set :env-get env-get} ================================================ FILE: impls/fennel/printer.fnl ================================================ (local t (require :types)) (fn escape [a-str] (pick-values 1 (-> a-str (string.gsub "\\" "\\\\") (string.gsub "\"" "\\\"") (string.gsub "\n" "\\n")))) (fn code* [ast buf print_readably] (let [value (t.get-value ast)] (if (t.nil?* ast) (table.insert buf value) ;; (t.boolean?* ast) (table.insert buf (if value "true" "false")) ;; (t.number?* ast) (table.insert buf (tostring value)) ;; (t.keyword?* ast) (table.insert buf value) ;; (t.symbol?* ast) (table.insert buf value) ;; (t.string?* ast) (if print_readably (do (table.insert buf "\"") (table.insert buf (escape value)) (table.insert buf "\"")) (table.insert buf value)) ;; (t.list?* ast) (do (table.insert buf "(") (var remove false) (each [idx elt (ipairs value)] (code* elt buf print_readably) (table.insert buf " ") (set remove true)) (when remove (table.remove buf)) (table.insert buf ")")) ;; (t.vector?* ast) (do (table.insert buf "[") (var remove false) (each [idx elt (ipairs value)] (code* elt buf print_readably) (table.insert buf " ") (set remove true)) (when remove (table.remove buf)) (table.insert buf "]")) ;; (t.hash-map?* ast) (do (table.insert buf "{") (var remove false) (each [idx elt (ipairs value)] (code* elt buf print_readably) (table.insert buf " ") (set remove true)) (when remove (table.remove buf)) (table.insert buf "}")) ;; (t.atom?* ast) (do (table.insert buf "(atom ") (code* (t.get-value ast) buf print_readably) (table.insert buf ")"))) buf)) (fn pr_str [ast print_readably] (let [buf []] (code* ast buf print_readably) (table.concat buf))) (comment (pr_str (t.make-number 1) false) ) {:pr_str pr_str} ================================================ FILE: impls/fennel/reader.fnl ================================================ (local t (require :types)) (local u (require :utils)) (local lpeg (require :lpeg)) (local P lpeg.P) (local S lpeg.S) (local C lpeg.C) (local V lpeg.V) (local Cmt lpeg.Cmt) (fn unescape [a-str] (pick-values 1 (-> a-str (string.gsub "\\\\" "\u{029e}") ;; temporarily hide (string.gsub "\\\"" "\"") (string.gsub "\\n" "\n") (string.gsub "\u{029e}" "\\")))) ;; now replace (local grammar {1 "main" "main" (^ (V "input") 1) "input" (+ (V "gap") (V "form")) "gap" (+ (V "ws") (V "comment")) "ws" (^ (S " \f\n\r\t,") 1) "comment" (* ";" (^ (- (P 1) (S "\r\n")) 0)) "form" (+ (V "boolean") (V "nil") (V "number") (V "keyword") (V "symbol") (V "string") (V "list") (V "vector") (V "hash-map") (V "deref") (V "quasiquote") (V "quote") (V "splice-unquote") (V "unquote") (V "with-meta")) "name-char" (- (P 1) (S " \f\n\r\t,[]{}()'`~^@\";")) "nil" (Cmt (C (* (P "nil") (- (V "name-char")))) (fn [s i a] (values i t.mal-nil))) "boolean" (Cmt (C (* (+ (P "false") (P "true")) (- (V "name-char")))) (fn [s i a] (values i (if (= a "true") t.mal-true t.mal-false)))) "number" (Cmt (C (^ (- (P 1) (S " \f\n\r\t,[]{}()'`~^@\";")) 1)) (fn [s i a] (let [result (tonumber a)] (if result (values i (t.make-number result)) nil)))) "keyword" (Cmt (C (* ":" (^ (V "name-char") 0))) (fn [s i a] (values i (t.make-keyword a)))) "symbol" (Cmt (^ (V "name-char") 1) (fn [s i a] (values i (t.make-symbol a)))) "string" (* (P "\"") (Cmt (C (* (^ (- (P 1) (S "\"\\")) 0) (^ (* (P "\\") (P 1) (^ (- (P 1) (S "\"\\")) 0)) 0))) (fn [s i a] (values i (t.make-string (unescape a))))) (+ (P "\"") (P (fn [s i] (error "unbalanced \""))))) "list" (* (P "(") (Cmt (C (^ (V "input") 0)) (fn [s i a ...] (values i (t.make-list [...])))) (+ (P ")") (P (fn [s i] (error "unbalanced )"))))) "vector" (* (P "[") (Cmt (C (^ (V "input") 0)) (fn [s i a ...] (values i (t.make-vector [...])))) (+ (P "]") (P (fn [s i] (error "unbalanced ]"))))) "hash-map" (* (P "{") (Cmt (C (^ (V "input") 0)) (fn [s i a ...] (values i (t.make-hash-map [...])))) (+ (P "}") (P (fn [s i] (error "unbalanced }"))))) "deref" (Cmt (C (* (P "@") (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "deref")]] (table.insert content (. [...] 2)) (values i (t.make-list content))))) "quasiquote" (Cmt (C (* (P "`") (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "quasiquote")]] (table.insert content (. [...] 2)) (values i (t.make-list content))))) "quote" (Cmt (C (* (P "'") (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "quote")]] (table.insert content (. [...] 2)) (values i (t.make-list content))))) "splice-unquote" (Cmt (C (* (P "~@") (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "splice-unquote")]] (table.insert content (. [...] 2)) (values i (t.make-list content))))) "unquote" (Cmt (C (* (P "~") (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "unquote")]] (table.insert content (. [...] 2)) (values i (t.make-list content))))) "with-meta" (Cmt (C (* (P "^") (V "form") (^ (V "gap") 1) (V "form"))) (fn [s i ...] (let [content [(t.make-symbol "with-meta")]] (table.insert content (. [...] 3)) (table.insert content (. [...] 2)) (values i (t.make-list content))))) }) (comment (lpeg.match grammar "; hello") (lpeg.match grammar "nil") (lpeg.match grammar "true") (lpeg.match grammar "false") (lpeg.match grammar "1.2") (lpeg.match grammar "(+ 1 1)") (lpeg.match grammar "[:a :b :c]") (lpeg.match grammar "\"hello there\"") (lpeg.match grammar "\"hello\" there\"") ) (fn read_str [a-str] (let [(ok? result) (pcall lpeg.match grammar a-str)] (if ok? (let [res-type (type result)] (if (= res-type "table") result (u.throw* t.mal-nil))) (u.throw* (t.make-string result))))) (comment (read_str "; hello") (read_str "nil") (read_str "true") (read_str "false") (read_str "1.2") (read_str "(+ 1 1)") (read_str "[:a :b :c]") (read_str "\"hello there\"") (read_str "\"hello\" there\"") ) {:read_str read_str} ================================================ FILE: impls/fennel/run ================================================ #!/usr/bin/env bash exec fennel $(dirname $0)/${STEP:-stepA_mal}.fnl "${@}" ================================================ FILE: impls/fennel/step0_repl.fnl ================================================ (fn READ [code-str] code-str) (fn EVAL [ast] ast) (fn PRINT [ast] ast) (fn rep [code-str] (PRINT (EVAL (READ code-str)))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (print (rep input))))) ================================================ FILE: impls/fennel/step1_read_print.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (fn READ [code-str] (reader.read_str code-str)) (fn EVAL [ast] ast) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))) ================================================ FILE: impls/fennel/step2_eval.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local u (require :utils)) (local repl_env {"+" (fn [ast-1 ast-2] (t.make-number (+ (t.get-value ast-1) (t.get-value ast-2)))) "-" (fn [ast-1 ast-2] (t.make-number (- (t.get-value ast-1) (t.get-value ast-2)))) "*" (fn [ast-1 ast-2] (t.make-number (* (t.get-value ast-1) (t.get-value ast-2)))) "/" (fn [ast-1 ast-2] (t.make-number (/ (t.get-value ast-1) (t.get-value ast-2))))}) (fn READ [code-str] (reader.read_str code-str)) (fn EVAL [ast env] ;; (print (.. "EVAL: " (printer.pr_str ast true))) (if (t.symbol?* ast) (. env (t.get-value ast)) ;; (t.vector?* ast) (t.make-vector (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (t.hash-map?* ast) (t.make-hash-map (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; (let [eval-list (u.map (fn [x] (EVAL x env)) (t.get-value ast)) f (u.first eval-list) args (u.slice eval-list 2 -1)] (f (table.unpack args))))) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))) ================================================ FILE: impls/fennel/step3_env.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local u (require :utils)) (local repl_env (-> (e.make-env nil) (e.env-set (t.make-symbol "+") (fn [ast-1 ast-2] (t.make-number (+ (t.get-value ast-1) (t.get-value ast-2))))) (e.env-set (t.make-symbol "-") (fn [ast-1 ast-2] (t.make-number (- (t.get-value ast-1) (t.get-value ast-2))))) (e.env-set (t.make-symbol "*") (fn [ast-1 ast-2] (t.make-number (* (t.get-value ast-1) (t.get-value ast-2))))) (e.env-set (t.make-symbol "/") (fn [ast-1 ast-2] (t.make-number (/ (t.get-value ast-1) (t.get-value ast-2))))))) (fn READ [arg] (reader.read_str arg)) (fn EVAL [ast env] (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found"))))) ;; (t.vector?* ast) (t.make-vector (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (t.hash-map?* ast) (t.make-hash-map (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but that screws up logic below (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) def-val) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) (EVAL (. ast-elts 3) new-env)) ;; (let [eval-list (u.map (fn [x] (EVAL x env)) ast-elts) f (. eval-list 1) args (u.slice eval-list 2 -1)] (f (table.unpack args))))))) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))) ================================================ FILE: impls/fennel/step4_if_fn_do.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn EVAL [ast env] (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found"))))) ;; (t.vector?* ast) (t.make-vector (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (t.hash-map?* ast) (t.make-hash-map (u.map (fn [elt-ast] (EVAL elt-ast env)) (t.get-value ast))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) ast ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but that screws up logic below (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) def-val) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) (EVAL (. ast-elts 3) new-env)) ;; (= "do" head-name) (u.last (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1))) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) t.mal-nil (EVAL else-ast env))) (EVAL (. ast-elts 3) env))) ;; (= "fn*" head-name) (let [args (t.get-value (. ast-elts 2)) body (. ast-elts 3)] (t.make-fn (fn [params] (EVAL body (e.make-env env args params))))) ;; (let [eval-list (u.map (fn [x] (EVAL x env)) ast-elts) f (. eval-list 1) args (u.slice eval-list 2 -1)] ((t.get-value f) args)))))) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))) ;; (fn [exc] ;; (if (t.nil?* exc) ;; (print) ;; (= "string" (type exc)) ;; (print exc) ;; (print (PRINT exc)))))))) ================================================ FILE: impls/fennel/step5_tco.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but that screws up logic below (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env))) ;; (let [f (EVAL (. ast-elts 1) env) args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))) ================================================ FILE: impls/fennel/step6_file.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but that screws up logic below (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env))) ;; (let [f (EVAL (. ast-elts 1) env) args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e.env-set repl_env (t.make-symbol "eval") (t.make-fn (fn [asts] (when (< (length asts) 1) ;; XXX (error "eval takes 1 arguments")) (EVAL (u.first asts) repl_env)))) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (e.env-set repl_env (t.make-symbol "*ARGV*") (t.make-list (u.map t.make-string (u.slice arg 2)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (if (<= 1 (length arg)) (xpcall (fn [] (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? handle-error) (do (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))))) ; (fn [exc] ;; (if (t.nil?* exc) ;; (print) ;; (= "string" (type exc)) ;; (print exc) ;; (print (PRINT exc)))))))))) ================================================ FILE: impls/fennel/step7_quote.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn starts-with [ast name] (when (and (t.list?* ast) (not (t.empty?* ast))) (let [head-ast (. (t.get-value ast) 1)] (and (t.symbol?* head-ast) (= name (t.get-value head-ast)))))) (var quasiquote* nil) (fn qq-iter [ast] (if (t.empty?* ast) (t.make-list []) (let [ast-value (t.get-value ast) elt (. ast-value 1) acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] (if (starts-with elt "splice-unquote") (t.make-list [(t.make-symbol "concat") (. (t.get-value elt) 2) acc]) (t.make-list [(t.make-symbol "cons") (quasiquote* elt) acc]))))) (set quasiquote* (fn [ast] (if (starts-with ast "unquote") (. (t.get-value ast) 2) ;; (t.list?* ast) (qq-iter ast) ;; (t.vector?* ast) (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) ;; (or (t.symbol?* ast) (t.hash-map?* ast)) (t.make-list [(t.make-symbol "quote") ast]) ;; ast))) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but that screws up logic below (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "quote" head-name) ;; tco (set result (. ast-elts 2)) ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env))) ;; (let [f (EVAL (. ast-elts 1) env) args (u.map (fn [x] (EVAL x env)) (u.slice ast-elts 2 -1)) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e.env-set repl_env (t.make-symbol "eval") (t.make-fn (fn [asts] (when (< (length asts) 1) ;; XXX (error "eval takes 1 arguments")) (EVAL (u.first asts) repl_env)))) (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (e.env-set repl_env (t.make-symbol "*ARGV*") (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (if (<= 1 (length arg)) (xpcall (fn [] (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? handle-error) (do (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))))) ================================================ FILE: impls/fennel/step8_macros.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn starts-with [ast name] (when (and (t.list?* ast) (not (t.empty?* ast))) (let [head-ast (. (t.get-value ast) 1)] (and (t.symbol?* head-ast) (= name (t.get-value head-ast)))))) (var quasiquote* nil) (fn qq-iter [ast] (if (t.empty?* ast) (t.make-list []) (let [ast-value (t.get-value ast) elt (. ast-value 1) acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] (if (starts-with elt "splice-unquote") (t.make-list [(t.make-symbol "concat") (. (t.get-value elt) 2) acc]) (t.make-list [(t.make-symbol "cons") (quasiquote* elt) acc]))))) (set quasiquote* (fn [ast] (if (starts-with ast "unquote") (. (t.get-value ast) 2) ;; (t.list?* ast) (qq-iter ast) ;; (t.vector?* ast) (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) ;; (or (t.symbol?* ast) (t.hash-map?* ast)) (t.make-list [(t.make-symbol "quote") ast]) ;; ast))) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but... (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "defmacro!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env) macro-ast (t.macrofy def-val)] (e.env-set env def-name macro-ast) (set result macro-ast)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "quote" head-name) ;; tco (set result (. ast-elts 2)) ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env false))) ;; (let [f (EVAL (. ast-elts 1) env) ast-rest (u.slice ast-elts 2 -1)] (if (t.macro?* f) (set ast ((t.get-value f) ast-rest)) (let [args (u.map (fn [x] (EVAL x env)) ast-rest) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e.env-set repl_env (t.make-symbol "eval") (t.make-fn (fn [asts] (when (< (length asts) 1) ;; XXX (error "eval takes 1 arguments")) (EVAL (u.first asts) repl_env)))) (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)))))))")) (e.env-set repl_env (t.make-symbol "*ARGV*") (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (if (<= 1 (length arg)) (xpcall (fn [] (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? handle-error) (do (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))))) ================================================ FILE: impls/fennel/step9_try.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn starts-with [ast name] (when (and (t.list?* ast) (not (t.empty?* ast))) (let [head-ast (. (t.get-value ast) 1)] (and (t.symbol?* head-ast) (= name (t.get-value head-ast)))))) (var quasiquote* nil) (fn qq-iter [ast] (if (t.empty?* ast) (t.make-list []) (let [ast-value (t.get-value ast) elt (. ast-value 1) acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] (if (starts-with elt "splice-unquote") (t.make-list [(t.make-symbol "concat") (. (t.get-value elt) 2) acc]) (t.make-list [(t.make-symbol "cons") (quasiquote* elt) acc]))))) (set quasiquote* (fn [ast] (if (starts-with ast "unquote") (. (t.get-value ast) 2) ;; (t.list?* ast) (qq-iter ast) ;; (t.vector?* ast) (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) ;; (or (t.symbol?* ast) (t.hash-map?* ast)) (t.make-list [(t.make-symbol "quote") ast]) ;; ast))) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but... (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "defmacro!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env) macro-ast (t.macrofy def-val)] (e.env-set env def-name macro-ast) (set result macro-ast)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "quote" head-name) ;; tco (set result (. ast-elts 2)) ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) ;; (= "try*" head-name) (set result (let [(ok? res) (pcall EVAL (. ast-elts 2) env)] (if (not ok?) (let [maybe-catch-ast (. ast-elts 3)] (if (not maybe-catch-ast) (u.throw* res) (if (not (starts-with maybe-catch-ast "catch*")) (u.throw* (t.make-string "Expected catch* form")) (let [catch-asts (t.get-value maybe-catch-ast)] (if (< (length catch-asts) 2) (u.throw* (t.make-string (.. "catch* requires at " "least 2 " "arguments"))) (let [catch-sym-ast (. catch-asts 2) catch-body-ast (. catch-asts 3)] (EVAL catch-body-ast (e.make-env env [catch-sym-ast] [res])))))))) res))) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env false))) ;; (let [f (EVAL (. ast-elts 1) env) ast-rest (u.slice ast-elts 2 -1)] (if (t.macro?* f) (set ast ((t.get-value f) ast-rest)) (let [args (u.map (fn [x] (EVAL x env)) ast-rest) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e.env-set repl_env (t.make-symbol "eval") (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "eval takes 1 argument"))) (EVAL (u.first asts) repl_env)))) (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)))))))")) (e.env-set repl_env (t.make-symbol "*ARGV*") (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (if (<= 1 (length arg)) (xpcall (fn [] (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? handle-error) (do (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))))) ================================================ FILE: impls/fennel/stepA_mal.fnl ================================================ (local printer (require :printer)) (local reader (require :reader)) (local t (require :types)) (local e (require :env)) (local core (require :core)) (local u (require :utils)) (local repl_env (let [env (e.make-env)] (each [name func (pairs core)] (e.env-set env (t.make-symbol name) func)) env)) (fn READ [code-str] (reader.read_str code-str)) (fn starts-with [ast name] (when (and (t.list?* ast) (not (t.empty?* ast))) (let [head-ast (. (t.get-value ast) 1)] (and (t.symbol?* head-ast) (= name (t.get-value head-ast)))))) (var quasiquote* nil) (fn qq-iter [ast] (if (t.empty?* ast) (t.make-list []) (let [ast-value (t.get-value ast) elt (. ast-value 1) acc (qq-iter (t.make-list (u.slice ast-value 2 -1)))] (if (starts-with elt "splice-unquote") (t.make-list [(t.make-symbol "concat") (. (t.get-value elt) 2) acc]) (t.make-list [(t.make-symbol "cons") (quasiquote* elt) acc]))))) (set quasiquote* (fn [ast] (if (starts-with ast "unquote") (. (t.get-value ast) 2) ;; (t.list?* ast) (qq-iter ast) ;; (t.vector?* ast) (t.make-list [(t.make-symbol "vec") (qq-iter ast)]) ;; (or (t.symbol?* ast) (t.hash-map?* ast)) (t.make-list [(t.make-symbol "quote") ast]) ;; ast))) (fn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) (let [dbgeval (e.env-get env "DEBUG-EVAL")] (when (and dbgeval (not (t.nil?* dbgeval)) (not (t.false?* dbgeval))) (print (.. "EVAL: " (printer.pr_str ast true))))) (if (t.symbol?* ast) (let [key (t.get-value ast)] (set result (or (e.env-get env key) (u.throw* (t.make-string (.. "'" key "' not found")))))) ;; (t.vector?* ast) (set result (t.make-vector (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (t.hash-map?* ast) (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) (t.get-value ast)))) ;; (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but... (if (= "def!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env)] (e.env-set env def-name def-val) (set result def-val)) ;; (= "defmacro!" head-name) (let [def-name (. ast-elts 2) def-val (EVAL (. ast-elts 3) env) macro-ast (t.macrofy def-val)] (e.env-set env def-name macro-ast) (set result macro-ast)) ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) stop (/ (length bindings) 2)] (for [idx 1 stop] (let [b-name (. bindings (- (* 2 idx) 1)) b-val (EVAL (. bindings (* 2 idx)) new-env)] (e.env-set new-env b-name b-val))) ;; tco (set ast (. ast-elts 3)) (set env new-env)) ;; (= "quote" head-name) ;; tco (set result (. ast-elts 2)) ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) ;; (= "try*" head-name) (set result (let [(ok? res) (pcall EVAL (. ast-elts 2) env)] (if (not ok?) (let [maybe-catch-ast (. ast-elts 3)] (if (not maybe-catch-ast) (u.throw* res) (if (not (starts-with maybe-catch-ast "catch*")) (u.throw* (t.make-string "Expected catch* form")) (let [catch-asts (t.get-value maybe-catch-ast)] (if (< (length catch-asts) 2) (u.throw* (t.make-string (.. "catch* requires at " "least 2 " "arguments"))) (let [catch-sym-ast (. catch-asts 2) catch-body-ast (. catch-asts 3)] (EVAL catch-body-ast (e.make-env env [catch-sym-ast] [res])))))))) res))) ;; (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; (= "if" head-name) (let [cond-res (EVAL (. ast-elts 2) env)] (if (or (t.nil?* cond-res) (t.false?* cond-res)) (let [else-ast (. ast-elts 4)] (if (not else-ast) ;; tco (set result t.mal-nil) (set ast else-ast))) ;; tco (set ast (. ast-elts 3)))) ;; (= "fn*" head-name) (let [params (t.get-value (. ast-elts 2)) body (. ast-elts 3)] ;; tco (set result (t.make-fn (fn [args] (EVAL body (e.make-env env params args))) body params env false nil))) ;; (let [f (EVAL (. ast-elts 1) env) ast-rest (u.slice ast-elts 2 -1)] (if (t.macro?* f) (set ast ((t.get-value f) ast-rest)) (let [args (u.map (fn [x] (EVAL x env)) ast-rest) body (t.get-ast f)] ;; tco (if body (do (set ast body) (set env (e.make-env (t.get-env f) (t.get-params f) args))) (set result ((t.get-value f) args)))))))))) result) (fn PRINT [ast] (printer.pr_str ast true)) (fn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e.env-set repl_env (t.make-symbol "eval") (t.make-fn (fn [asts] (when (< (length asts) 1) (u.throw* (t.make-string "eval takes 1 argument"))) (EVAL (u.first asts) repl_env)))) (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)))))))")) (e.env-set repl_env (t.make-symbol "*host-language*") (t.make-string "fennel")) (e.env-set repl_env (t.make-symbol "*ARGV*") (t.make-list (u.map t.make-string (u.slice arg 2 -1)))) (fn handle-error [err] (if (t.nil?* err) (print) (= "string" (type err)) (print err) (print (.. "Error: " (PRINT err))))) (if (<= 1 (length arg)) (xpcall (fn [] (rep (.. "(load-file \"" (. arg 1) "\")"))) ;; XXX: escaping? handle-error) (do (rep "(println (str \"Mal [\" *host-language* \"]\"))") (var done false) (while (not done) (io.write "user> ") (io.flush) (let [input (io.read)] (if (not input) (set done true) (xpcall (fn [] (print (rep input))) handle-error)))))) ================================================ FILE: impls/fennel/types.fnl ================================================ (fn make-nil [a-str] {:tag :nil :content "nil"}) (fn make-boolean [a-bool] {:tag :boolean :content a-bool}) (fn make-number [a-num] {:tag :number :content a-num}) (fn make-keyword [a-str] {:tag :keyword :content a-str}) (fn make-symbol [a-str] {:tag :symbol :content a-str}) (fn make-string [a-str] {:tag :string :content a-str}) (local mal-nil (make-nil)) (fn make-list [elts md] (local md (if md md mal-nil)) {:tag :list :content elts :md md}) (fn make-vector [elts md] (local md (if md md mal-nil)) {:tag :vector :content elts :md md}) (fn make-hash-map [elts md] (local md (if md md mal-nil)) {:tag :hash-map :content elts :md md}) (fn make-fn [a-fn ast params env is-macro md] (local is-macro (if is-macro is-macro false)) (local md (if md md mal-nil)) {:tag :fn :content a-fn :ast ast :params params :env env :is-macro is-macro :md md}) (fn make-atom [ast] {:tag :atom :content ast}) (local mal-true (make-boolean true)) (local mal-false (make-boolean false)) ;; (fn get-value [ast] (. ast :content)) (fn get-type [ast] (. ast :tag)) (fn get-md [ast] (. ast :md)) ;; (fn get-is-macro [ast] (. ast :is-macro)) (fn get-ast [ast] (. ast :ast)) (fn get-params [ast] (. ast :params)) (fn get-env [ast] (. ast :env)) ;; (fn nil?* [ast] (= :nil (. ast :tag))) (fn boolean?* [ast] (= :boolean (. ast :tag))) (fn number?* [ast] (= :number (. ast :tag))) (fn keyword?* [ast] (= :keyword (. ast :tag))) (fn symbol?* [ast] (= :symbol (. ast :tag))) (fn string?* [ast] (= :string (. ast :tag))) (fn list?* [ast] (= :list (. ast :tag))) (fn vector?* [ast] (= :vector (. ast :tag))) (fn hash-map?* [ast] (= :hash-map (. ast :tag))) (fn fn?* [ast] (= :fn (. ast :tag))) (fn atom?* [ast] (= :atom (. ast :tag))) (fn macro?* [ast] (and (fn?* ast) (get-is-macro ast))) ;; (fn macrofy [fn-ast] (local macro-ast {}) (each [k v (pairs fn-ast)] (tset macro-ast k v)) (tset macro-ast :is-macro true) macro-ast) (fn clone-with-meta [fn-ast meta-ast] (local new-fn-ast {}) (each [k v (pairs fn-ast)] (tset new-fn-ast k v)) (tset new-fn-ast :md meta-ast) new-fn-ast) ;; (fn set-atom-value! [atom-ast value-ast] (tset atom-ast :content value-ast)) (fn deref* [ast] (if (not (atom?* ast)) ;; XXX (error (.. "Expected atom, got: " (get-type ast))) (get-value ast))) (fn reset!* [atom-ast val-ast] (set-atom-value! atom-ast val-ast) val-ast) ;; (fn empty?* [ast] (when (or (list?* ast) (vector?* ast)) (= (length (get-value ast)) 0))) (fn true?* [ast] (and (boolean?* ast) (= true (get-value ast)))) (fn false?* [ast] (and (boolean?* ast) (= false (get-value ast)))) (fn equals?* [ast-1 ast-2] (let [type-1 (get-type ast-1) type-2 (get-type ast-2)] (if (and (not= type-1 type-2) ;; XXX: not elegant (not (and (list?* ast-1) (vector?* ast-2))) (not (and (list?* ast-2) (vector?* ast-1)))) false (let [val-1 (get-value ast-1) val-2 (get-value ast-2)] ;; XXX: when not a collection... (if (and (not (list?* ast-1)) (not (vector?* ast-1)) (not (hash-map?* ast-1))) (= val-1 val-2) (if (not= (length val-1) (length val-2)) false (if (and (not (hash-map?* ast-1)) (not (hash-map?* ast-2))) (do (var found-unequal false) (var idx 1) (while (and (not found-unequal) (<= idx (length val-1))) (let [v1 (. val-1 idx) v2 (. val-2 idx)] (when (not (equals?* v1 v2)) (set found-unequal true)) (set idx (+ idx 1)))) (not found-unequal)) (if (or (not (hash-map?* ast-1)) (not (hash-map?* ast-2))) false (do (var found-unequal false) (var idx-in-1 1) (while (and (not found-unequal) (<= idx-in-1 (length val-1))) (let [k1 (. val-1 idx-in-1)] (var found-in-2 false) (var idx-in-2 1) (while (and (not found-in-2) (<= idx-in-2 (length val-2))) (let [k2 (. val-2 idx-in-2)] (if (equals?* k1 k2) (set found-in-2 true) (set idx-in-2 (+ idx-in-2 2))))) (if (not found-in-2) (set found-unequal true) (let [v1 (. val-1 (+ idx-in-1 1)) v2 (. val-2 (+ idx-in-2 1))] (if (not (equals?* v1 v2)) (set found-unequal true) (set idx-in-1 (+ idx-in-1 2))))))) (not found-unequal)))))))))) { :make-nil make-nil :make-boolean make-boolean :make-number make-number :make-keyword make-keyword :make-symbol make-symbol :make-string make-string :make-list make-list :make-vector make-vector :make-hash-map make-hash-map :make-fn make-fn :make-atom make-atom ;; :mal-nil mal-nil :mal-true mal-true :mal-false mal-false ;; :get-value get-value :get-md get-md :get-is-macro get-is-macro :get-ast get-ast :get-params get-params :get-env get-env ;; :nil?* nil?* :boolean?* boolean?* :number?* number?* :keyword?* keyword?* :symbol?* symbol?* :string?* string?* :list?* list?* :vector?* vector?* :hash-map?* hash-map?* :fn?* fn?* :atom?* atom?* :macro?* macro?* ;; :macrofy macrofy :clone-with-meta clone-with-meta ;; :set-atom-value! set-atom-value! :deref* deref* :reset!* reset!* ;; :empty?* empty?* :true?* true?* :false?* false?* :equals?* equals?* } ================================================ FILE: impls/fennel/utils.fnl ================================================ (fn throw* [ast] (error ast)) (fn abs-index [i len] (if (> i 0) i (< i 0) (+ len i 1) nil)) (comment (abs-index 0 9) ;; => nil (abs-index 1 9) ;; => 1 (abs-index -1 9) ;; => 9 (abs-index -2 9) ;; => 8 ) (fn slice [tbl beg end] (local len-tbl (length tbl)) (local new-beg (if beg (abs-index beg len-tbl) 1)) (local new-end (if end (abs-index end len-tbl) len-tbl)) (local start (if (< new-beg 1) 1 new-beg)) (local fin (if (< len-tbl new-end) len-tbl new-end)) (local new-tbl []) (for [idx start fin] (tset new-tbl (+ (length new-tbl) 1) (. tbl idx))) new-tbl) (comment (slice [7 8 9] 2 -1) ;; => [8 9] (slice [1 2 3] 1 2) ;; => [1 2] ) (fn first [tbl] (. tbl 1)) (comment (first [7 8 9]) ;; => 7 ) (fn last [tbl] (. tbl (length tbl))) (comment (last [7 8 9]) ;; => 9 ) (fn map [a-fn tbl] (local new-tbl []) (each [i elt (ipairs tbl)] (tset new-tbl i (a-fn elt))) new-tbl) (comment (map (fn [x] (+ x 1)) [7 8 9]) ;; => [8 9 10] (map (fn [n] [n (+ n 1)]) [1 2 3]) ;; => [[1 2] [2 3] [3 4]] ) (fn reverse [tbl] (local new-tbl []) (for [i (length tbl) 1 -1] (table.insert new-tbl (. tbl i))) new-tbl) (comment (reverse [:a :b :c]) ;; => ["c" "b" "a"] ) (fn concat-two [tbl-1 tbl-2] (local new-tbl []) (each [i elt (ipairs tbl-1)] (table.insert new-tbl elt)) (each [i elt (ipairs tbl-2)] (table.insert new-tbl elt)) new-tbl) (comment (concat-two [:a :b :c] [:d :e :f]) ;; => ["a" "b" "c" "d" "e" "f"] (concat-two {1 :a 2 :b 3 :c} {1 :d 2 :e 3 :f}) ;; => ["a" "b" "c" "d" "e" "f"] ) { :throw* throw* :slice slice :first first :last last :map map :reverse reverse :concat-two concat-two } ================================================ FILE: impls/forth/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install gforth ================================================ FILE: impls/forth/Makefile ================================================ SOURCES_BASE = str.fs types.fs reader.fs printer.fs SOURCES_LISP = env.fs core.fs stepA_mal.fs SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.fs mal mal.fs: $(SOURCES) cat $+ | egrep -v "^require |^droprequire " > $@ mal: mal.fs echo "#! /usr/bin/env gforth" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.fs mal ================================================ FILE: impls/forth/core.fs ================================================ require env.fs 0 MalEnv. constant core : args-as-native { argv argc -- entry*argc... } argc 0 ?do argv i cells + @ as-native loop ; : defcore* ( sym xt ) MalNativeFn. core env/set ; : defcore parse-allot-name MalSymbol. ( xt ) ['] defcore* :noname ; defcore + args-as-native + MalInt. ;; defcore - args-as-native - MalInt. ;; defcore * args-as-native * MalInt. ;; defcore / args-as-native / MalInt. ;; defcore < args-as-native < mal-bool ;; defcore > args-as-native > mal-bool ;; defcore <= args-as-native <= mal-bool ;; defcore >= args-as-native >= mal-bool ;; defcore list { argv argc } argc cells allocate throw { start } argv start argc cells cmove start argc MalList. ;; defcore vector { argv argc } argc cells allocate throw { start } argv start argc cells cmove start argc MalList. MalVector new swap over MalVector/list ! ;; defcore empty? drop @ empty? ;; defcore count drop @ mal-count ;; defcore = drop dup @ swap cell+ @ swap m= mal-bool ;; : pr-str-multi ( readably? argv argc ) ?dup 0= if drop 0 0 else { argv argc } new-str argv @ pr-buf argc 1 ?do a-space argv i cells + @ pr-buf loop endif ; defcore prn true -rot pr-str-multi type cr drop mal-nil ;; defcore pr-str true -rot pr-str-multi MalString. nip ;; defcore println false -rot pr-str-multi type cr drop mal-nil ;; defcore str ( argv argc ) dup 0= if MalString. else { argv argc } false new-str argc 0 ?do argv i cells + @ pr-buf loop MalString. nip endif ;; defcore read-string drop @ unpack-str read-str ;; defcore slurp drop @ unpack-str slurp-file MalString. ;; create core-buff 128 allot defcore readline ( argv argc -- mal-string ) drop @ unpack-str type stdout flush-file drop core-buff 128 stdin read-line throw if core-buff swap MalString. else drop mal-nil endif ;; defcore cons ( argv[item,coll] argc ) drop dup @ swap cell+ @ ( item coll ) to-list conj ;; defcore concat { lists argc } MalList new lists over MalList/start ! 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 argv i cells + @ swap conj loop ;; defcore seq drop @ seq ;; defcore assoc { argv argc } argv @ ( coll ) argv argc cells + argv cell+ +do i @ \ key i cell+ @ \ val rot assoc 2 cells +loop ;; defcore keys ( argv argc ) drop @ MalMap/list @ dup MalList/start @ swap MalList/count @ { start count } here start count cells + start +do i @ , 2 cells +loop here>MalList ;; defcore vals ( argv argc ) drop @ MalMap/list @ dup MalList/start @ swap MalList/count @ { start count } here start count cells + start cell+ +do i @ , 2 cells +loop here>MalList ;; defcore dissoc { argv argc } argv @ \ coll argv argc cells + argv cell+ +do i @ swap dissoc cell +loop ;; defcore hash-map { argv argc } MalMap/Empty argc cells argv + argv +do i @ i cell+ @ rot assoc 2 cells +loop ;; defcore get { argv argc } argc 3 < if mal-nil else argv cell+ cell+ @ endif argv cell+ @ \ key argv @ \ coll get ;; defcore contains? { argv argc } 0 argv cell+ @ \ key argv @ \ coll get 0 <> mal-bool ;; defcore nth ( argv[coll,i] argc ) drop dup @ to-list ( argv list ) swap cell+ @ MalInt/int @ ( list i ) over MalList/count @ ( list i count ) 2dup >= if { i count } 0 0 new-str i int>str str-append s\" \040>= " count int>str s" nth out of bounds: " ...throw-str endif drop ( list i ) cells swap ( c-offset list ) MalList/start @ + @ ;; defcore first ( argv[coll] argc ) drop @ to-list dup MalList/count @ 0= if drop mal-nil else MalList/start @ @ endif ;; defcore rest ( argv[coll] argc ) drop @ to-list MalList/rest ;; defcore meta ( argv[obj] argc ) drop @ mal-meta @ ?dup 0= if mal-nil endif ;; defcore with-meta ( argv[obj,meta] argc ) drop ( argv ) dup cell+ @ swap @ ( meta obj ) dup mal-type @ MalTypeType-struct @ ( meta obj obj-size ) dup allocate throw { new-obj } ( meta obj obj-size ) new-obj swap cmove ( meta ) new-obj mal-meta ! ( ) new-obj ;; defcore atom ( argv[val] argc ) drop @ Atom. ;; defcore deref ( argv[atom] argc ) drop @ Atom/val @ ;; defcore reset! ( argv[atom,val] argc ) drop dup cell+ @ ( argv val ) dup -rot swap @ Atom/val ! ;; defcore apply { argv argc -- val } \ argv is (fn args... more-args) argv argc 1- cells + @ to-list { more-args } argc 2 - { list0len } more-args MalList/count @ list0len + { final-argc } final-argc cells allocate throw { final-argv } argv cell+ final-argv list0len cells cmove more-args MalList/start @ final-argv list0len cells + final-argc list0len - cells cmove final-argv final-argc argv @ invoke ;; defcore throw ( argv argc -- ) drop @ to exception-object 1 throw ;; defcore map? drop @ mal-type @ MalMap = mal-bool ;; defcore list? drop @ mal-type @ MalList = mal-bool ;; defcore vector? drop @ mal-type @ MalVector = mal-bool ;; defcore keyword? drop @ mal-type @ MalKeyword = mal-bool ;; defcore symbol? drop @ mal-type @ MalSymbol = mal-bool ;; defcore string? drop @ mal-type @ MalString = mal-bool ;; defcore atom? drop @ mal-type @ Atom = mal-bool ;; defcore true? drop @ mal-true = mal-bool ;; defcore false? drop @ mal-false = mal-bool ;; defcore nil? drop @ mal-nil = mal-bool ;; defcore number? drop @ mal-type @ MalInt = mal-bool ;; defcore fn? drop @ dup mal-type @ MalUserFn = if MalUserFn/is-macro? @ if mal-false else mal-true endif else mal-type @ MalNativeFn = if mal-true else mal-false endif endif ;; defcore macro? drop @ dup mal-type @ MalUserFn = swap MalUserFn/is-macro? @ and mal-bool ;; defcore sequential? drop @ sequential? ;; defcore keyword drop @ unpack-str MalKeyword. ;; defcore symbol drop @ unpack-str MalSymbol. ;; defcore time-ms 2drop utime d>s 1000 / MalInt. ;; ================================================ FILE: impls/forth/env.fs ================================================ require types.fs MalType% cell% field MalEnv/outer cell% field MalEnv/data deftype MalEnv : MalEnv. { outer -- env } MalEnv new { env } outer env MalEnv/outer ! MalMap/Empty env MalEnv/data ! env ; : env/set { key val env -- } key val env MalEnv/data @ assoc env MalEnv/data ! ; : env/get-addr { key env -- val-addr } env begin ( env ) key over MalEnv/data @ MalMap/get-addr ( env addr-or-0 ) ?dup 0= if ( env ) MalEnv/outer @ dup 0= ( env-or-0 done-looping? ) else ( env addr ) nip -1 \ found it! ( addr -1 ) endif until ; MalEnv extend pr-buf { env } env MalEnv/data @ pr-buf a-space s" outer: " str-append env MalEnv/outer @ ?dup 0= if s" " str-append else pr-buf endif ;; drop ================================================ FILE: impls/forth/misc-tests.fs ================================================ require printer.fs \ === basic testing util === / : test= 2dup m= if 2drop else cr ." assert failed on line " sourceline# . swap cr ." | got " . cr ." | expected " . cr endif ; \ array function tests create za 2 , 6 , 7 , 10 , 15 , 80 , 81 , 7 za 2 array-find -1 test= 0 test= 7 za 6 array-find -1 test= 1 test= 7 za 10 array-find -1 test= 3 test= 7 za 81 array-find -1 test= 6 test= 7 za 12 array-find 0 test= 4 test= 7 za 8 array-find 0 test= 3 test= 7 za 100 array-find 0 test= 7 test= 7 za 1 array-find 0 test= 0 test= 6 za 81 array-find 0 test= 6 test= 10 new-array 1 swap 0 5 array-insert 2 swap 1 7 array-insert 3 swap 3 12 array-insert 4 swap 4 15 array-insert 5 swap 5 20 array-insert dup 0 cells + @ 5 test= dup 1 cells + @ 7 test= dup 2 cells + @ 10 test= dup 3 cells + @ 12 test= dup 4 cells + @ 15 test= dup 5 cells + @ 20 test= \ Protocol tests : t1 mal-nil 42 MalInt. mal-nil conj 10 MalInt. mal-nil conj conj 20 MalInt. swap conj 23 MalInt. mal-nil conj conj conj pr-str s" (nil (20 (42) 10) 23)" str= -1 test= 1500 MalInt. 1500 MalInt. test= \ MalList tests here 1 MalInt. , 2 MalInt. , 3 MalInt. , here>MalList 4 MalInt. swap conj 5 MalInt. swap conj pr-str s" (5 4 1 2 3)" str= -1 test= \ map tests s" one" MalString. s" one" MalString. test= s" one" MalString. s" x" MalString. m= 0 test= MalMap/Empty 1000 MalInt. 1100 rot assoc 2000 MalInt. 2100 rot assoc 3000 MalInt. 3100 rot assoc dup 99 2000 MalInt. rot get 2100 test= dup 99 4000 MalInt. rot get 99 test= drop MalMap/Empty s" one" MalString. s" first" MalString. rot assoc s" two" MalString. s" second" MalString. rot assoc s" three" MalString. s" third" MalString. rot assoc dup 99 s" two" MalString. rot get s" second" MalString. test= dup 99 s" none" MalString. rot get 99 test= drop 99 MalInt. 10 MalInt. MalMap/Empty get 99 MalInt. test= ; t1 \ eval tests require step2_eval.fs : t2 mal-nil 1 MalInt. swap conj 2 MalInt. swap conj 3 MalInt. swap conj mal-eval ; t2 bye ================================================ FILE: impls/forth/printer.fs ================================================ require str.fs require types.fs \ === printer protocol and implementations === / def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len ) def-protocol-method pr-seq-buf ( readably? str-addr str-len this -- str-addr str-len ) : pr-str { obj } true new-str obj pr-buf rot drop ; \ Examples of extending existing protocol methods to existing type MalDefault extend pr-buf { this } s" #<" str-append this mal-type @ type-name str-append a-space this int>str str-append s" >" str-append ;; drop MalNil extend pr-buf drop s" nil" str-append ;; drop MalTrue extend pr-buf drop s" true" str-append ;; drop MalFalse extend pr-buf drop s" false" str-append ;; drop MalList extend pr-buf -rot s" (" str-append ( list str-addr str-len ) rot pr-seq-buf s" )" str-append ;; extend pr-seq-buf { list } list MalList/count @ 0 > if list MalList/start @ { start } start @ pr-buf list MalList/count @ 1 ?do a-space start i cells + @ pr-buf loop endif ;; drop MalVector extend pr-buf MalVector/list @ -rot s" [" str-append ( list str-addr str-len ) rot pr-seq-buf s" ]" str-append ;; drop MalMap extend pr-buf MalMap/list @ -rot s" {" str-append ( list str-addr str-len ) rot { list } list MalList/count @ { count } count 0 > if list MalList/start @ { start } start @ pr-buf a-space start cell+ @ pr-buf count 2 / 1 ?do a-space start i 2 * cells + @ pr-buf a-space start i 2 * 1+ cells + @ pr-buf loop endif s" }" str-append ;; drop MalInt extend pr-buf MalInt/int @ int>str str-append ;; drop MalSymbol extend pr-buf unpack-sym str-append ;; drop MalKeyword extend pr-buf { kw } s" :" str-append kw unpack-keyword str-append ;; drop : escape-str { addr len } s\" \"" str-append addr len + addr ?do i c@ case [char] " of s\" \\\"" str-append endof [char] \ of s\" \\\\" str-append endof 10 of s\" \\n" str-append endof 13 of s\" \\r" str-append endof -rot i 1 str-append rot endcase loop s\" \"" str-append ; MalString extend pr-buf dup MalString/str-addr @ swap MalString/str-len @ 4 pick if escape-str else str-append endif ;; drop Atom extend pr-buf { this } s" (atom " str-append this Atom/val @ pr-buf s" )" str-append ;; drop ================================================ FILE: impls/forth/reader.fs ================================================ require types.fs require printer.fs \ Drop a char off the front of string by advancing the addr and \ decrementing the length, and fetch next char : adv-str ( str-addr str-len -- str-addr str-len char ) swap 1+ swap 1- dup 0= if 0 ( eof ) else over c@ endif ; : mal-digit? ( char -- flag ) dup [char] 9 <= if [char] 0 >= else drop 0 endif ; : char-in-str? ( char str-addr str-len ) rot { needle } false -rot over + swap ?do i c@ needle = if drop true leave endif loop ; : sym-char? ( char -- flag ) s\" \n\r\t\000[]{}()'\"`,; " char-in-str? 0= ; : skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char ) begin begin dup s\" \n\r\t, " char-in-str? while ( str-addr str-len space-char ) drop adv-str repeat dup [char] ; = if drop begin adv-str s\" \n\r\000" char-in-str? until adv-str false else true endif until ; defer read-form ( str-addr str-len -- str-addr str-len mal-obj ) : read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int ) 0 { int } 0 { neg } dup [char] - = if drop adv-str 1 to neg endif begin ( str-addr str-len digit-char ) [char] 0 - int 10 * + to int ( str-addr str-len ) adv-str dup mal-digit? 0= ( str-addr str-len digit-char ) until neg if 0 int - to int endif int MalInt. ; : read-symbol-str ( str-addr str-len sym-char -- str-addr str-len char sym-addr sym-len ) new-str { sym-addr sym-len } begin ( str-addr str-len sym-char ) sym-addr sym-len rot str-append-char to sym-len to sym-addr adv-str dup sym-char? 0= until sym-addr sym-len ; : read-string-literal ( in-addr in-len quote-char -- in-addr in-len mal-string ) new-str { out-addr out-len } drop \ drop leading quote begin ( in-addr in-len ) adv-str over 0= if 2drop 0 0 s\" expected '\"', got EOF" ...throw-str endif dup [char] " <> while dup [char] \ = if drop adv-str dup [char] n = if drop 10 endif dup [char] r = if drop 13 endif endif out-addr out-len rot str-append-char to out-len to out-addr repeat drop adv-str \ skip trailing quote out-addr out-len MalString. ; : read-list ( str-addr str-len open-paren-char close-paren-char -- str-addr str-len non-paren-char mal-list ) here { close-char old-here } drop adv-str begin ( str-addr str-len char ) skip-spaces ( str-addr str-len non-space-char ) over 0= if drop 2drop 0 0 s" ', got EOF" close-char pad ! pad 1 s" expected '" ...throw-str endif dup close-char <> while ( str-addr str-len non-space-non-paren-char ) read-form , repeat drop adv-str old-here here>MalList ; s" deref" MalSymbol. constant deref-sym s" quote" MalSymbol. constant quote-sym s" quasiquote" MalSymbol. constant quasiquote-sym s" splice-unquote" MalSymbol. constant splice-unquote-sym s" unquote" MalSymbol. constant unquote-sym : read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list ) here { old-here } , ( buf-addr buf-len char ) read-form , ( buf-addr buf-len char ) old-here here>MalList ; : read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj ) skip-spaces dup [char] - = 3 pick 1 + c@ mal-digit? and if read-int else dup mal-digit? if read-int else dup [char] ( = if [char] ) read-list else dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else dup [char] " = if read-string-literal else dup [char] : = if drop adv-str read-symbol-str MalKeyword. else dup [char] @ = if drop adv-str deref-sym read-wrapped else dup [char] ' = if drop adv-str quote-sym read-wrapped else dup [char] ` = if drop adv-str quasiquote-sym read-wrapped else dup [char] ~ = if drop adv-str dup [char] @ = if drop adv-str splice-unquote-sym read-wrapped else unquote-sym read-wrapped endif else dup [char] ^ = if drop adv-str read-form { meta } read-form { obj } meta mal-nil conj obj swap conj s" with-meta" MalSymbol. swap conj else read-symbol-str 2dup s" true" str= if 2drop mal-true else 2dup s" false" str= if 2drop mal-false else 2dup s" nil" str= if 2drop mal-nil else MalSymbol. endif endif endif endif endif endif endif endif endif endif endif endif endif endif endif ; ' read-form2 is read-form : read-str ( str-addr str-len - mal-obj ) over c@ read-form { obj } drop 2drop obj ; ================================================ FILE: impls/forth/run ================================================ #!/usr/bin/env bash exec gforth $(dirname $0)/${STEP:-stepA_mal}.fs "${@}" ================================================ FILE: impls/forth/step0_repl.fs ================================================ require types.fs : read ; : eval ; : print ; : rep read eval print ; create buff 128 allot : read-lines begin ." user> " buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap rep type cr endif repeat ; read-lines ================================================ FILE: impls/forth/step1_read_print.fs ================================================ require reader.fs require printer.fs : read read-str ; : eval ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; : rep ( str-addr str-len -- str-addr str-len ) read eval print ; create buff 128 allot 77777777777 constant stack-leak-detect : read-lines begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; read-lines cr bye ================================================ FILE: impls/forth/step2_eval.fs ================================================ require reader.fs require printer.fs : args-as-native { argv argc -- entry*argc... } argc 0 ?do argv i cells + @ as-native loop ; : env-assoc ( map sym-str-addr sym-str-len xt ) -rot MalSymbol. swap MalNativeFn. rot assoc ; MalMap/Empty s" +" :noname args-as-native + MalInt. ; env-assoc s" -" :noname args-as-native - MalInt. ; env-assoc s" *" :noname args-as-native * MalInt. ; env-assoc s" /" :noname args-as-native / MalInt. ; env-assoc constant repl-env : read read-str ; : eval ( env obj ) \ ." EVAL: " dup pr-str safe-type cr mal-eval ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke ( env list this -- list ) MalNativeFn/xt @ { xt } eval-rest ( argv argc ) xt execute ( return-val ) ;; drop MalSymbol extend mal-eval { env sym -- val } 0 sym env get dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; create buff 128 allot 77777777777 constant stack-leak-detect : read-lines begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; read-lines cr bye ================================================ FILE: impls/forth/step3_env.fs ================================================ require reader.fs require printer.fs require env.fs : args-as-native { argv argc -- entry*argc... } argc 0 ?do argv i cells + @ as-native loop ; 0 MalEnv. constant repl-env s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. repl-env env/set s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. repl-env env/set s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. repl-env env/set s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. repl-env env/set : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke ( env list this -- list ) MalNativeFn/xt @ { xt } eval-rest ( argv argc ) xt execute ( return-val ) ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ eval \ TODO: dec refcount of env ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; create buff 128 allot 77777777777 constant stack-leak-detect : read-lines begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; read-lines cr bye ================================================ FILE: impls/forth/step4_if_fn_do.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke ( env list this -- list ) MalNativeFn/xt @ { xt } eval-rest ( argv argc ) xt execute ( return-val ) ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ 0 list MalList/count @ 1 ?do drop dup i cells + @ env swap eval loop nip ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ eval else mal-nil endif else \ branch to true env arg0 cell+ @ eval endif ;; s" &" MalSymbol. constant &-sym MalUserFn extend eval-invoke { call-env list mal-fn -- list } call-env list eval-rest { argv argc } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop f-args i 1+ cells + @ ( more-args-symbol ) MalList new ( sym more-args ) argc i - dup { c } over MalList/count ! c cells allocate throw dup { start } over MalList/start ! argv i cells + start c cells cmove env env/set leave endif argv i cells + @ env env/set loop env mal-fn MalUserFn/body @ eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; create buff 128 allot 77777777777 constant stack-leak-detect s\" (def! not (fn* (x) (if x false true)))" rep 2drop : read-lines begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; read-lines cr bye ================================================ FILE: impls/forth/step5_tco.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke ( env list this -- list ) MalNativeFn/xt @ { xt } eval-rest ( argv argc ) xt execute ( return-val ) ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym MalUserFn extend eval-invoke { call-env list mal-fn -- list } call-env list eval-rest { argv argc } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop f-args i 1+ cells + @ ( more-args-symbol ) MalList new ( sym more-args ) argc i - dup { c } over MalList/count ! c cells allocate throw dup { start } over MalList/start ! argv i cells + start c cells cmove env env/set leave endif argv i cells + @ env env/set loop env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; create buff 128 allot 77777777777 constant stack-leak-detect s\" (def! not (fn* (x) (if x false true)))" rep 2drop : read-lines begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; read-lines cr bye ================================================ FILE: impls/forth/step6_file.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke { env list this -- list } env list eval-rest ( argv argc ) this invoke ;; extend invoke ( argv argc this -- val ) MalNativeFn/xt @ execute ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym : new-user-fn-env { argv argc mal-fn -- env } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop argc i - { c } c cells allocate throw { start } argv i cells + start c cells cmove f-args i 1+ cells + @ ( more-args-symbol ) start c MalList. env env/set leave endif argv i cells + @ env env/set loop env ; MalUserFn extend eval-invoke { call-env list mal-fn -- list } call-env list eval-rest mal-fn invoke ;; extend invoke ( argv argc mal-fn ) dup { mal-fn } new-user-fn-env { env } env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop defcore eval ( argv argc ) drop @ repl-env swap eval ;; : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; : mk-args-list ( -- ) here begin next-arg 2dup 0 0 d<> while MalString. , repeat 2drop here>MalList ; create buff 128 allot 77777777777 constant stack-leak-detect : nop ; defcore swap! { argv argc -- val } \ argv is (atom fn args...) argv @ { atom } argv cell+ @ { fn } argc 1- { call-argc } call-argc cells allocate throw { call-argv } atom Atom/val call-argv 1 cells cmove argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove call-argv call-argc fn invoke dup TCO-eval = if drop eval endif { new-val } new-val atom Atom/val ! new-val ;; s\" (def! not (fn* (x) (if x false true)))" rep 2drop s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop : repl ( -- ) begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; : main ( -- ) mk-args-list { args-list } args-list MalList/count @ 0= if s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set repl else args-list MalList/start @ @ { filename } s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set repl-env here s" load-file" MalSymbol. , filename , here>MalList eval print endif ; main cr bye ================================================ FILE: impls/forth/step7_quote.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke { env list this -- list } env list eval-rest ( argv argc ) this invoke ;; extend invoke ( argv argc this -- val ) MalNativeFn/xt @ execute ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; 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 ( 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 quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym : new-user-fn-env { argv argc mal-fn -- env } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop argc i - { c } c cells allocate throw { start } argv i cells + start c cells cmove f-args i 1+ cells + @ ( more-args-symbol ) start c MalList. env env/set leave endif argv i cells + @ env env/set loop env ; MalUserFn extend eval-invoke { call-env list mal-fn -- list } call-env list eval-rest mal-fn invoke ;; extend invoke ( argv argc mal-fn ) dup { mal-fn } new-user-fn-env { env } env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop defcore eval ( argv argc ) drop @ repl-env swap eval ;; : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; : mk-args-list ( -- ) here begin next-arg 2dup 0 0 d<> while MalString. , repeat 2drop here>MalList ; create buff 128 allot 77777777777 constant stack-leak-detect : nop ; defcore swap! { argv argc -- val } \ argv is (atom fn args...) argv @ { atom } argv cell+ @ { fn } argc 1- { call-argc } call-argc cells allocate throw { call-argv } atom Atom/val call-argv 1 cells cmove argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove call-argv call-argc fn invoke dup TCO-eval = if drop eval endif { new-val } new-val atom Atom/val ! new-val ;; s\" (def! not (fn* (x) (if x false true)))" rep 2drop s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop : repl ( -- ) begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; : main ( -- ) mk-args-list { args-list } args-list MalList/count @ 0= if s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set repl else args-list MalList/start @ @ { filename } s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set repl-env here s" load-file" MalSymbol. , filename , here>MalList eval print endif ; main cr bye ================================================ FILE: impls/forth/step8_macros.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke { env list this -- list } env list eval-rest ( argv argc ) this invoke ;; extend invoke ( argv argc this -- val ) MalNativeFn/xt @ execute ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; 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 ( 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 quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval asMacro { val } val env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym : new-user-fn-env { argv argc mal-fn -- env } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop argc i - { c } c cells allocate throw { start } argv i cells + start c cells cmove f-args i 1+ cells + @ ( more-args-symbol ) start c MalList. env env/set leave endif argv i cells + @ env env/set loop env ; MalUserFn extend eval-invoke { call-env list mal-fn -- list } mal-fn MalUserFn/is-macro? @ if list MalList/start @ cell+ \ argv list MalList/count @ 1- \ argc mal-fn new-user-fn-env { env } env mal-fn MalUserFn/body @ eval call-env swap TCO-eval else call-env list eval-rest mal-fn invoke endif ;; extend invoke ( argv argc mal-fn ) dup { mal-fn } new-user-fn-env { env } env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new false over MalUserFn/is-macro? ! env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop defcore eval ( argv argc ) drop @ repl-env swap eval ;; : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; : mk-args-list ( -- ) here begin next-arg 2dup 0 0 d<> while MalString. , repeat 2drop here>MalList ; create buff 128 allot 77777777777 constant stack-leak-detect : nop ; defcore swap! { argv argc -- val } \ argv is (atom fn args...) argv @ { atom } argv cell+ @ { fn } argc 1- { call-argc } call-argc cells allocate throw { call-argv } atom Atom/val call-argv 1 cells cmove argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove call-argv call-argc fn invoke dup TCO-eval = if drop eval endif { new-val } new-val atom Atom/val ! new-val ;; s\" (def! not (fn* (x) (if x false true)))" rep 2drop s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop : repl ( -- ) begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; : main ( -- ) mk-args-list { args-list } args-list MalList/count @ 0= if s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set repl else args-list MalList/start @ @ { filename } s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set repl-env here s" load-file" MalSymbol. , filename , here>MalList eval print endif ; main cr bye ================================================ FILE: impls/forth/step9_try.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; extend invoke { argv argc kw -- val } 0 kw argv @ get ?dup 0= if argc 1 > if argv cell+ @ else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke { env list this -- list } env list eval-rest ( argv argc ) this invoke ;; extend invoke ( argv argc this -- val ) MalNativeFn/xt @ execute ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; 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 ( 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 quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval asMacro { val } val env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym : new-user-fn-env { argv argc mal-fn -- env } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop argc i - { c } c cells allocate throw { start } argv i cells + start c cells cmove f-args i 1+ cells + @ ( more-args-symbol ) start c MalList. env env/set leave endif argv i cells + @ env env/set loop env ; MalUserFn extend eval-invoke { call-env list mal-fn -- list } mal-fn MalUserFn/is-macro? @ if list MalList/start @ cell+ \ argv list MalList/count @ 1- \ argc mal-fn new-user-fn-env { env } env mal-fn MalUserFn/body @ eval call-env swap TCO-eval else call-env list eval-rest mal-fn invoke endif ;; extend invoke ( argv argc mal-fn ) dup { mal-fn } new-user-fn-env { env } env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new false over MalUserFn/is-macro? ! env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; 5555555555 constant pre-try defspecial try* { env list -- val } list MalList/start @ cell+ { arg0 } list MalList/count @ 3 < if env arg0 @ eval else pre-try env arg0 @ ['] eval catch ?dup 0= if nip else { errno } begin pre-try = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif arg0 cell+ @ ( list[catch*,sym,form] ) MalList/start @ cell+ { catch0 } env MalEnv. { catch-env } catch0 @ exception-object catch-env env/set catch-env catch0 cell+ @ TCO-eval endif endif ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop defcore eval ( argv argc ) drop @ repl-env swap eval ;; : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; : mk-args-list ( -- ) here begin next-arg 2dup 0 0 d<> while MalString. , repeat 2drop here>MalList ; create buff 128 allot 77777777777 constant stack-leak-detect : nop ; defcore swap! { argv argc -- val } \ argv is (atom fn args...) argv @ { atom } argv cell+ @ { fn } argc 1- { call-argc } call-argc cells allocate throw { call-argv } atom Atom/val call-argv 1 cells cmove argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove call-argv call-argc fn invoke dup TCO-eval = if drop eval endif { new-val } new-val atom Atom/val ! new-val ;; defcore map ( argv argc -- list ) drop dup @ swap cell+ @ to-list { fn list } here list MalList/start @ list MalList/count @ cells over + swap +do i 1 fn invoke dup TCO-eval = if drop eval endif , cell +loop here>MalList ;; s\" (def! not (fn* (x) (if x false true)))" rep 2drop s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop : repl ( -- ) begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; : main ( -- ) mk-args-list { args-list } args-list MalList/count @ 0= if s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set repl else args-list MalList/start @ @ { filename } s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set repl-env here s" load-file" MalSymbol. , filename , here>MalList eval print endif ; main cr bye ================================================ FILE: impls/forth/stepA_mal.fs ================================================ require reader.fs require printer.fs require core.fs core MalEnv. constant repl-env 99999999 constant TCO-eval : read read-str ; s" DEBUG-EVAL" MalSymbol. constant debug-eval-sym : eval ( env obj ) begin over debug-eval-sym swap env/get-addr ?dup-if @ dup mal-false <> swap mal-nil <> and if ." EVAL: " dup pr-str safe-type cr endif endif mal-eval dup TCO-eval = while drop repeat ; : print \ ." Type: " dup mal-type @ type-name safe-type cr pr-str ; MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself MalKeyword extend eval-invoke { env list kw -- val } 0 kw env list MalList/start @ cell+ @ eval get ?dup 0= if \ compute not-found value list MalList/count @ 1 > if env list MalList/start @ 2 cells + @ TCO-eval else mal-nil endif endif ;; extend invoke { argv argc kw -- val } 0 kw argv @ get ?dup 0= if argc 1 > if argv cell+ @ else mal-nil endif endif ;; drop \ eval all but the first item of list : eval-rest { env list -- argv argc } list MalList/start @ cell+ { expr-start } list MalList/count @ 1- { argc } argc cells allocate throw { target } argc 0 ?do env expr-start i cells + @ eval target i cells + ! loop target argc ; MalNativeFn extend eval-invoke { env list this -- list } env list eval-rest ( argv argc ) this invoke ;; extend invoke ( argv argc this -- val ) MalNativeFn/xt @ execute ;; drop SpecialOp extend eval-invoke ( env list this -- list ) SpecialOp/xt @ execute ;; drop : install-special ( symbol xt ) SpecialOp. repl-env env/set ; : defspecial parse-allot-name MalSymbol. ['] install-special :noname ; 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 ( 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 quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; defspecial def! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval dup { val } ( key val ) env env/set val ;; defspecial defmacro! { env list -- val } list MalList/start @ cell+ { arg0 } arg0 @ ( key ) env arg0 cell+ @ eval asMacro { val } val env env/set val ;; defspecial let* { old-env list -- val } old-env MalEnv. { env } list MalList/start @ cell+ dup { arg0 } @ to-list dup MalList/start @ { bindings-start } ( list ) MalList/count @ 0 +do bindings-start i cells + dup @ swap cell+ @ ( sym expr ) env swap eval env env/set 2 +loop env arg0 cell+ @ TCO-eval \ TODO: dec refcount of env ;; defspecial do { env list -- val } list MalList/start @ { start } list MalList/count @ dup 1- { last } 1 ?do env start i cells + @ i last = if TCO-eval else eval drop endif loop ;; defspecial if { env list -- val } list MalList/start @ cell+ { arg0 } env arg0 @ eval ( test-val ) dup mal-false = if drop -1 else mal-nil = endif if \ branch to false list MalList/count @ 3 > if env arg0 cell+ cell+ @ TCO-eval else mal-nil endif else \ branch to true env arg0 cell+ @ TCO-eval endif ;; s" &" MalSymbol. constant &-sym : new-user-fn-env { argv argc mal-fn -- env } mal-fn MalUserFn/formal-args @ { f-args-list } mal-fn MalUserFn/env @ MalEnv. { env } f-args-list MalList/start @ { f-args } f-args-list MalList/count @ ?dup 0= if else \ pass empty list for last arg, unless overridden below 1- cells f-args + @ MalList new env env/set endif argc 0 ?do f-args i cells + @ dup &-sym m= if drop argc i - { c } c cells allocate throw { start } argv i cells + start c cells cmove f-args i 1+ cells + @ ( more-args-symbol ) start c MalList. env env/set leave endif argv i cells + @ env env/set loop env ; MalUserFn extend eval-invoke { call-env list mal-fn -- list } mal-fn MalUserFn/is-macro? @ if list MalList/start @ cell+ \ argv list MalList/count @ 1- \ argc mal-fn new-user-fn-env { env } env mal-fn MalUserFn/body @ eval call-env swap TCO-eval else call-env list eval-rest mal-fn invoke endif ;; extend invoke ( argv argc mal-fn ) dup { mal-fn } new-user-fn-env { env } env mal-fn MalUserFn/body @ TCO-eval ;; drop defspecial fn* { env list -- val } list MalList/start @ cell+ { arg0 } MalUserFn new false over MalUserFn/is-macro? ! env over MalUserFn/env ! arg0 @ to-list over MalUserFn/formal-args ! arg0 cell+ @ over MalUserFn/body ! ;; 5555555555 constant pre-try defspecial try* { env list -- val } list MalList/start @ cell+ { arg0 } list MalList/count @ 3 < if env arg0 @ eval else pre-try env arg0 @ ['] eval catch ?dup 0= if nip else { errno } begin pre-try = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif arg0 cell+ @ ( list[catch*,sym,form] ) MalList/start @ cell+ { catch0 } env MalEnv. { catch-env } catch0 @ exception-object catch-env env/set catch-env catch0 cell+ @ TCO-eval endif endif ;; defspecial . { env coll -- rtn-list } depth { old-depth } coll to-list dup MalList/count @ swap MalList/start @ { count start } count cells start + start cell+ +do env i @ eval as-native cell +loop ;; MalSymbol extend mal-eval { env sym -- val } sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; drop : eval-ast { env list -- list } here list MalList/start @ { expr-start } list MalList/count @ 0 ?do env expr-start i cells + @ eval , loop here>MalList ; MalList extend mal-eval { env list -- val } list MalList/count @ 0= if list else env list MalList/start @ @ eval env list rot eval-invoke endif ;; drop MalVector extend mal-eval ( env vector -- vector ) MalVector/list @ eval-ast MalVector new swap over MalVector/list ! ;; drop MalMap extend mal-eval ( env map -- map ) MalMap/list @ eval-ast MalMap new swap over MalMap/list ! ;; drop defcore eval ( argv argc ) drop @ repl-env swap eval ;; : rep ( str-addr str-len -- str-addr str-len ) read repl-env swap eval print ; : mk-args-list ( -- ) here begin next-arg 2dup 0 0 d<> while MalString. , repeat 2drop here>MalList ; create buff 128 allot 77777777777 constant stack-leak-detect : nop ; defcore swap! { argv argc -- val } \ argv is (atom fn args...) argv @ { atom } argv cell+ @ { fn } argc 1- { call-argc } call-argc cells allocate throw { call-argv } atom Atom/val call-argv 1 cells cmove argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove call-argv call-argc fn invoke dup TCO-eval = if drop eval endif { new-val } new-val atom Atom/val ! new-val ;; defcore map ( argv argc -- list ) drop dup @ swap cell+ @ to-list { fn list } here list MalList/start @ list MalList/count @ cells over + swap +do i 1 fn invoke dup TCO-eval = if drop eval endif , cell +loop here>MalList ;; s\" (def! *host-language* \"forth\")" rep 2drop s\" (def! not (fn* (x) (if x false true)))" rep 2drop s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep 2drop s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop : repl ( -- ) s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop begin ." user> " stack-leak-detect buff 128 stdin read-line throw while ( num-bytes-read ) dup 0 <> if buff swap ( str-addr str-len ) ['] rep \ execute ['] nop \ uncomment to see stack traces catch ?dup 0= if safe-type cr stack-leak-detect <> if ." --stack leak--" cr endif else { errno } begin stack-leak-detect = until errno 1 <> if s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc to exception-object endif ." Uncaught exception: " exception-object pr-str safe-type cr endif endif repeat ; : main ( -- ) mk-args-list { args-list } args-list MalList/count @ 0= if s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set repl else args-list MalList/start @ @ { filename } s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set repl-env here s" load-file" MalSymbol. , filename , here>MalList eval print endif ; main cr bye ================================================ FILE: impls/forth/str.fs ================================================ : safe-type ( str-addr str-len -- ) dup 256 > if drop 256 type ." ..." else type endif ; \ === mutable string buffer === / \ string buffer that maintains an allocation larger than the current \ string size. When appending would cause the string size exceed the \ current allocation, resize is used to double the allocation. The \ current allocation is not stored anywhere, but computed based on \ current string size or str-base-size, whichever is larger. 64 constant str-base-size : new-str ( -- addr length ) str-base-size allocate throw 0 ; : round-up ( n -- n ) 2 begin 1 lshift 2dup < until nip ; : str-append { buf-addr buf-str-len str-addr str-len } buf-str-len str-len + { new-len } new-len str-base-size >= if buf-str-len new-len xor buf-str-len > if buf-addr new-len round-up resize throw to buf-addr endif endif str-addr buf-addr buf-str-len + str-len cmove buf-addr new-len ; \ define a-space, to append a space char to a string bl c, here constant space-str : a-space space-str 1 str-append ; : str-append-char ( buf-addr buf-str-len char -- buf-addr buf-str-len ) pad ! pad 1 str-append ; \ from gforth docs, there named 'my-.' : int>str ( num -- str-addr str-len ) \ handling negatives.. behaves like Standard . s>d \ convert to signed double swap over dabs \ leave sign byte followed by unsigned double <<# \ start conversion #s \ convert all digits rot sign \ get at sign byte, append "-" if needed #> \ complete conversion #>> ; \ release hold area defer MalString. : ...str new-str begin 2swap over 0 <> while str-append repeat 2drop MalString. ; nil value exception-object : ...throw-str ...str to exception-object 1 throw ; ================================================ FILE: impls/forth/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/forth/tests/stepA_mal.mal ================================================ ;; Basic interop (. 5 'MalInt.) ;=>5 (. 11 31 '+ 'MalInt.) ;=>42 (. "greetings" 'MalString.) ;=>"greetings" (. "hello" 'type 'cr 'mal-nil) ;/hello ;=>nil ;; Interop on non-literals (. (+ 15 27) 'MalInt.) ;=>42 (let* [a 17] (. a 25 '+ 'MalInt.)) ;=>42 (let* [a "hello"] (. a 1 '- 'MalString.)) ;=>"hell" ;; Use of annoyingly-named forth words (. 1 'MalInt. (symbol ",") 'here (symbol "@")) ;=>1 (let* (i 'MalInt.) (. 5 i)) ;=>5 (let* (comma (symbol ",") fetch (symbol "@")) (. 'here 42 'MalInt. comma fetch)) ;=>42 ;; Multiple .-forms interacting via heap memory and mal locals (def! string-parts (fn* (s) (. s 'MalInt. 'swap 'MalInt. 'here '-rot (symbol ",") (symbol ",") 'here>MalList))) (first (rest (string-parts "sketchy"))) ;=>7 (def! prn-chars (fn* (start count) (if (> count 0) (do (prn (. start 1 'MalString.)) (prn-chars (+ start 1) (- count 1)))))) (let* (msg (string-parts "sketchy")) (prn-chars (first msg) (first (rest msg)))) ;/"s" ;/"k" ;/"e" ;/"t" ;/"c" ;/"h" ;/"y" ;=>nil ================================================ FILE: impls/forth/types.fs ================================================ require str.fs \ === sorted-array === / \ Here are a few utility functions useful for creating and maintaining \ the deftype* method tables. The keys array is kept in sorted order, \ and the methods array is maintained in parallel so that an index into \ one corresponds to an index in the other. \ Search a sorted array for key, returning the index of where it was \ found. If key is not in the array, return the index where it would \ be if added. : array-find { a-length a-addr key -- index found? } 0 a-length ( start end ) begin \ cr 2dup . . 2dup + 2 / dup ( start end middle middle ) cells a-addr + @ ( start end middle mid-val ) dup key < if drop rot ( end middle start ) 2dup = if 2drop dup ( end end ) else drop swap ( middle end ) endif else key > if ( start end middle ) nip ( start middle ) else -rot 2drop dup ( middle middle ) endif endif 2dup = until dup a-length = if drop false else cells a-addr + @ key = endif ; \ Create a new array, one cell in length, initialized the provided value : new-array { value -- array } cell allocate throw value over ! ; \ Resize a heap-allocated array to be one cell longer, inserting value \ at idx, and shifting the tail of the array as necessary. Returns the \ (possibly new) array address : array-insert { old-array-length old-array idx value -- array } old-array old-array-length 1+ cells resize throw { a } a idx cells + dup cell+ old-array-length idx - cells cmove> value a idx cells + ! a ; \ === deftype* -- protocol-enabled structs === / \ Each type has MalTypeType% struct allocated on the stack, with \ mutable fields pointing to all class-shared resources, specifically \ the data needed to allocate new instances, and the table of protocol \ methods that have been extended to the type. \ Use 'deftype*' to define a new type, and 'new' to create new \ instances of that type. struct cell% field mal-type cell% field mal-meta \ cell% field ref-count \ Ha, right. end-struct MalType% struct cell% 2 * field MalTypeType-struct cell% field MalTypeType-methods cell% field MalTypeType-method-keys cell% field MalTypeType-method-vals cell% field MalTypeType-name-addr cell% field MalTypeType-name-len end-struct MalTypeType% : new ( MalTypeType -- obj ) dup MalTypeType-struct 2@ %allocate throw ( MalTypeType obj ) \ create struct dup -rot mal-type ! ( obj ) \ set struct's type pointer to this type nil over mal-meta ! ; : deftype* ( struct-align struct-len -- MalTypeType ) MalTypeType% %allot ( s-a s-l MalTypeType ) dup 2swap rot ( MalTypeType s-a s-l MalTypeType ) MalTypeType-struct 2! ( MalTypeType ) \ store struct info dup MalTypeType-methods 0 swap ! ( MalTypeType ) dup MalTypeType-method-keys nil swap ! ( MalTypeType ) dup MalTypeType-method-vals nil swap ! ( MalTypeType ) dup MalTypeType-name-len 0 swap ! ( MalTypeType ) ; \ parse-name uses temporary space, so copy into dictionary stack: : parse-allot-name { -- new-str-addr str-len } parse-name { str-addr str-len } here { new-str-addr } str-len allot str-addr new-str-addr str-len cmove new-str-addr str-len ; : deftype ( struct-align struct-len R:type-name -- ) parse-allot-name { name-addr name-len } \ allot and initialize type structure deftype* { mt } name-addr mt MalTypeType-name-addr ! name-len mt MalTypeType-name-len ! \ ." Defining " mt MalTypeType-name-addr @ mt MalTypeType-name-len @ type cr mt name-addr name-len nextname 1 0 const-does> ; : type-name ( mal-type ) dup MalTypeType-name-addr @ ( mal-type name-addr ) swap MalTypeType-name-len @ ( name-addr name-len ) ; MalType% deftype MalDefault \ nil type and instance to support extending protocols to it MalType% deftype MalNil MalNil new constant mal-nil MalType% deftype MalTrue MalTrue new constant mal-true MalType% deftype MalFalse MalFalse new constant mal-false : mal-bool 0= if mal-false else mal-true endif ; : not-object? ( obj -- bool ) dup 7 and 0 <> if drop true else 1000000 < endif ; \ === protocol methods === / struct cell% field call-site/type cell% field call-site/xt end-struct call-site% \ Used by protocol methods to find the appropriate implementation of \ themselves for the given object, and then execute that implementation. : execute-method { obj pxt call-site -- } obj not-object? if 0 0 obj int>str s" ' on non-object: " pxt >name name>string s" Refusing to invoke protocol fn '" ...throw-str endif \ ." Calling '" pxt >name name>string type ." ' on " obj mal-type @ type-name type ." , cs " call-site . obj mal-type @ ( type ) dup call-site call-site/type @ = if \ ." hit!" cr drop call-site call-site/xt @ else \ ." miss!" cr dup MalTypeType-methods 2@ swap ( type methods method-keys ) dup 0= if \ No protocols extended to this type; check for a default 2drop drop MalDefault MalTypeType-methods 2@ swap endif pxt array-find ( type idx found? ) dup 0= if \ No implementation found for this method; check for a default 2drop drop MalDefault dup MalTypeType-methods 2@ swap pxt array-find ( type idx found? ) endif 0= if ( type idx ) 2drop 0 0 s" '" obj mal-type @ type-name s" ' extended to type '" pxt >name name>string s" No protocol fn '" ...throw-str endif cells over MalTypeType-method-vals @ + @ ( type xt ) swap call-site call-site/type ! ( xt ) dup call-site call-site/xt ! ( xt ) endif obj swap execute ; \ Extend a type with a protocol method. This mutates the MalTypeType \ object that represents the MalType being extended. : extend-method* { type pxt ixt -- type } \ ." Extend '" pxt dup . >name name>string safe-type ." ' to " type type-name safe-type ." , " \ type MalTypeType-methods 2@ ( method-keys methods ) \ 0 ?do \ dup i cells + @ >name name>string safe-type ." , " \ \ dup i cells + @ . \ loop \ drop cr type MalTypeType-methods 2@ swap ( methods method-keys ) dup 0= if \ no protocols extended to this type 2drop 1 type MalTypeType-methods ! pxt new-array type MalTypeType-method-keys ! ixt new-array type MalTypeType-method-vals ! else pxt array-find { idx found? } found? if \ overwrite ." Warning: overwriting protocol method implementation '" pxt >name name>string safe-type ." ' on " type type-name safe-type ." , " idx . found? . cr type MalTypeType-method-vals @ idx cells + ixt ! else \ resize type MalTypeType-methods dup @ 1+ dup rot ! ( new-count ) 1- dup type MalTypeType-method-keys @ idx pxt array-insert ( old-count new-array ) type MalTypeType-method-keys ! ( old-count ) type MalTypeType-method-vals @ idx ixt array-insert ( new-array ) type MalTypeType-method-vals ! endif endif type ; \ Define a new protocol function. For example: \ def-protocol-method pr-str \ When called as above, defines a new word 'pr-str' and stores there its \ own xt (known as pxt). When a usage of pr-str is compiled, it \ allocates a call-site object on the heap and injects a reference to \ both that and the pxt into the compilation, along with a call to \ execute-method. Thus when pr-str runs, execute-method can check the \ call-site object to see if the type of the target object is the same \ as the last call for this site. If so, it executes the implementation \ immediately. Otherwise, it searches the target type's method list and \ if necessary MalDefault's method list. If an implementation of pxt is \ found, it is cached in the call-site, and then executed. : make-call-site { pxt -- } pxt postpone literal \ transfer pxt into call site call-site% %allocate throw dup postpone literal \ allocate call-site, push reference \ dup ." Make cs '" pxt >name name>string type ." ' " . cr 0 swap call-site/type ! postpone execute-method ; : def-protocol-method ( parse: name -- ) : latestxt postpone literal postpone make-call-site postpone ; immediate ; : extend ( type -- type pxt install-xt ) parse-name find-name name>int ( type pxt ) ['] extend-method* :noname ; : ;; ( type pxt -- type ) [compile] ; ( type pxt install-xt ixt ) swap execute ; immediate ( \ These whole-protocol names are only needed for 'satisfies?': protocol IPrintable def-protocol-method pr-str end-protocol MalList IPrintable extend ' pr-str :noname drop s" " ; extend-method* extend-method pr-str drop s" " ;; end-extend ) \ === Mal types and protocols === / def-protocol-method conj ( obj this -- this ) def-protocol-method seq ( obj -- mal-list|nil ) def-protocol-method assoc ( k v this -- this ) def-protocol-method dissoc ( k this -- this ) def-protocol-method get ( not-found k this -- value ) def-protocol-method mal= ( a b -- bool ) def-protocol-method as-native ( obj -- ) def-protocol-method to-list ( obj -- mal-list ) def-protocol-method empty? ( obj -- mal-bool ) def-protocol-method mal-count ( obj -- mal-int ) def-protocol-method sequential? ( obj -- mal-bool ) def-protocol-method get-map-hint ( obj -- hint ) def-protocol-method set-map-hint! ( hint obj -- ) \ Fully evalutate any Mal object: def-protocol-method mal-eval ( env ast -- val ) \ Invoke an object, given whole env and unevaluated argument forms: def-protocol-method eval-invoke ( env list obj -- ... ) \ Invoke a function, given parameter values def-protocol-method invoke ( argv argc mal-fn -- ... ) : m= ( a b -- bool ) 2dup = if 2drop true else mal= endif ; MalType% cell% field MalInt/int deftype MalInt : MalInt. { int -- mal-int } MalInt new dup MalInt/int int swap ! ; MalInt extend mal= ( other this -- bool ) over mal-type @ MalInt = if MalInt/int @ swap MalInt/int @ = else 2drop 0 endif ;; extend as-native ( mal-int -- int ) MalInt/int @ ;; drop MalType% cell% field MalList/count cell% field MalList/start deftype MalList : MalList. ( start count -- mal-list ) MalList new swap over MalList/count ! ( start list ) swap over MalList/start ! ( list ) ; : here>MalList ( old-here -- mal-list ) here over - { bytes } ( old-here ) MalList new bytes ( old-here mal-list bytes ) allocate throw dup { target } over MalList/start ! ( old-here mal-list ) bytes cell / over MalList/count ! ( old-here mal-list ) swap target bytes cmove ( mal-list ) 0 bytes - allot \ pop list contents from dictionary stack ; : MalList/concat ( list-of-lists ) dup MalList/start @ swap MalList/count @ { lists argc } 0 lists argc cells + lists +do ( count ) i @ to-list MalList/count @ + cell +loop { count } count cells allocate throw { start } start lists argc cells + lists +do ( target ) i @ to-list MalList/count @ cells 2dup i @ to-list MalList/start @ -rot ( target bytes src target bytes ) cmove ( target bytes ) + ( new-target ) cell +loop drop start count MalList. ; MalList extend to-list ;; extend sequential? drop mal-true ;; extend conj { elem old-list -- list } old-list MalList/count @ 1+ { new-count } new-count cells allocate throw { new-start } elem new-start ! new-count 1 > if old-list MalList/start @ new-start cell+ new-count 1- cells cmove endif new-start new-count MalList. ;; extend seq dup MalList/count @ 0= if drop mal-nil endif ;; extend empty? MalList/count @ 0= mal-bool ;; extend mal-count MalList/count @ MalInt. ;; extend mal= over mal-nil = if 2drop false else swap to-list dup 0= if nip else 2dup MalList/count @ swap MalList/count @ over = if ( list-a list-b count ) -rot MalList/start @ swap MalList/start @ { start-b start-a } true swap ( return-val count ) 0 ?do start-a i cells + @ start-b i cells + @ m= if else drop false leave endif loop else drop 2drop false endif endif endif ;; drop MalList new 0 over MalList/count ! constant MalList/Empty : MalList/rest { list -- list } list MalList/start @ cell+ list MalList/count @ 1- MalList. ; MalType% cell% field MalVector/list deftype MalVector MalVector extend sequential? drop mal-true ;; extend to-list MalVector/list @ ;; extend empty? MalVector/list @ MalList/count @ 0= mal-bool ;; extend mal-count MalVector/list @ MalList/count @ MalInt. ;; extend mal= MalVector/list @ swap m= ;; extend conj MalVector/list @ { elem old-list } old-list MalList/count @ { old-count } old-count 1+ cells allocate throw { new-start } elem new-start old-count cells + ! old-list MalList/start @ new-start old-count cells cmove new-start old-count 1+ MalList. MalVector new swap over MalVector/list ! ;; extend seq MalVector/list @ seq ;; drop MalType% cell% field MalMap/list deftype MalMap MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty : MalMap/get-addr ( k map -- addr-or-nil ) MalMap/list @ dup MalList/start @ swap MalList/count @ { k start count } true \ need to search? k get-map-hint { hint-idx } hint-idx -1 <> if hint-idx count < if hint-idx cells start + { key-addr } key-addr @ k m= if key-addr cell+ nip false endif endif endif if \ search nil ( addr ) count cells start + start +do i @ k m= if drop i dup start - cell / k set-map-hint! cell+ leave endif [ 2 cells ] literal +loop endif ; MalMap extend conj ( kv map -- map ) MalMap/list @ \ get list over MalList/start @ cell+ @ swap conj \ add value swap MalList/start @ @ swap conj \ add key MalMap new dup -rot MalMap/list ! \ put back in map ;; extend assoc ( k v map -- map ) MalMap/list @ \ get list conj conj MalMap new tuck MalMap/list ! \ put back in map ;; extend dissoc { k map -- map } map MalMap/list @ dup MalList/start @ swap MalList/count @ { start count } map \ return original if key not found count 0 +do start i cells + @ k mal= if drop here start i MalList. , start i 2 + cells + count i - 2 - MalList. , here>MalList MalList/concat MalMap new dup -rot MalMap/list ! \ put back in map endif 2 +loop ;; extend get ( not-found k map -- value ) MalMap/get-addr ( not-found addr-or-nil ) dup 0= if drop else nip @ endif ;; extend empty? MalMap/list @ MalList/count @ 0= mal-bool ;; extend mal-count MalMap/list @ MalList/count @ 2 / MalInt. ;; extend mal= { b a -- bool } b mal-type @ MalMap = if a MalMap/list @ MalList/count @ { a-count } b MalMap/list @ MalList/count @ { b-count } a-count b-count = if a MalMap/list @ MalList/start @ { a-start } true ( return-val ) a-count 0 +do a-start i cells + @ ( return-val key ) dup a MalMap/get-addr swap b MalMap/get-addr ( return-val a-val-addr b-val-addr ) dup 0= if drop 2drop false leave else @ swap @ ( return-val b-val a-val ) m= if else drop false leave endif endif 2 +loop else false endif else false endif ;; drop \ Examples of extending existing protocol methods to existing type MalDefault extend conj ( obj this -- this ) nip ;; extend to-list drop 0 ;; extend empty? drop mal-true ;; extend sequential? drop mal-false ;; extend mal= = ;; extend get-map-hint drop -1 ;; extend set-map-hint! 2drop ;; drop MalNil extend conj ( item nil -- mal-list ) drop MalList/Empty conj ;; extend seq drop mal-nil ;; extend as-native drop nil ;; extend get 2drop ;; extend to-list drop MalList/Empty ;; extend empty? drop mal-true ;; extend mal-count drop 0 MalInt. ;; extend mal= drop mal-nil = ;; drop MalType% cell% field MalSymbol/sym-addr cell% field MalSymbol/sym-len cell% field MalSymbol/map-hint deftype MalSymbol : MalSymbol. { str-addr str-len -- mal-sym } MalSymbol new { sym } str-addr sym MalSymbol/sym-addr ! str-len sym MalSymbol/sym-len ! -1 sym MalSymbol/map-hint ! sym ; : unpack-sym ( mal-string -- addr len ) dup MalSymbol/sym-addr @ swap MalSymbol/sym-len @ ; MalSymbol extend mal= ( other this -- bool ) over mal-type @ MalSymbol = if unpack-sym rot unpack-sym str= else 2drop 0 endif ;; extend get-map-hint MalSymbol/map-hint @ ;; extend set-map-hint! MalSymbol/map-hint ! ;; extend as-native ( this ) unpack-sym evaluate ;; drop MalType% cell% field MalKeyword/str-addr cell% field MalKeyword/str-len deftype MalKeyword : unpack-keyword ( mal-keyword -- addr len ) dup MalKeyword/str-addr @ swap MalKeyword/str-len @ ; MalKeyword extend mal= ( other this -- bool ) over mal-type @ MalKeyword = if unpack-keyword rot unpack-keyword str= else 2drop 0 endif ;; ' as-native ' unpack-keyword extend-method* drop : MalKeyword. { str-addr str-len -- mal-keyword } MalKeyword new { kw } str-addr kw MalKeyword/str-addr ! str-len kw MalKeyword/str-len ! kw ; MalType% cell% field MalString/str-addr cell% field MalString/str-len deftype MalString : MalString.0 { str-addr str-len -- mal-str } MalString new { str } str-addr str MalString/str-addr ! str-len str MalString/str-len ! str ; ' MalString.0 is MalString. : unpack-str ( mal-string -- addr len ) dup MalString/str-addr @ swap MalString/str-len @ ; MalString extend mal= ( other this -- bool ) over mal-type @ MalString = if unpack-str rot unpack-str str= else 2drop 0 endif ;; ' as-native ' unpack-str extend-method* extend seq { str } str MalString/str-len @ { len } len 0= if mal-nil else len cells allocate throw { list-start } len 0 ?do str MalString/str-addr @ i + 1 MalString. ( new-char-string ) list-start i cells + ! loop list-start len MalList. endif ;; drop MalType% cell% field MalNativeFn/xt deftype MalNativeFn : MalNativeFn. { xt -- mal-fn } MalNativeFn new { mal-fn } xt mal-fn MalNativeFn/xt ! mal-fn ; MalType% cell% field MalUserFn/is-macro? cell% field MalUserFn/env cell% field MalUserFn/formal-args cell% field MalUserFn/var-arg cell% field MalUserFn/body deftype MalUserFn : asMacro ( fn -- macro ) MalUserFn new true over MalUserFn/is-macro? ! over MalUserFn/env @ over MalUserFn/env ! over MalUserFn/formal-args @ over MalUserFn/formal-args ! over MalUserFn/var-arg @ over MalUserFn/var-arg ! swap MalUserFn/body @ over MalUserFn/body ! ; MalType% cell% field SpecialOp/xt deftype SpecialOp : SpecialOp. SpecialOp new swap over SpecialOp/xt ! ; MalType% cell% field Atom/val deftype Atom : Atom. Atom new swap over Atom/val ! ; ================================================ FILE: impls/fsharp/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install fsharp ================================================ FILE: impls/fsharp/Makefile ================================================ ##################### DEBUG = SOURCES_BASE = types.fs error.fs node.fs printer.fs tokenizer.fs reader.fs \ readline.fs SOURCES_LISP = core.fs env.fs stepA_mal.fs SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) TERMINAL_SOURCES = terminal.cs ##################### SRCS = step0_repl.fs step1_read_print.fs step2_eval.fs step3_env.fs \ step4_if_fn_do.fs step5_tco.fs step6_file.fs step7_quote.fs \ step8_macros.fs step9_try.fs stepA_mal.fs DLL_SOURCES = $(filter-out stepA_mal.fs,$(SOURCES)) FSFLAGS = $(if $(strip $(DEBUG)),--debug+,--debug- --optimize+ --tailcalls+) CSFLAGS = $(if $(strip $(DEBUG)),-debug+,) ##################### all: $(patsubst %.fs,%.exe,$(SRCS)) dist: mal.exe mal mal.exe: stepA_mal.exe cp $< $@ # NOTE/WARNING: static linking triggers mono libraries LGPL # distribution requirements. # http://www.mono-project.com/archived/guiderunning_mono_applications/ mal: $(patsubst %.fs,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) Mono.Terminal.dll mal.dll mkbundle --static -o $@ $+ --deps Mono.Terminal.dll: $(TERMINAL_SOURCES) mcs $(CSFLAGS) -target:library $+ -out:$@ mal.dll: $(DLL_SOURCES) Mono.Terminal.dll fsharpc $(FSFLAGS) -o $@ -r Mono.Terminal.dll -a $(DLL_SOURCES) %.exe: %.fs mal.dll fsharpc $(FSFLAGS) -o $@ -r mal.dll $< clean: rm -f mal *.dll *.exe *.mdb ================================================ FILE: impls/fsharp/core.fs ================================================ module Core open System open Types let inline toBool b = if b then Node.TRUE else Node.FALSE let inline twoNumberOp (f : int64 -> int64 -> Node) = function | [Number(a); Number(b)] -> f a b | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let inline twoNodeOp (f : Node -> Node -> Node) = function | [a; b] -> f a b | _ -> raise <| Error.wrongArity () let add = twoNumberOp (fun a b -> a + b |> Number) let subtract = twoNumberOp (fun a b -> a - b |> Number) let multiply = twoNumberOp (fun a b -> a * b |> Number) let divide = twoNumberOp (fun a b -> a / b |> Number) let lt = twoNodeOp (fun a b -> a < b |> toBool) let le = twoNodeOp (fun a b -> a <= b |> toBool) let ge = twoNodeOp (fun a b -> a >= b |> toBool) let gt = twoNodeOp (fun a b -> a > b |> toBool) let eq = twoNodeOp (fun a b -> a = b |> toBool) let time_ms _ = DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond |> int64 |> Number let list = Node.makeList let isList = function | [List(_, _)] -> Node.TRUE | [_] -> Node.FALSE | _ -> raise <| Error.wrongArity () let isEmpty = function | [List(_, [])] -> Node.TRUE | [Vector(_, seg)] when seg.Count <= 0 -> Node.TRUE | _ -> Node.FALSE let count = function | [List(_, lst)] -> lst |> List.length |> int64 |> Number | [Vector(_, seg)] -> seg.Count |> int64 |> Number | [Nil] -> Node.ZERO | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let pr_str nodes = nodes |> Printer.pr_str |> String let str nodes = nodes |> Printer.str |> String let prn nodes = nodes |> Printer.prn |> printfn "%s"; Nil let println nodes = nodes |> Printer.println |> printfn "%s"; Nil let read_str = function | [String(s)] -> match Reader.read_str s with | [node] -> node | nodes -> Symbol("do")::nodes |> Node.makeList | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let slurp = function | [String(s)] -> System.IO.File.ReadAllText s |> String | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let cons = function | [node; List(_, lst)] -> node::lst |> Node.makeList | [node; Vector(_, seg)] -> node::(List.ofSeq seg) |> Node.makeList | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let concat nodes = let cons st node = node::st let accumNode acc = function | List(_, lst) -> lst |> List.fold cons acc | Vector(_, seg) -> seg |> Seq.fold cons acc | _ -> raise <| Error.argMismatch () nodes |> List.fold accumNode [] |> 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 | [] -> raise <| Error.indexOutOfBounds () | h::_ when n = 0L -> h | _::t -> nth_list (n - 1L) t nth_list n lst | [Vector(_, seg); Number(n)] -> if n < 0L || n >= int64(seg.Count) then raise <| Error.indexOutOfBounds () else seg.Array.[int(n)] | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let first = function | [List(_, [])] -> Node.NIL | [List(_, h::_)] -> h | [Vector(_, seg)] when seg.Count > 0 -> seg.Array.[0] | [Vector(_, _)] -> Node.NIL | [Nil] -> Node.NIL | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let rest = function | [List(_, [])] -> Node.EmptyLIST | [List(_, _::t)] -> t |> Node.makeList | [Vector(_, seg)] when seg.Count < 2 -> Node.EmptyLIST | [Vector(_, seg)] -> seg |> Seq.skip 1 |> List.ofSeq |> Node.makeList | [Nil] -> Node.EmptyLIST | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let throw = function | [node] -> raise <| Error.MalError(node) | _ -> raise <| Error.wrongArity () let map = function | [BuiltInFunc(_, _, f); Node.Seq seq] | [Func(_, _, f, _, _, _); Node.Seq seq] -> seq |> Seq.map (fun node -> f [node]) |> List.ofSeq |> Node.makeList | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let apply = function | BuiltInFunc(_, _, f)::rest | Macro(_, _, f, _, _, _)::rest | Func(_, _, f, _, _, _)::rest -> let rec getArgsAndCall acc = function | [] -> raise <| Error.wrongArity () | [Node.Seq seq] -> seq |> Seq.fold (fun acc node -> node::acc) acc |> List.rev |> f | [_] -> raise <| Error.argMismatch () | h::rest -> getArgsAndCall (h::acc) rest getArgsAndCall [] rest | _::_ -> raise <| Error.argMismatch () | [] -> raise <| Error.wrongArity () let isConst cmp = function | [node] -> if node = cmp then Node.TRUE else Node.FALSE | _ -> raise <| Error.wrongArity () let isPattern f = function | [node] -> if f node then Node.TRUE else Node.FALSE | _ -> raise <| Error.wrongArity () let isSymbol = isPattern (function Symbol(_) -> true | _ -> false) let isKeyword = isPattern (function Keyword(_) -> true | _ -> false) let isString = isPattern (function String(_) -> true | _ -> false) let isNumber = isPattern (function Number(_) -> true | _ -> false) let isFn = isPattern (function BuiltInFunc(_, _, _) | Func(_, _, _, _, _, _) -> true | _ -> false) let isMacro = isPattern (function Macro(_, _, _, _, _, _) -> true | _ -> false) let isSequential = isPattern (function Node.Seq(_) -> true | _ -> false) let isVector = isPattern (function Vector(_, _) -> true | _ -> false) let isMap = isPattern (function Map(_, _) -> true | _ -> false) let isAtom = isPattern (function Atom(_, _) -> true | _ -> false) let symbol = function | [String(s)] -> Symbol s | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let keyword = function | [String(s)] -> Keyword s | [Keyword(_) as k] -> k | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let vector lst = lst |> Array.ofList |> Node.ofArray let rec getPairs lst = seq { match lst with | first::second::t -> yield first, second yield! getPairs t | [_] -> raise <| Error.expectedEvenNodeCount () | [] -> () } let mapOpN f = function | Map(_, map)::rest -> f rest map | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let mapOp1 f = mapOpN (fun rest map -> match rest with | [v] -> f v map | _ -> raise <| Error.wrongArity ()) let mapOp0 f = mapOpN (fun rest map -> match rest with | [] -> f map | _ -> raise <| Error.wrongArity ()) let mapKV f = mapOp0 (fun map -> map |> Map.toSeq |> Seq.map f |> List.ofSeq |> Node.makeList) let hashMap lst = lst |> getPairs |> Map.ofSeq |> Node.makeMap let assoc = mapOpN (fun rest map -> rest |> getPairs |> Seq.fold (fun map (k, v) -> Map.add k v map) map |> Node.makeMap) let dissoc = mapOpN (fun keys map -> keys |> List.fold (fun map k -> Map.remove k map) map |> Node.makeMap) let get = function | [Nil; _] -> Node.NIL | _ as rest -> rest |> mapOp1 (fun key map -> match Map.tryFind key map with | Some(node) -> node | None -> Node.NIL) let containsKey key map = if Map.containsKey key map then Node.TRUE else Node.FALSE let contains = mapOp1 containsKey let keys = mapKV (fun (k, v) -> k) let vals = mapKV (fun (k, v) -> v) let atom nextValue = function | [node] -> Atom((nextValue ()), ref node) | _ -> raise <| Error.wrongArity () let deref = function | [Atom(_, r)] -> !r | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let reset = function | [Atom(_, r); node] -> r := node !r | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let swap = function | Atom(_, r) ::(BuiltInFunc(_, _, f) | Func(_, _, f, _, _, _)) ::rest -> r := f (!r::rest) !r | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let conj = function | List(_, lst)::rest -> rest |> List.fold (fun lst node -> node::lst) lst |> Node.makeList | Vector(_, seg)::rest -> (* Might be nice to implement a persistent vector here someday. *) let cnt = List.length rest if cnt > 0 then let target : Node array = seg.Count + cnt |> Array.zeroCreate System.Array.Copy(seg.Array :> System.Array, seg.Offset, target :> System.Array, 0, seg.Count) let rec copyElem i = function | h::t -> Array.set target i h copyElem (i + 1) t | [] -> () copyElem (seg.Count) rest target |> Node.ofArray else seg |> Node.makeVector | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let seq = function | [Nil] -> Node.NIL | [List(_, [])] -> Node.NIL | [List(_, _) as l] -> l | [Vector(_, seg)] when seg.Count < 1 -> Node.NIL | [Vector(_, seg)] -> seg |> List.ofSeq |> Node.makeList | [String(s)] when String.length s < 1 -> Node.NIL | [String(s)] -> s |> Seq.map Node.ofChar |> List.ofSeq |> Node.makeList | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let withMeta = function | [List(_, lst); m] -> List(m, lst) | [Vector(_, seg); m] -> Vector(m, seg) | [Map(_, map); m] -> Map(m, map) | [BuiltInFunc(_, tag, f); m] -> BuiltInFunc(m, tag, f) | [Func(_, tag, f, a, b, c); m] -> Func(m, tag, f, a, b, c) | [Macro(_, tag, f, a, b, c); m] -> Macro(m, tag, f, a, b, c) | [_; _] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let meta = function | [List(m, _)] | [Vector(m, _)] | [Map(m, _)] | [BuiltInFunc(m, _, _)] | [Func(m, _, _, _, _, _)] | [Macro(m, _, _, _, _, _)] -> m | [_] -> Node.NIL | _ -> raise <| Error.wrongArity () ================================================ FILE: impls/fsharp/env.fs ================================================ module Env open Types let makeEmpty () = Env() let ofList lst = let env = makeEmpty () let accumulate (e : Env) (k, v) = e.Add(k, v); e List.fold accumulate env lst let set (env : EnvChain) key node = match env with | head::_ -> head.[key] <- node | _ -> raise <| Error.noEnvironment () let rec get (chain : EnvChain) key = match chain with | [] -> None | env::rest -> match env.TryGetValue(key) with | true, v -> Some(v) | false, _ -> get rest key let private getNextValue = let counter = ref 0 fun () -> System.Threading.Interlocked.Increment(counter) let makeBuiltInFunc f = BuiltInFunc(Node.NIL, getNextValue (), f) let makeFunc f body binds env = Func(Node.NIL, getNextValue (), f, body, binds, env) let makeMacro f body binds env = Macro(Node.NIL, getNextValue (), f, body, binds, env) let makeRootEnv () = let wrap name f = name, makeBuiltInFunc f let env = [ wrap "+" Core.add wrap "-" Core.subtract wrap "*" Core.multiply wrap "/" Core.divide wrap "list" Core.list wrap "list?" Core.isList wrap "empty?" Core.isEmpty wrap "count" Core.count wrap "=" Core.eq wrap "<" Core.lt wrap "<=" Core.le wrap ">=" Core.ge wrap ">" Core.gt wrap "time-ms" Core.time_ms wrap "pr-str" Core.pr_str wrap "str" Core.str wrap "prn" Core.prn wrap "println" Core.println wrap "read-string" Core.read_str 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 wrap "throw" Core.throw wrap "map" Core.map wrap "apply" Core.apply wrap "nil?" (Core.isConst Node.NIL) wrap "true?" (Core.isConst Node.TRUE) wrap "false?" (Core.isConst Node.FALSE) wrap "symbol?" Core.isSymbol wrap "symbol" Core.symbol wrap "string?" Core.isString wrap "keyword?" Core.isKeyword wrap "keyword" Core.keyword wrap "number?" Core.isNumber wrap "fn?" Core.isFn wrap "macro?" Core.isMacro wrap "sequential?" Core.isSequential wrap "vector?" Core.isVector wrap "vector" Core.vector wrap "map?" Core.isMap wrap "hash-map" Core.hashMap wrap "assoc" Core.assoc wrap "dissoc" Core.dissoc wrap "get" Core.get wrap "contains?" Core.contains wrap "keys" Core.keys wrap "vals" Core.vals wrap "atom" (Core.atom getNextValue) wrap "atom?" Core.isAtom wrap "deref" Core.deref wrap "reset!" Core.reset wrap "swap!" Core.swap wrap "conj" Core.conj wrap "seq" Core.seq wrap "meta" Core.meta wrap "with-meta" Core.withMeta ] |> ofList [ env ] let makeNew outer symbols nodes = let env = (makeEmpty ())::outer let rec loop symbols nodes = match symbols, nodes with | [Symbol("&"); Symbol(s)], nodes -> set env s (Node.makeList nodes) env | Symbol("&")::_, _ -> raise <| Error.onlyOneSymbolAfterAmp () | Symbol(s)::symbols, n::nodes -> set env s n loop symbols nodes | [], [] -> env | _, [] -> raise <| Error.notEnoughValues () | [], _ -> raise <| Error.tooManyValues () | _, _ -> raise <| Error.errExpectedX "symbol" loop symbols nodes ================================================ FILE: impls/fsharp/error.fs ================================================ module Error exception ReaderError of string exception EvalError of string exception MalError of Types.Node let expectedXButEOF x = ReaderError(sprintf "Expected %s, got EOF" x) let expectedX x = ReaderError(sprintf "Expected %s" x) let unexpectedChar () = ReaderError("Unexpected char") let invalidToken () = ReaderError("Invalid token") let expectedEvenNodeCount () = EvalError("Expected even node count") let wrongArity () = EvalError("Arity: wrong number of arguments") let argMismatch () = EvalError("Argument mismatch") let symbolNotFound s = EvalError(sprintf "'%s' not found" s) let noEnvironment () = EvalError("No environment") let tooManyValues () = EvalError("Too many values") let notEnoughValues () = EvalError("Not enough values") let onlyOneSymbolAfterAmp () = EvalError("only one symbol after &") let errExpectedX x = EvalError(sprintf "expected %s" x) let indexOutOfBounds () = EvalError("Index out of bounds") ================================================ FILE: impls/fsharp/node.fs ================================================ module Node open Types let TRUE = Bool(true) let SomeTRUE = Some(TRUE) let FALSE = Bool(false) let SomeFALSE = Some(FALSE) let NIL = Nil let SomeNIL = Some(NIL) let ZERO = Number(0L) let makeVector seg = Vector(NIL, seg) let makeList lst = List(NIL, lst) let makeMap map = Map(NIL, map) let EmptyLIST = [] |> makeList let EmptyVECTOR = System.ArraySegment([| |]) |> makeVector let EmptyMAP = Map.empty |> makeMap let ofArray arr = System.ArraySegment(arr) |> makeVector let ofChar chr = sprintf "%c" chr |> String let toArray = function | List(_, lst) -> Array.ofList lst | Vector(_, seg) -> Array.sub seg.Array seg.Offset seg.Count | node -> [| node |] let length = function | List(_, lst) -> List.length lst | Vector(_, seg) -> seg.Count | Map(_, m) -> m.Count | _ -> 1 (* Active Patterns to help with pattern matching nodes *) let inline (|Elements|_|) num node = let rec accumList acc idx lst = let len = Array.length acc match lst with | [] when idx = len -> Some(Elements acc) | h::t when idx < len -> acc.[idx] <- h accumList acc (idx + 1) t | _ -> None match node with | List(_, lst) -> accumList (Array.zeroCreate num) 0 lst | Vector(_, seg) when seg.Count = num -> Some(toArray node) | _ -> None let inline (|Cons|_|) node = match node with | List(_, h::t) -> Some(Cons(h, makeList t)) | Vector(_, seg) when seg.Count > 0 -> let h = seg.Array.[seg.Offset] let t = System.ArraySegment(seg.Array, seg.Offset + 1, seg.Count - 1) |> makeVector Some(Cons(h, t)) | _ -> None let inline (|Empty|_|) node = match node with | List(_, []) -> Some(Empty) | Vector(_, seg) when seg.Count = 0 -> Some(Empty) | _ -> None let inline (|Pair|_|) node = match node with | List(_, a::b::t) -> Some(a, b, makeList t) | List(_, []) -> None | List(_, _) -> raise <| Error.expectedEvenNodeCount () | Vector(_, seg) -> match seg.Count with | 0 -> None | 1 -> raise <| Error.expectedEvenNodeCount () | _ -> let a = seg.Array.[seg.Offset] let b = seg.Array.[seg.Offset + 1] let t = System.ArraySegment(seg.Array, seg.Offset + 2, seg.Count - 2) |> makeVector Some(a, b, t) | _ -> None let inline (|Seq|_|) node = match node with | List(_, lst) -> Some(Seq.ofList lst) | Vector(_, seg) -> Some(seg :> Node seq) | _ -> None ================================================ FILE: impls/fsharp/printer.fs ================================================ module Printer open System.Text open Types type Profile = { Pretty : bool; Separator : string } let pr_str_profile = { Pretty = true; Separator = " " } let str_profile = { Pretty = false; Separator = "" } let prn_profile = { Pretty = true; Separator = " " } let println_profile = { Pretty = false; Separator = " " } let print profile nodes = let acc = StringBuilder() let appendStr (str : string) = acc.Append(str) |> ignore let rec pr_node = function | Nil -> appendStr "nil" | List(_, nodes) -> pr_list nodes | Vector(_, nodes) -> pr_vector nodes | Map(_, map) -> pr_map map | Symbol(symbol) -> appendStr symbol | Keyword(keyword) -> appendStr ":"; appendStr keyword | Number(num) -> acc.Append(num) |> ignore | String(str) when profile.Pretty -> pr_str_pretty str | String(str) -> appendStr str | Bool(true) -> appendStr "true" | Bool(false) -> appendStr "false" | BuiltInFunc(_, tag, _) | Func(_, tag, _, _, _, _) -> pr_func "func" tag | Macro(_, tag, _, _, _, _) -> pr_func "macro" tag | Atom(tag, r) -> pr_atom tag !r and pr separator prefix node = appendStr prefix pr_node node separator and std_pr = pr " " and pr_str_pretty str = let appendChar = function | '\t' -> appendStr "\\t" | '\b' -> appendStr "\\b" | '\n' -> appendStr "\\n" | '\r' -> appendStr "\\r" | '\f' -> appendStr "\\f" | '"' -> appendStr "\\\"" | '\\' -> appendStr "\\\\" | ch -> acc.Append(ch) |> ignore appendStr "\"" str |> Seq.iter appendChar appendStr "\"" and pr_func ftype tag = sprintf "#<%s %d>" ftype tag |> appendStr and pr_atom tag node = appendStr "(atom " pr_node node appendStr ")" and pr_list nodes = appendStr "(" nodes |> List.fold std_pr "" |> ignore appendStr ")" and pr_vector nodes = appendStr "[" nodes |> Seq.fold std_pr "" |> ignore appendStr "]" and pr_map map = let pr prefix key value = appendStr prefix pr_node key appendStr " " pr_node value " " appendStr "{" map |> Map.fold pr "" |> ignore appendStr "}" nodes |> Seq.fold (pr profile.Separator) "" |> ignore acc.ToString() let pr_str : seq -> string = print pr_str_profile let str : seq -> string = print str_profile let prn : seq -> string = print prn_profile let println : seq -> string = print println_profile ================================================ FILE: impls/fsharp/reader.fs ================================================ module Reader open System open Tokenizer open Types open Node type MutableList = System.Collections.Generic.List let inline addToMutableList (lst:MutableList) item = lst.Add(item); lst let quote = Symbol("quote") let quasiquote = Symbol("quasiquote") let unquote = Symbol("unquote") let spliceUnquote = Symbol("splice-unquote") let deref = Symbol("deref") let withMeta = Symbol("with-meta") let rec readForm = function | OpenParen::rest -> readList [] rest | OpenBracket::rest -> readVector (MutableList()) rest | OpenBrace::rest -> readMap [] rest | SingleQuote::rest -> wrapForm quote rest | Backtick::rest -> wrapForm quasiquote rest | Tilde::rest -> wrapForm unquote rest | SpliceUnquote::rest -> wrapForm spliceUnquote rest | At::rest -> wrapForm deref rest | Caret::rest -> readMeta rest | tokens -> readAtom tokens and wrapForm node tokens = match readForm tokens with | Some(form), rest -> Some(makeList [node; form]), rest | None, _ -> raise <| Error.expectedXButEOF "form" and readList acc = function | CloseParen::rest -> Some(acc |> List.rev |> makeList), rest | [] -> raise <| Error.expectedXButEOF "')'" | tokens -> match readForm tokens with | Some(form), rest -> readList (form::acc) rest | None, _ -> raise <| Error.expectedXButEOF "')'" and readVector acc = function | CloseBracket::rest -> Some(acc.ToArray() |> Node.ofArray), rest | [] -> raise <| Error.expectedXButEOF "']'" | tokens -> match readForm tokens with | Some(form), rest -> readVector (addToMutableList acc form) rest | None, _ -> raise <| Error.expectedXButEOF "']'" and readMap acc = function | CloseBrace::rest -> Some(acc |> List.rev |> Map.ofList |> makeMap), rest | [] -> raise <| Error.expectedXButEOF "'}'" | tokens -> match readForm tokens with | Some(key), rest -> match readForm rest with | Some(v), rest -> readMap ((key, v)::acc) rest | None, _ -> raise <| Error.expectedXButEOF "'}'" | None, _ -> raise <| Error.expectedXButEOF "'}'" and readMeta = function | OpenBrace::rest -> let meta, rest = readMap [] rest match readForm rest with | Some(form), rest -> Some([withMeta; form; meta.Value] |> makeList), rest | None, _ -> raise <| Error.expectedXButEOF "form" | _ -> raise <| Error.expectedXButEOF "map" and readAtom = function | Token("nil")::rest -> Node.SomeNIL, rest | Token("true")::rest -> Node.SomeTRUE, rest | Token("false")::rest -> Node.SomeFALSE, rest | Tokenizer.String(str)::rest -> Some(String(str)), rest | Tokenizer.Keyword(kw)::rest -> Some(Keyword(kw)), rest | Tokenizer.Number(num)::rest -> Some(Number(Int64.Parse(num))), rest | Token(sym)::rest -> Some(Symbol(sym)), rest | [] -> None, [] | _ -> raise <| Error.invalidToken () let rec readForms acc = function | [] -> List.rev acc | tokens -> match readForm tokens with | Some(form), rest -> readForms (form::acc) rest | None, rest -> readForms acc rest let read_str str = tokenize str |> readForms [] ================================================ FILE: impls/fsharp/readline.fs ================================================ module Readline open System open Mono.Terminal type Mode = | Terminal | Raw let read prompt = function | Terminal -> let editor = LineEditor("Mal") editor.Edit(prompt, "") | Raw -> Console.Write(prompt) Console.Out.Flush() Console.ReadLine() ================================================ FILE: impls/fsharp/run ================================================ #!/usr/bin/env bash exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" ================================================ FILE: impls/fsharp/step0_repl.fs ================================================ module REPL let READ input = input let EVAL ast = ast let PRINT v = printfn "%s" v let REP input = input |> READ |> EVAL |> PRINT let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let rec main args = let mode = getReadlineMode args match Readline.read "user> " mode with | null -> 0 | input -> REP input main args ================================================ FILE: impls/fsharp/step1_read_print.fs ================================================ module REPL open System let READ input = try Reader.read_str input with | Error.ReaderError(msg) -> printfn "%s" msg [] let EVAL ast = Some(ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let REP input = READ input |> Seq.ofList |> Seq.map (fun form -> EVAL form) |> Seq.filter Option.isSome |> Seq.iter (fun value -> PRINT value.Value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let main args = let mode = getReadlineMode args let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> REP input loop() loop () ================================================ FILE: impls/fsharp/step2_eval.fs ================================================ module REPL open System open Node open Types let rec eval env ast = (* Printer.pr_str [ast] |> printfn "EVAL: %s" *) match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, (a0 :: rest)) -> match eval env a0 with | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let REP env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let main args = let mode = getReadlineMode args let env = Env.makeRootEnv () let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step3_env.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" let rec defBang env = function | [sym; node] -> match sym with | Symbol(sym) -> let node = eval env node Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStar env = function | [bindings; form] -> let newEnv = Env.makeNew env [] [] let binder = setBinding newEnv match bindings with | List(_, _) | Vector(_, _) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" eval newEnv form | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBang env rest | List(_, Symbol("let*")::rest) -> letStar env rest | List(_, (a0 :: rest)) -> match eval env a0 with | BuiltInFunc(_, _, f) -> List.map (eval env) rest |> f | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let REP env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let main args = let mode = getReadlineMode args let env = Env.makeRootEnv () let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step4_if_fn_do.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm env = function | [bindings; form] -> let newEnv = Env.makeNew env [] [] let binder = setBinding newEnv match bindings with | List(_, _) | Vector(_, _) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" eval newEnv form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> eval env falseForm | _ -> eval env trueForm and doForm env = function | [a] -> eval env a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("let*")::rest) -> letStarForm env rest | List(_, Symbol("if")::rest) -> ifForm env rest | List(_, Symbol("do")::rest) -> doForm env rest | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, (a0 :: rest)) -> let args = List.map (eval env) rest match eval env a0 with | BuiltInFunc(_, _, f) -> f args | Func(_, _, _, body, binds, outer) -> let inner = Env.makeNew outer binds args body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let main args = let mode = getReadlineMode args let env = Env.makeRootEnv () RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step5_tco.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_, _) | Vector(_, _)-> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, (a0 :: rest)) -> let args = List.map (eval env) rest match eval env a0 with | BuiltInFunc(_, _, f) -> f args | Func(_, _, _, body, binds, outer) -> let inner = Env.makeNew outer binds args body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal [] let main args = let mode = getReadlineMode args let env = Env.makeRootEnv () RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step6_file.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_, _) | Vector(_, _)-> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, (a0 :: rest)) -> let args = List.map (eval env) rest match eval env a0 with | BuiltInFunc(_, _, f) -> f args | Func(_, _, _, body, binds, outer) -> let inner = Env.makeNew outer binds args body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal let eval_func env = function | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function | file::rest -> rest |> List.map Types.String |> makeList | [] -> EmptyLIST let configureEnv args = let env = Env.makeRootEnv () Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) Env.set env "*ARGV*" <| argv_func args RE env """ (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """ |> Seq.iter ignore env [] let main args = let mode = getReadlineMode args let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq let env = configureEnv args match args with | file::_ -> System.IO.File.ReadAllText file |> RE env |> Seq.iter ignore 0 | _ -> let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step7_quote.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" 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 | _ -> raise <| Error.wrongArity () let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_) | Vector(_) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | 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");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, (a0 :: rest)) -> let args = List.map (eval env) rest match eval env a0 with | BuiltInFunc(_, _, f) -> f args | Func(_, _, _, body, binds, outer) -> let inner = Env.makeNew outer binds args body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal let eval_func env = function | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function | file::rest -> rest |> List.map Types.String |> makeList | [] -> EmptyLIST let configureEnv args = let env = Env.makeRootEnv () Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) Env.set env "*ARGV*" <| argv_func args RE env """ (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) """ |> Seq.iter ignore env [] let main args = let mode = getReadlineMode args let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq let env = configureEnv args match args with | file::_ -> System.IO.File.ReadAllText file |> RE env |> Seq.iter ignore 0 | _ -> let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step8_macros.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" 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 | _ -> raise <| Error.wrongArity () let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and defMacroForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form match node with | Func(_, _, f, body, binds, outer) -> let node = Env.makeMacro f body binds outer Env.set env sym node node | _ -> raise <| Error.errExpectedX "user defined func" | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_) | Vector(_) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | 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");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, (a0 :: args)) -> match eval env a0 with | Macro(_, _, f, _, _, _) -> f args |> eval env | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f | Func(_, _, _, body, binds, outer) -> let inner = List.map (eval env) args |> Env.makeNew outer binds body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal let eval_func env = function | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function | file::rest -> rest |> List.map Types.String |> makeList | [] -> EmptyLIST let configureEnv args = let env = Env.makeRootEnv () Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) Env.set env "*ARGV*" <| argv_func args RE env """ (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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))))))) """ |> Seq.iter ignore env [] let main args = let mode = getReadlineMode args let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq let env = configureEnv args match args with | file::_ -> System.IO.File.ReadAllText file |> RE env |> Seq.iter ignore 0 | _ -> let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/step9_try.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" 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 | _ -> raise <| Error.wrongArity () let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and defMacroForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form match node with | Func(_, _, f, body, binds, outer) -> let node = Env.makeMacro f body binds outer Env.set env sym node node | _ -> raise <| Error.errExpectedX "user defined func" | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_) | Vector(_) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and catchForm env err = function | List(_, [Symbol("catch*"); Symbol(_) as sym; catchBody]) -> let inner = Env.makeNew env [sym] [err] catchBody |> eval inner | List(_, [_; _; _]) -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () and tryForm env = function | [exp] -> eval env exp | [exp; catchClause] -> try eval env exp with | Error.EvalError(str) -> catchForm env (String(str)) catchClause | Error.MalError(node) -> catchForm env node catchClause | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | 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");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest | List(_, (a0 :: args)) -> match eval env a0 with | Macro(_, _, f, _, _, _) -> f args |> eval env | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f | Func(_, _, _, body, binds, outer) -> let inner = List.map (eval env) args |> Env.makeNew outer binds body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal let eval_func env = function | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function | file::rest -> rest |> List.map Types.String |> makeList | [] -> EmptyLIST let configureEnv args = let env = Env.makeRootEnv () Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) Env.set env "*ARGV*" <| argv_func args RE env """ (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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))))))) """ |> Seq.iter ignore env [] let main args = let mode = getReadlineMode args let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq let env = configureEnv args match args with | file::_ -> System.IO.File.ReadAllText file |> RE env |> Seq.iter ignore 0 | _ -> let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | Error.MalError(node) -> printfn "Error: %s" (Printer.pr_str [node]) | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/stepA_mal.fs ================================================ module REPL open System open Node open Types let rec iterPairs f = function | Pair(first, second, t) -> f first second iterPairs f t | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" 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 | _ -> raise <| Error.wrongArity () let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form Env.set env sym node node | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and defMacroForm env = function | [sym; form] -> match sym with | Symbol(sym) -> let node = eval env form match node with | Func(_, _, f, body, binds, outer) -> let node = Env.makeMacro f body binds outer Env.set env sym node node | _ -> raise <| Error.errExpectedX "user defined func" | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () and setBinding env first second = let s = match first with | Symbol(s) -> s | _ -> raise <| Error.errExpectedX "symbol" let form = eval env second Env.set env s form and letStarForm outer = function | [bindings; form] -> let inner = Env.makeNew outer [] [] let binder = setBinding inner match bindings with | List(_) | Vector(_) -> iterPairs binder bindings | _ -> raise <| Error.errExpectedX "list or vector" inner, form | _ -> raise <| Error.wrongArity () and ifForm env = function | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | _ -> raise <| Error.wrongArity () and ifForm3 env condForm trueForm falseForm = match eval env condForm with | Bool(false) | Nil -> falseForm | _ -> trueForm and doForm env = function | [a] -> a | a::rest -> eval env a |> ignore doForm env rest | _ -> raise <| Error.wrongArity () and fnStarForm outer nodes = let makeFunc binds body = let f = fun nodes -> let inner = Env.makeNew outer binds nodes eval inner body Env.makeFunc f body binds outer match nodes with | [List(_, binds); body] -> makeFunc binds body | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" | _ -> raise <| Error.wrongArity () and catchForm env err = function | List(_, [Symbol("catch*"); Symbol(_) as sym; catchBody]) -> let inner = Env.makeNew env [sym] [err] catchBody |> eval inner | List(_, [_; _; _]) -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () and tryForm env = function | [exp] -> eval env exp | [exp; catchClause] -> try eval env exp with | Error.EvalError(str) | Error.ReaderError(str) -> catchForm env (String(str)) catchClause | Error.MalError(node) -> catchForm env node catchClause | _ -> raise <| Error.wrongArity () and eval env ast = ignore <| match Env.get env "DEBUG-EVAL" with | None | Some(Bool(false)) | Some(Nil) -> () | _ -> Printer.pr_str [ast] |> printfn "EVAL: %s" match ast with | Symbol(sym) -> match Env.get env sym with | Some(value) -> value | None -> Error.symbolNotFound sym |> raise | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env | 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");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest | List(_, (a0 :: args)) -> match eval env a0 with | Macro(_, _, f, _, _, _) -> f args |> eval env | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f | Func(_, _, _, body, binds, outer) -> let inner = List.map (eval env) args |> Env.makeNew outer binds body |> eval inner | _ -> raise <| Error.errExpectedX "func" | _ -> ast let READ input = Reader.read_str input let EVAL env ast = Some(eval env ast) let PRINT v = v |> Seq.singleton |> Printer.pr_str |> printfn "%s" let RE env input = READ input |> Seq.ofList |> Seq.choose (fun form -> EVAL env form) let REP env input = input |> RE env |> Seq.iter (fun value -> PRINT value) let getReadlineMode args = if args |> Array.exists (fun e -> e = "--raw") then Readline.Mode.Raw else Readline.Mode.Terminal let eval_func env = function | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function | file::rest -> rest |> List.map Types.String |> makeList | [] -> EmptyLIST let readline_func mode = function | [String(prompt)] -> match Readline.read prompt mode with | null -> Node.NIL | input -> String(input) | [_] -> raise <| Error.argMismatch () | _ -> raise <| Error.wrongArity () let configureEnv args mode = let env = Env.makeRootEnv () Env.set env "eval" <| Env.makeBuiltInFunc (eval_func env) Env.set env "*ARGV*" <| argv_func args Env.set env "readline" <| Env.makeBuiltInFunc (readline_func mode) RE env """ (def! *host-language* "fsharp") (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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))))))) """ |> Seq.iter ignore env [] let main args = let mode = getReadlineMode args let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq let env = configureEnv args mode match args with | file::_ -> System.IO.File.ReadAllText file |> RE env |> Seq.iter ignore 0 | _ -> RE env "(println (str \"Mal [\" *host-language* \"]\"))" |> Seq.iter ignore let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> try REP env input with | Error.EvalError(str) | Error.ReaderError(str) -> printfn "Error: %s" str | Error.MalError(node) -> printfn "Error: %s" (Printer.pr_str [node]) | ex -> printfn "Error: %s" (ex.Message) loop () loop () ================================================ FILE: impls/fsharp/terminal.cs ================================================ // // getline.cs: A command line editor // // Authors: // Miguel de Icaza (miguel@novell.com) // // Copyright 2008 Novell, Inc. // // Dual-licensed under the terms of the MIT X11 license or the // Apache License 2.0 // // USE -define:DEMO to build this as a standalone file and test it // // TODO: // Enter an error (a = 1); Notice how the prompt is in the wrong line // This is caused by Stderr not being tracked by System.Console. // Completion support // Why is Thread.Interrupt not working? Currently I resort to Abort which is too much. // // Limitations in System.Console: // Console needs SIGWINCH support of some sort // Console needs a way of updating its position after things have been written // behind its back (P/Invoke puts for example). // System.Console needs to get the DELETE character, and report accordingly. // using System; using System.Text; using System.IO; using System.Threading; using System.Reflection; namespace Mono.Terminal { public class LineEditor { public class Completion { public string [] Result; public string Prefix; public Completion (string prefix, string [] result) { Prefix = prefix; Result = result; } } public delegate Completion AutoCompleteHandler (string text, int pos); //static StreamWriter log; // The text being edited. StringBuilder text; // The text as it is rendered (replaces (char)1 with ^A on display for example). StringBuilder rendered_text; // The prompt specified, and the prompt shown to the user. string prompt; string shown_prompt; // The current cursor position, indexes into "text", for an index // into rendered_text, use TextToRenderPos int cursor; // The row where we started displaying data. int home_row; // The maximum length that has been displayed on the screen int max_rendered; // If we are done editing, this breaks the interactive loop bool done = false; // The thread where the Editing started taking place Thread edit_thread; // Our object that tracks history History history; // The contents of the kill buffer (cut/paste in Emacs parlance) string kill_buffer = ""; // The string being searched for string search; string last_search; // whether we are searching (-1= reverse; 0 = no; 1 = forward) int searching; // The position where we found the match. int match_at; // Used to implement the Kill semantics (multiple Alt-Ds accumulate) KeyHandler last_handler; delegate void KeyHandler (); struct Handler { public ConsoleKeyInfo CKI; public KeyHandler KeyHandler; public Handler (ConsoleKey key, KeyHandler h) { CKI = new ConsoleKeyInfo ((char) 0, key, false, false, false); KeyHandler = h; } public Handler (char c, KeyHandler h) { KeyHandler = h; // Use the "Zoom" as a flag that we only have a character. CKI = new ConsoleKeyInfo (c, ConsoleKey.Zoom, false, false, false); } public Handler (ConsoleKeyInfo cki, KeyHandler h) { CKI = cki; KeyHandler = h; } public static Handler Control (char c, KeyHandler h) { return new Handler ((char) (c - 'A' + 1), h); } public static Handler Alt (char c, ConsoleKey k, KeyHandler h) { ConsoleKeyInfo cki = new ConsoleKeyInfo ((char) c, k, false, true, false); return new Handler (cki, h); } } /// /// Invoked when the user requests auto-completion using the tab character /// /// /// The result is null for no values found, an array with a single /// string, in that case the string should be the text to be inserted /// for example if the word at pos is "T", the result for a completion /// of "ToString" should be "oString", not "ToString". /// /// When there are multiple results, the result should be the full /// text /// public AutoCompleteHandler AutoCompleteEvent; static Handler [] handlers; public LineEditor (string name) : this (name, 10) { } public LineEditor (string name, int histsize) { handlers = new Handler [] { new Handler (ConsoleKey.Home, CmdHome), new Handler (ConsoleKey.End, CmdEnd), new Handler (ConsoleKey.LeftArrow, CmdLeft), new Handler (ConsoleKey.RightArrow, CmdRight), new Handler (ConsoleKey.UpArrow, CmdHistoryPrev), new Handler (ConsoleKey.DownArrow, CmdHistoryNext), new Handler (ConsoleKey.Enter, CmdDone), new Handler (ConsoleKey.Backspace, CmdBackspace), new Handler (ConsoleKey.Delete, CmdDeleteChar), new Handler (ConsoleKey.Tab, CmdTabOrComplete), // Emacs keys Handler.Control ('A', CmdHome), Handler.Control ('E', CmdEnd), Handler.Control ('B', CmdLeft), Handler.Control ('F', CmdRight), Handler.Control ('P', CmdHistoryPrev), Handler.Control ('N', CmdHistoryNext), Handler.Control ('K', CmdKillToEOF), Handler.Control ('Y', CmdYank), Handler.Control ('D', CmdDeleteChar), Handler.Control ('L', CmdRefresh), Handler.Control ('R', CmdReverseSearch), Handler.Control ('G', delegate {} ), Handler.Alt ('B', ConsoleKey.B, CmdBackwardWord), Handler.Alt ('F', ConsoleKey.F, CmdForwardWord), Handler.Alt ('D', ConsoleKey.D, CmdDeleteWord), Handler.Alt ((char) 8, ConsoleKey.Backspace, CmdDeleteBackword), // DEBUG //Handler.Control ('T', CmdDebug), // quote Handler.Control ('Q', delegate { HandleChar (Console.ReadKey (true).KeyChar); }) }; rendered_text = new StringBuilder (); text = new StringBuilder (); history = new History (name, histsize); //if (File.Exists ("log"))File.Delete ("log"); //log = File.CreateText ("log"); } void CmdDebug () { history.Dump (); Console.WriteLine (); Render (); } void Render () { Console.Write (shown_prompt); Console.Write (rendered_text); int max = System.Math.Max (rendered_text.Length + shown_prompt.Length, max_rendered); for (int i = rendered_text.Length + shown_prompt.Length; i < max_rendered; i++) Console.Write (' '); max_rendered = shown_prompt.Length + rendered_text.Length; // Write one more to ensure that we always wrap around properly if we are at the // end of a line. Console.Write (' '); UpdateHomeRow (max); } void UpdateHomeRow (int screenpos) { int lines = 1 + (screenpos / Console.WindowWidth); home_row = Console.CursorTop - (lines - 1); if (home_row < 0) home_row = 0; } void RenderFrom (int pos) { int rpos = TextToRenderPos (pos); int i; for (i = rpos; i < rendered_text.Length; i++) Console.Write (rendered_text [i]); if ((shown_prompt.Length + rendered_text.Length) > max_rendered) max_rendered = shown_prompt.Length + rendered_text.Length; else { int max_extra = max_rendered - shown_prompt.Length; for (; i < max_extra; i++) Console.Write (' '); } } void ComputeRendered () { rendered_text.Length = 0; for (int i = 0; i < text.Length; i++){ int c = (int) text [i]; if (c < 26){ if (c == '\t') rendered_text.Append (" "); else { rendered_text.Append ('^'); rendered_text.Append ((char) (c + (int) 'A' - 1)); } } else rendered_text.Append ((char)c); } } int TextToRenderPos (int pos) { int p = 0; for (int i = 0; i < pos; i++){ int c; c = (int) text [i]; if (c < 26){ if (c == 9) p += 4; else p += 2; } else p++; } return p; } int TextToScreenPos (int pos) { return shown_prompt.Length + TextToRenderPos (pos); } string Prompt { get { return prompt; } set { prompt = value; } } int LineCount { get { return (shown_prompt.Length + rendered_text.Length)/Console.WindowWidth; } } void ForceCursor (int newpos) { cursor = newpos; int actual_pos = shown_prompt.Length + TextToRenderPos (cursor); int row = home_row + (actual_pos/Console.WindowWidth); int col = actual_pos % Console.WindowWidth; if (row >= Console.BufferHeight) row = Console.BufferHeight-1; Console.SetCursorPosition (col, row); //log.WriteLine ("Going to cursor={0} row={1} col={2} actual={3} prompt={4} ttr={5} old={6}", newpos, row, col, actual_pos, prompt.Length, TextToRenderPos (cursor), cursor); //log.Flush (); } void UpdateCursor (int newpos) { if (cursor == newpos) return; ForceCursor (newpos); } void InsertChar (char c) { int prev_lines = LineCount; text = text.Insert (cursor, c); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); ForceCursor (++cursor); } else { RenderFrom (cursor); ForceCursor (++cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } // // Commands // void CmdDone () { done = true; } void CmdTabOrComplete () { bool complete = false; if (AutoCompleteEvent != null){ if (TabAtStartCompletes) complete = true; else { for (int i = 0; i < cursor; i++){ if (!Char.IsWhiteSpace (text [i])){ complete = true; break; } } } if (complete){ Completion completion = AutoCompleteEvent (text.ToString (), cursor); string [] completions = completion.Result; if (completions == null) return; int ncompletions = completions.Length; if (ncompletions == 0) return; if (completions.Length == 1){ InsertTextAtCursor (completions [0]); } else { int last = -1; for (int p = 0; p < completions [0].Length; p++){ char c = completions [0][p]; for (int i = 1; i < ncompletions; i++){ if (completions [i].Length < p) goto mismatch; if (completions [i][p] != c){ goto mismatch; } } last = p; } mismatch: if (last != -1){ InsertTextAtCursor (completions [0].Substring (0, last+1)); } Console.WriteLine (); foreach (string s in completions){ Console.Write (completion.Prefix); Console.Write (s); Console.Write (' '); } Console.WriteLine (); Render (); ForceCursor (cursor); } } else HandleChar ('\t'); } else HandleChar ('t'); } void CmdHome () { UpdateCursor (0); } void CmdEnd () { UpdateCursor (text.Length); } void CmdLeft () { if (cursor == 0) return; UpdateCursor (cursor-1); } void CmdBackwardWord () { int p = WordBackward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdForwardWord () { int p = WordForward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdRight () { if (cursor == text.Length) return; UpdateCursor (cursor+1); } void RenderAfter (int p) { ForceCursor (p); RenderFrom (p); ForceCursor (cursor); } void CmdBackspace () { if (cursor == 0) return; text.Remove (--cursor, 1); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteChar () { // If there is no input, this behaves like EOF if (text.Length == 0){ done = true; text = null; Console.WriteLine (); return; } if (cursor == text.Length) return; text.Remove (cursor, 1); ComputeRendered (); RenderAfter (cursor); } int WordForward (int p) { if (p >= text.Length) return -1; int i = p; if (Char.IsPunctuation (text [p]) || Char.IsSymbol (text [p]) || Char.IsWhiteSpace (text[p])){ for (; i < text.Length; i++){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } else { for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } if (i != p) return i; return -1; } int WordBackward (int p) { if (p == 0) return -1; int i = p-1; if (i == 0) return 0; if (Char.IsPunctuation (text [i]) || Char.IsSymbol (text [i]) || Char.IsWhiteSpace (text[i])){ for (; i >= 0; i--){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text[i])) break; } } else { for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text [i])) break; } } i++; if (i != p) return i; return -1; } void CmdDeleteWord () { int pos = WordForward (cursor); if (pos == -1) return; string k = text.ToString (cursor, pos-cursor); if (last_handler == CmdDeleteWord) kill_buffer = kill_buffer + k; else kill_buffer = k; text.Remove (cursor, pos-cursor); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteBackword () { int pos = WordBackward (cursor); if (pos == -1) return; string k = text.ToString (pos, cursor-pos); if (last_handler == CmdDeleteBackword) kill_buffer = k + kill_buffer; else kill_buffer = k; text.Remove (pos, cursor-pos); ComputeRendered (); RenderAfter (pos); } // // Adds the current line to the history if needed // void HistoryUpdateLine () { history.Update (text.ToString ()); } void CmdHistoryPrev () { if (!history.PreviousAvailable ()) return; HistoryUpdateLine (); SetText (history.Previous ()); } void CmdHistoryNext () { if (!history.NextAvailable()) return; history.Update (text.ToString ()); SetText (history.Next ()); } void CmdKillToEOF () { kill_buffer = text.ToString (cursor, text.Length-cursor); text.Length = cursor; ComputeRendered (); RenderAfter (cursor); } void CmdYank () { InsertTextAtCursor (kill_buffer); } void InsertTextAtCursor (string str) { int prev_lines = LineCount; text.Insert (cursor, str); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); cursor += str.Length; ForceCursor (cursor); } else { RenderFrom (cursor); cursor += str.Length; ForceCursor (cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } void SetSearchPrompt (string s) { SetPrompt ("(reverse-i-search)`" + s + "': "); } void ReverseSearch () { int p; if (cursor == text.Length){ // The cursor is at the end of the string p = text.ToString ().LastIndexOf (search); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } else { // The cursor is somewhere in the middle of the string int start = (cursor == match_at) ? cursor - 1 : cursor; if (start != -1){ p = text.ToString ().LastIndexOf (search, start); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } } // Need to search backwards in history HistoryUpdateLine (); string s = history.SearchBackward (search); if (s != null){ match_at = -1; SetText (s); ReverseSearch (); } } void CmdReverseSearch () { if (searching == 0){ match_at = -1; last_search = search; searching = -1; search = ""; SetSearchPrompt (""); } else { if (search == ""){ if (last_search != "" && last_search != null){ search = last_search; SetSearchPrompt (search); ReverseSearch (); } return; } ReverseSearch (); } } void SearchAppend (char c) { search = search + c; SetSearchPrompt (search); // // If the new typed data still matches the current text, stay here // if (cursor < text.Length){ string r = text.ToString (cursor, text.Length - cursor); if (r.StartsWith (search)) return; } ReverseSearch (); } void CmdRefresh () { Console.Clear (); max_rendered = 0; Render (); ForceCursor (cursor); } void InterruptEdit (object sender, ConsoleCancelEventArgs a) { // Do not abort our program: a.Cancel = true; // Interrupt the editor edit_thread.Abort(); } void HandleChar (char c) { if (searching != 0) SearchAppend (c); else InsertChar (c); } void EditLoop () { ConsoleKeyInfo cki; while (!done){ ConsoleModifiers mod; cki = Console.ReadKey (true); if (cki.Key == ConsoleKey.Escape){ cki = Console.ReadKey (true); mod = ConsoleModifiers.Alt; } else mod = cki.Modifiers; bool handled = false; foreach (Handler handler in handlers){ ConsoleKeyInfo t = handler.CKI; if (t.Key == cki.Key && t.Modifiers == mod){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } else if (t.KeyChar == cki.KeyChar && t.Key == ConsoleKey.Zoom){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } } if (handled){ if (searching != 0){ if (last_handler != CmdReverseSearch){ searching = 0; SetPrompt (prompt); } } continue; } if (cki.KeyChar != (char) 0) HandleChar (cki.KeyChar); } } void InitText (string initial) { text = new StringBuilder (initial); ComputeRendered (); cursor = text.Length; Render (); ForceCursor (cursor); } void SetText (string newtext) { Console.SetCursorPosition (0, home_row); InitText (newtext); } void SetPrompt (string newprompt) { shown_prompt = newprompt; Console.SetCursorPosition (0, home_row); Render (); ForceCursor (cursor); } public string Edit (string prompt, string initial) { edit_thread = Thread.CurrentThread; searching = 0; Console.CancelKeyPress += InterruptEdit; done = false; history.CursorToEnd (); max_rendered = 0; Prompt = prompt; shown_prompt = prompt; InitText (initial); history.Append (initial); do { try { EditLoop (); } catch (ThreadAbortException){ searching = 0; Thread.ResetAbort (); Console.WriteLine (); SetPrompt (prompt); SetText (""); } } while (!done); Console.WriteLine (); Console.CancelKeyPress -= InterruptEdit; if (text == null){ history.Close (); return null; } string result = text.ToString (); if (result != "") history.Accept (result); else history.RemoveLast (); return result; } public void SaveHistory () { if (history != null) { history.Close (); } } public bool TabAtStartCompletes { get; set; } // // Emulates the bash-like behavior, where edits done to the // history are recorded // class History { string [] history; int head, tail; int cursor, count; string histfile; public History (string app, int size) { if (size < 1) throw new ArgumentException ("size"); if (app != null){ string dir = Environment.GetFolderPath (Environment.SpecialFolder.Personal); //Console.WriteLine (dir); /* if (!Directory.Exists (dir)){ try { Directory.CreateDirectory (dir); } catch { app = null; } } if (app != null) histfile = Path.Combine (dir, app) + ".history"; */ histfile = Path.Combine (dir, ".mal-history"); } history = new string [size]; head = tail = cursor = 0; if (File.Exists (histfile)){ using (StreamReader sr = File.OpenText (histfile)){ string line; while ((line = sr.ReadLine ()) != null){ if (line != "") Append (line); } } } } public void Close () { if (histfile == null) return; try { using (StreamWriter sw = File.CreateText (histfile)){ int start = (count == history.Length) ? head : tail; for (int i = start; i < start+count; i++){ int p = i % history.Length; sw.WriteLine (history [p]); } } } catch { // ignore } } // // Appends a value to the history // public void Append (string s) { //Console.WriteLine ("APPENDING {0} head={1} tail={2}", s, head, tail); history [head] = s; head = (head+1) % history.Length; if (head == tail) tail = (tail+1 % history.Length); if (count != history.Length) count++; //Console.WriteLine ("DONE: head={1} tail={2}", s, head, tail); } // // Updates the current cursor location with the string, // to support editing of history items. For the current // line to participate, an Append must be done before. // public void Update (string s) { history [cursor] = s; } public void RemoveLast () { head = head-1; if (head < 0) head = history.Length-1; } public void Accept (string s) { int t = head-1; if (t < 0) t = history.Length-1; history [t] = s; } public bool PreviousAvailable () { //Console.WriteLine ("h={0} t={1} cursor={2}", head, tail, cursor); if (count == 0) return false; int next = cursor-1; if (next < 0) next = count-1; if (next == head) return false; return true; } public bool NextAvailable () { if (count == 0) return false; int next = (cursor + 1) % history.Length; if (next == head) return false; return true; } // // Returns: a string with the previous line contents, or // nul if there is no data in the history to move to. // public string Previous () { if (!PreviousAvailable ()) return null; cursor--; if (cursor < 0) cursor = history.Length - 1; return history [cursor]; } public string Next () { if (!NextAvailable ()) return null; cursor = (cursor + 1) % history.Length; return history [cursor]; } public void CursorToEnd () { if (head == tail) return; cursor = head; } public void Dump () { Console.WriteLine ("Head={0} Tail={1} Cursor={2} count={3}", head, tail, cursor, count); for (int i = 0; i < history.Length;i++){ Console.WriteLine (" {0} {1}: {2}", i == cursor ? "==>" : " ", i, history[i]); } //log.Flush (); } public string SearchBackward (string term) { for (int i = 0; i < count; i++){ int slot = cursor-i-1; if (slot < 0) slot = history.Length+slot; if (slot >= history.Length) slot = 0; if (history [slot] != null && history [slot].IndexOf (term) != -1){ cursor = slot; return history [slot]; } } return null; } } } #if DEMO class Demo { static void Main () { LineEditor le = new LineEditor ("foo"); string s; while ((s = le.Edit ("shell> ", "")) != null){ Console.WriteLine ("----> [{0}]", s); } } } #endif } ================================================ FILE: impls/fsharp/tests/step5_tco.mal ================================================ ;; F#: skipping non-TCO recursion ;; Reason: completes at 10,000, unrecoverable segfault at 20,000 ================================================ FILE: impls/fsharp/tokenizer.fs ================================================ module Tokenizer open System open Types type Token = | EOF | OpenBracket | CloseBracket | OpenBrace | CloseBrace | OpenParen | CloseParen | SingleQuote | Backtick | Tilde | SpliceUnquote | Caret | At | String of string | Token of string | Keyword of string | Number of string let tokenize (str : string) = let len = str.Length let inline isWhiteSpace ch = ch = ',' || Char.IsWhiteSpace(ch) let inline isNotNewline ch = ch <> '\r' && ch <> '\n' let inline isDigit ch = Char.IsDigit(ch) let inline isTokenChar ch = match ch with | '[' | ']' | '{' | '}' | '(' | ')' | '\'' | '"' | '`' | ',' | ';' -> false | ch when Char.IsWhiteSpace(ch) -> false | _ -> true let rec skipWhile pred p = if p >= len then p elif pred (str.[p]) then p + 1 |> skipWhile pred else p let rec accumulateWhile pred (f : string -> Token) start p = if p >= len then str.Substring(start, p - start) |> f, p elif pred (str.[p]) then p + 1 |> accumulateWhile pred f start else str.Substring(start, p - start) |> f, p let accumulateString p = let b = System.Text.StringBuilder() let rec accChar (ch : char) n = b.Append(ch) |> ignore accChars n and accChars p = let n = p + 1 if p >= len then raise <| Error.expectedXButEOF "'\"'" match str.[p] with | '\\' -> accEscaped n | '"' -> n | ch -> accChar ch n and accEscaped p = let n = p + 1 if p >= len then raise <| Error.expectedXButEOF "char" match str.[p] with | 't' -> accChar '\t' n | 'b' -> accChar '\b' n | 'n' -> accChar '\n' n | 'r' -> accChar '\r' n | 'f' -> accChar '\f' n | '\'' -> accChar '\'' n | '"' -> accChar '"' n | '\\' -> accChar '\\' n | _ -> raise <| Error.expectedXButEOF "valid escape char" let n = accChars p String(b.ToString()), n let accumulateKeyword p = let n = p + 1 if p >= len then raise <| Error.expectedXButEOF "keyword" elif isTokenChar str.[p] then accumulateWhile isTokenChar Keyword p n else raise <| Error.expectedX "keyword char" let accumulateSpliceUnquote p = if p >= len then Tilde, p elif str.[p] = '@' then SpliceUnquote, (p + 1) else Tilde, p let rec getToken p = if p >= len then EOF, p else let n = p + 1 match str.[p] with | ch when isWhiteSpace ch -> getToken n | ';' -> skipWhile isNotNewline n |> getToken | '[' -> OpenBracket, n | ']' -> CloseBracket, n | '{' -> OpenBrace, n | '}' -> CloseBrace, n | '(' -> OpenParen, n | ')' -> CloseParen, n | '\'' -> SingleQuote, n | '`' -> Backtick, n | '~' -> accumulateSpliceUnquote n | '^' -> Caret, n | '@' -> At, n | '"' -> accumulateString n | ':' -> accumulateKeyword n | '-' when n < len && isDigit str.[n] -> accumulateWhile isDigit Number p n | ch when isDigit ch -> accumulateWhile isDigit Number p n | ch when isTokenChar ch -> accumulateWhile isTokenChar Token p n | _ -> raise <| Error.unexpectedChar () let rec accumulate acc p = match getToken p with | EOF, p -> List.rev acc | tok, p -> accumulate (tok::acc) p accumulate [] 0 ================================================ FILE: impls/fsharp/types.fs ================================================ module Types [] type Node = | Nil | List of Metadata * Node list | Vector of Metadata * Node System.ArraySegment | Map of Metadata * Collections.Map | Symbol of string | Keyword of string | Number of int64 | String of string | Bool of bool | BuiltInFunc of Metadata * int * (Node list -> Node) | Func of Metadata * int * (Node list -> Node) * Node * Node list * EnvChain | Macro of Metadata * int * (Node list -> Node) * Node * Node list * EnvChain | Atom of int * Node Ref static member private hashSeq (s : seq) = let iter st node = (st * 397) ^^^ node.GetHashCode() s |> Seq.fold iter 0 static member private allEqual (x : seq) (y : seq) = use ex = x.GetEnumerator() use ey = y.GetEnumerator() let rec loop () = match ex.MoveNext(), ey.MoveNext() with | false, false -> true | false, true | true, false -> false | true, true -> if ex.Current = ey.Current then loop () else false loop () static member private allCompare (x : seq) (y : seq) = use ex = x.GetEnumerator() use ey = y.GetEnumerator() let rec loop () = match ex.MoveNext(), ey.MoveNext() with | false, false -> 0 | false, true -> -1 | true, false -> 1 | true, true -> let cmp = compare ex.Current ey.Current if cmp = 0 then loop () else cmp loop () static member private rank x = match x with | Nil -> 0 | List(_, _) -> 1 | Vector(_, _) -> 2 | Map(_, _) -> 3 | Symbol(_) -> 4 | Keyword(_) -> 5 | Number(_) -> 6 | String(_) -> 7 | Bool(_) -> 8 | BuiltInFunc(_, _, _) | Func(_, _, _, _, _, _) | Macro(_, _, _, _, _, _) -> 9 | Atom(_, _) -> 10 static member private equals x y = match x, y with | Nil, Nil -> true | List(_, a), List(_, b) -> a = b | List(_, a), Vector(_, b) -> Node.allEqual a b | Vector(_, a), List(_, b) -> Node.allEqual a b | Vector(_, a), Vector(_, b) -> Node.allEqual a b | Map(_, a), Map(_, b) -> a = b | Symbol(a), Symbol(b) -> a = b | Keyword(a), Keyword(b) -> a = b | Number(a), Number(b) -> a = b | String(a), String(b) -> a = b | Bool(a), Bool(b) -> a = b | (BuiltInFunc(_, a, _) | Func(_, a, _, _, _, _) | Macro(_, a, _, _, _, _)), (BuiltInFunc(_, b, _) | Func(_, b, _, _, _, _) | Macro(_, b, _, _, _, _)) -> a = b | Atom(a, _), Atom(b, _) -> a = b | _, _ -> false static member private compare x y = match x, y with | Nil, Nil -> 0 | List(_, a), List(_, b) -> compare a b | List(_, a), Vector(_, b) -> Node.allCompare a b | Vector(_, a), List(_, b) -> Node.allCompare a b | Vector(_, a), Vector(_, b) -> Node.allCompare a b | Map(_, a), Map(_, b) -> compare a b | Symbol(a), Symbol(b) -> compare a b | Keyword(a), Keyword(b) -> compare a b | Number(a), Number(b) -> compare a b | String(a), String(b) -> compare a b | Bool(a), Bool(b) -> compare a b | (BuiltInFunc(_, a, _) | Func(_, a, _, _, _, _) | Macro(_, a, _, _, _, _)), (BuiltInFunc(_, b, _) | Func(_, b, _, _, _, _) | Macro(_, b, _, _, _, _)) -> compare a b | Atom(a, _), Atom(b, _) -> compare a b | a, b -> compare (Node.rank a) (Node.rank b) override x.Equals yobj = match yobj with | :? Node as y -> Node.equals x y | _ -> false override x.GetHashCode() = match x with | Nil -> 0 | List(_, lst) -> hash lst | Vector(_, vec) -> Node.hashSeq vec | Map(_, map) -> hash map | Symbol(sym) -> hash sym | Keyword(key) -> hash key | Number(num) -> hash num | String(str) -> hash str | Bool(b) -> hash b | BuiltInFunc(_, tag, _) | Func(_, tag, _, _, _, _) | Macro(_, tag, _, _, _, _) -> hash tag | Atom(tag, _) -> hash tag interface System.IComparable with member x.CompareTo yobj = match yobj with | :? Node as y -> Node.compare x y | _ -> invalidArg "yobj" "Cannot compare values of different types." and Env = System.Collections.Generic.Dictionary and EnvChain = Env list and Metadata = Node ================================================ FILE: impls/gnu-smalltalk/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install gnu-smalltalk libreadline-dev ================================================ FILE: impls/gnu-smalltalk/Makefile ================================================ all: clean: ================================================ FILE: impls/gnu-smalltalk/core.st ================================================ Object subclass: Core [ Ns := Dictionary new. Core class >> Ns [ ^Ns ] Core class >> coerce: block [ block value ifTrue: [ ^MALObject True ] ifFalse: [ ^MALObject False ] ] Core class >> nilable: args else: block [ args first type = #nil ifTrue: [ ^MALObject Nil ] ifFalse: [ ^block value ] ] Core class >> printedArgs: args readable: readable sep: sep [ | items | items := args collect: [ :arg | Printer prStr: arg printReadably: readable ]. "NOTE: {} join returns the unchanged array" items isEmpty ifTrue: [ ^'' ] ifFalse: [ ^items join: sep ] ] ] Core Ns at: #+ put: (Fn new: [ :args | MALNumber new: args first value + args second value ]). Core Ns at: #- put: (Fn new: [ :args | MALNumber new: args first value - args second value ]). Core Ns at: #* put: (Fn new: [ :args | MALNumber new: args first value * args second value ]). Core Ns at: #/ put: (Fn new: [ :args | MALNumber new: args first value // args second value ]). Core Ns at: #'pr-str' put: (Fn new: [ :args | MALString new: (Core printedArgs: args readable: true sep: ' ') ]). Core Ns at: #str put: (Fn new: [ :args | MALString new: (Core printedArgs: args readable: false sep: '') ]). Core Ns at: #prn put: (Fn new: [ :args | (Core printedArgs: args readable: true sep: ' ') displayNl. MALObject Nil ]). Core Ns at: #println put: (Fn new: [ :args | (Core printedArgs: args readable: false sep: ' ') displayNl. MALObject Nil ]). Core Ns at: #list put: (Fn new: [ :args | MALList new: (OrderedCollection from: args) ]). Core Ns at: #'list?' put: (Fn new: [ :args | Core coerce: [ args first type = #list ] ]). Core Ns at: #'empty?' put: (Fn new: [ :args | Core coerce: [ args first value isEmpty ] ]). Core Ns at: #count put: (Fn new: [ :args | MALNumber new: args first value size ]). Core Ns at: #= put: (Fn new: [ :args | Core coerce: [ args first = args second ] ]). Core Ns at: #< put: (Fn new: [ :args | Core coerce: [ args first value < args second value ] ]). Core Ns at: #<= put: (Fn new: [ :args | Core coerce: [ args first value <= args second value ] ]). Core Ns at: #> put: (Fn new: [ :args | Core coerce: [ args first value > args second value ] ]). Core Ns at: #>= put: (Fn new: [ :args | Core coerce: [ args first value >= args second value ] ]). Core Ns at: #'read-string' put: (Fn new: [ :args | Reader readStr: args first value ]). Core Ns at: #slurp put: (Fn new: [ :args | MALString new: (File path: args first value) contents ]). Core Ns at: #throw put: (Fn new: [ :args | MALCustomError new signal: args first ]). Core Ns at: #readline put: (Fn new: [ :args | | result | result := ReadLine readLine: args first value. result isString ifTrue: [ MALString new: result ] ifFalse: [ MALObject Nil ] ]). Core Ns at: #'time-ms' put: (Fn new: [ :args | MALNumber new: Time millisecondClock ]). Core Ns at: #'gst-eval' put: (Fn new: [ :args | (Behavior evaluate: args first value) toMALValue ]). Core Ns at: #atom put: (Fn new: [ :args | MALAtom new: args first ]). Core Ns at: #'atom?' put: (Fn new: [ :args | Core coerce: [ args first type = #atom ] ]). Core Ns at: #deref put: (Fn new: [ :args | args first value ]). Core Ns at: #'reset!' put: (Fn new: [ :args | args first value: args second. args second ]). Core Ns at: #'swap!' put: (Fn new: [ :args | | a f x xs result | a := args first. f := args second fn. x := a value. xs := args allButFirst: 2. result := f value: (xs copyWithFirst: x). a value: result. result ]). Core Ns at: #cons put: (Fn new: [ :args | MALList new: (args second value copyWithFirst: args first) ]). Core Ns at: #concat put: (Fn new: [ :args | MALList new: (OrderedCollection join: (args collect: [ :arg | arg value ])) ]). Core Ns at: #nth put: (Fn new: [ :args | | items index | items := args first value. index := args second value + 1. items at: index ifAbsent: [ MALOutOfBounds new signal ] ]). Core Ns at: #first put: (Fn new: [ :args | Core nilable: args else: [ args first value at: 1 ifAbsent: [ MALObject Nil ] ] ]). Core Ns at: #rest put: (Fn new: [ :args | | items rest | items := args first value. (args first type = #nil or: [ items isEmpty ]) ifTrue: [ rest := {} ] ifFalse: [ rest := items allButFirst ]. MALList new: (OrderedCollection from: rest) ]). Core Ns at: #conj put: (Fn new: [ :args | | kind result items | kind := args first type. result := args first value. items := args allButFirst. kind = #list ifTrue: [ MALList new: (OrderedCollection from: items reverse, result) ] ifFalse: [ MALVector new: (OrderedCollection from: result, items) ] ]). Core Ns at: #seq put: (Fn new: [ :args | | kind storage result | kind := args first type. storage := args first value. Core nilable: args else: [ storage isEmpty ifTrue: [ MALObject Nil ] ifFalse: [ kind = #string ifTrue: [ result := (OrderedCollection from: storage) collect: [ :char | MALString new: char asString ]. MALList new: result ] ifFalse: [ MALList new: (OrderedCollection from: storage) ] ] ] ]). Core Ns at: #apply put: (Fn new: [ :args | | f rest result | f := args first fn. args size < 3 ifTrue: [ rest := {} ] ifFalse: [ rest := args copyFrom: 2 to: args size - 1 ]. rest := rest, args last value. f value: rest ]). Core Ns at: #map put: (Fn new: [ :args | | items f result | f := args first fn. items := args second value. result := items collect: [ :item | f value: {item} ]. MALList new: (OrderedCollection from: result) ]). Core Ns at: #meta put: (Fn new: [ :args | | meta | meta := args first meta. meta isNil ifTrue: [ MALObject Nil ] ifFalse: [ meta ] ]). Core Ns at: #'with-meta' put: (Fn new: [ :args | args first withMeta: args second ]). Core Ns at: #'nil?' put: (Fn new: [ :args | Core coerce: [ args first type = #nil ] ]). Core Ns at: #'true?' put: (Fn new: [ :args | Core coerce: [ args first type = #true ] ]). Core Ns at: #'false?' put: (Fn new: [ :args | Core coerce: [ args first type = #false ] ]). Core Ns at: #'number?' put: (Fn new: [ :args | Core coerce: [ args first type = #number ] ]). Core Ns at: #'symbol?' put: (Fn new: [ :args | Core coerce: [ args first type = #symbol ] ]). Core Ns at: #'keyword?' put: (Fn new: [ :args | Core coerce: [ args first type = #keyword ] ]). Core Ns at: #'string?' put: (Fn new: [ :args | Core coerce: [ args first type = #string ] ]). Core Ns at: #'vector?' put: (Fn new: [ :args | Core coerce: [ args first type = #vector ] ]). Core Ns at: #'map?' put: (Fn new: [ :args | Core coerce: [ args first type = #map ] ]). Core Ns at: #'sequential?' put: (Fn new: [ :args | Core coerce: [ args first type = #list or: [ args first type = #vector ] ] ]). Core Ns at: #'fn?' put: (Fn new: [ :args | Core coerce: [ args first type = #fn or: [ args first type = #func and: [ args first isMacro not ] ] ] ]). Core Ns at: #'macro?' put: (Fn new: [ :args | Core coerce: [ args first type = #func and: [ args first isMacro ] ] ]). 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: (Fn new: [ :args | MALMap new: args asDictionary ]). Core Ns at: #assoc put: (Fn new: [ :args | | result keyVals | result := Dictionary from: args first value associations. keyVals := args allButFirst. 1 to: keyVals size by: 2 do: [ :i | result add: (keyVals at: i) -> (keyVals at: i + 1) ]. MALMap new: result ]). Core Ns at: #dissoc put: (Fn new: [ :args | | result keys | result := Dictionary from: args first value associations. keys := args allButFirst. keys do: [ :key | result removeKey: key ifAbsent: [ nil ] ]. MALMap new: result ]). Core Ns at: #get put: (Fn new: [ :args | Core nilable: args else: [ args first value at: args second ifAbsent: [ MALObject Nil ] ] ]). Core Ns at: #'contains?' put: (Fn new: [ :args | Core coerce: [ args first value includesKey: args second ] ]). Core Ns at: #keys put: (Fn new: [ :args | MALList new: (OrderedCollection from: args first value keys) ]). Core Ns at: #vals put: (Fn new: [ :args | MALList new: (OrderedCollection from: args first value values) ]). ================================================ FILE: impls/gnu-smalltalk/env.st ================================================ Object subclass: Env [ | data outer | Env class >> new: outerEnv [ ^self new: outerEnv binds: {} exprs: {} ] Env class >> new: outerEnv binds: binds exprs: exprs [ | env | env := super new. env init: outerEnv binds: binds exprs: exprs. ^env ] init: env binds: binds exprs: exprs [ data := Dictionary new. outer := env. 1 to: binds size do: [ :i | (binds at: i) = #& ifTrue: [ | rest | rest := OrderedCollection from: (exprs copyFrom: i). self set: (binds at: i + 1) value: (MALList new: rest). ^nil ] ifFalse: [ self set: (binds at: i) value: (exprs at: i) ] ] ] set: key value: value [ data at: key put: value. ] get: key [ ^data at: key ifAbsent: [ outer isNil ifFalse: [ outer get: key ] ] ] ] ================================================ FILE: impls/gnu-smalltalk/func.st ================================================ MALObject subclass: Func [ | ast params env fn isMacro | ast [ ^ast ] params [ ^params ] env [ ^env ] fn [ ^fn ] isMacro [ ^isMacro ] isMacro: bool [ isMacro := bool ] Func class >> new: ast params: params env: env fn: fn [ | func | func := super new: #func value: fn meta: nil. func init: ast params: params env: env fn: fn. ^func ] init: anAst params: someParams env: anEnv fn: aFn [ ast := anAst. params := someParams. env := anEnv. fn := aFn. isMacro := false ] ] ================================================ FILE: impls/gnu-smalltalk/printer.st ================================================ Object subclass: Printer [ Printer class >> prStr: sexp printReadably: printReadably [ sexp type = #fn ifTrue: [ ^'#' ]. sexp type = #func ifTrue: [ ^'#' ]. sexp type = #true ifTrue: [ ^'true' ]. sexp type = #false ifTrue: [ ^'false' ]. sexp type = #nil ifTrue: [ ^'nil' ]. sexp type = #number ifTrue: [ ^sexp value asString ]. sexp type = #symbol ifTrue: [ ^sexp value asString ]. sexp type = #keyword ifTrue: [ ^':', sexp value ]. sexp type = #string ifTrue: [ printReadably ifTrue: [ ^sexp value repr ] ifFalse: [ ^sexp value ] ]. sexp type = #list ifTrue: [ ^self prList: sexp printReadably: printReadably starter: '(' ender: ')' ]. sexp type = #vector ifTrue: [ ^self prList: sexp printReadably: printReadably starter: '[' ender: ']' ]. sexp type = #map ifTrue: [ ^self prMap: sexp printReadably: printReadably ]. sexp type = #atom ifTrue: [ ^'(atom ', (self prStr: sexp value printReadably: printReadably), ')' ]. Error halt: 'unimplemented type' ] Printer class >> prList: sexp printReadably: printReadably starter: starter ender: ender [ | items | items := sexp value collect: [ :item | self prStr: item printReadably: printReadably ]. ^starter, (items join: ' ') , ender ] Printer class >> prMap: sexp printReadably: printReadably [ | items | items := sexp value associations collect: [ :item | (self prStr: item key printReadably: printReadably), ' ', (self prStr: item value printReadably: printReadably) ]. ^'{', (items join: ' '), '}' ] ] ================================================ FILE: impls/gnu-smalltalk/reader.st ================================================ Object subclass: Reader [ | storage index | TokenRegex := '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}(''"`,;)]*)'. CommentRegex := ';.*'. NumberRegex := '-?[0-9]+(?:\.[0-9]+)?'. StringRegex := '"(?:\\.|[^\\"])*"'. Reader class >> tokenizer: input [ | tokens token hit pos done | tokens := OrderedCollection new. pos := 1. done := false. [done] whileFalse: [ hit := input searchRegex: TokenRegex startingAt: pos. token := hit at: 1. token size = 0 ifTrue: [ tokens add: (input copyFrom: pos to: input size) trimSeparators. done := true. ]. (token size = 0 or: [token matchRegex: CommentRegex]) ifFalse: [ tokens add: token ]. pos := pos + (hit match size). pos > input size ifTrue: [ done := true. ]. ]. ^tokens ] Reader class >> readStr: input [ | tokens reader form | tokens := self tokenizer: input. reader := self new: tokens. tokens isEmpty ifTrue: [ ^MALEmptyInput new signal ]. ^self readForm: reader. ] Reader class >> readForm: reader [ | token | token := reader peek. token = '(' ifTrue: [ ^self readList: reader class: MALList ender: ')' ]. token = '[' ifTrue: [ ^self readList: reader class: MALVector ender: ']' ]. token = '{' ifTrue: [ ^self readList: reader class: MALMap ender: '}' ]. (token matchRegex: '[])}]') ifTrue: [ ^MALUnexpectedToken new signal: token ]. token = '''' ifTrue: [ ^self readSimpleMacro: reader name: #quote ]. token = '`' ifTrue: [ ^self readSimpleMacro: reader name: #quasiquote ]. token = '~' ifTrue: [ ^self readSimpleMacro: reader name: #unquote ]. token = '~@' ifTrue: [ ^self readSimpleMacro: reader name: #'splice-unquote' ]. token = '@' ifTrue: [ ^self readSimpleMacro: reader name: #deref ]. token = '^' ifTrue: [ ^self readWithMetaMacro: reader ]. ^self readAtom: reader ] Reader class >> readList: reader class: aClass ender: ender [ | storage token | storage := OrderedCollection new. "pop opening token" reader next. [ token := reader peek. token isNil ] whileFalse: [ token = ender ifTrue: [ ender = '}' ifTrue: [ storage := storage asDictionary. ]. "pop closing token" reader next. ^aClass new: storage ]. storage add: (self readForm: reader). ]. ^MALUnterminatedSequence new signal: ender ] Reader class >> readAtom: reader [ | token | token := reader next. token = 'true' ifTrue: [ ^MALObject True ]. token = 'false' ifTrue: [ ^MALObject False ]. token = 'nil' ifTrue: [ ^MALObject Nil ]. (token matchRegex: StringRegex) ifTrue: [ ^MALString new: token parse ]. (token first = $") ifTrue: [ ^MALUnterminatedSequence new signal: '"' ]. (token matchRegex: NumberRegex) ifTrue: [ ^MALNumber new: token asNumber ]. (token first = $:) ifTrue: [ ^MALKeyword new: token allButFirst asSymbol ]. ^MALSymbol new: token asSymbol ] Reader class >> readSimpleMacro: reader name: name [ | form list | "pop reader macro token" reader next. form := self readForm: reader. list := OrderedCollection from: { MALSymbol new: name. form }. ^MALList new: list ] Reader class >> readWithMetaMacro: reader [ | form meta list | "pop reader macro token" reader next. meta := self readForm: reader. form := self readForm: reader. list := OrderedCollection from: { MALSymbol new: #'with-meta'. form. meta }. ^MALList new: list ] Reader class >> new: tokens [ | reader | reader := super new. reader init: tokens. ^reader ] init: tokens [ storage := tokens. index := 1. ] peek [ ^storage at: index ifAbsent: [ nil ] ] next [ | token | token := self peek. index := index + 1. ^token ] ] ================================================ FILE: impls/gnu-smalltalk/readline.st ================================================ DLD addLibrary: 'libreadline'. DLD addLibrary: 'libhistory'. Object subclass: ReadLine [ ReadLine class >> readLine: prompt [ ] ReadLine class >> addHistory: item [ ] ReadLine class >> readHistory: filePath [ ] ReadLine class >> writeHistory: filePath [ ] ] ================================================ FILE: impls/gnu-smalltalk/run ================================================ #!/usr/bin/env bash exec gst -f $(dirname $0)/${STEP:-stepA_mal}.st "${@}" ================================================ FILE: impls/gnu-smalltalk/step0_repl.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^input ] MAL class >> EVAL: sexp [ ^sexp ] MAL class >> PRINT: sexp [ ^sexp ] MAL class >> rep: input [ ^self PRINT: (self EVAL: (self READ: input)) ] ] | input historyFile | historyFile := '.mal_history'. ReadLine readHistory: historyFile. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. (MAL rep: input) displayNl. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step1_read_print.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> EVAL: sexp [ ^sexp ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input [ ^self PRINT: (self EVAL: (self READ: input)) ] ] | input historyFile | historyFile := '.mal_history'. ReadLine readHistory: historyFile. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step2_eval.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] MAL class >> EVAL: sexp env: env [ | forms function args | " ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. " sexp type = #symbol ifTrue: [ ^env at: sexp value ifAbsent: [ ^MALUnknownSymbol new signal: sexp value ]. ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. ^function valueWithArguments: args ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Dictionary from: { #+ -> [ :a :b | MALNumber new: a value + b value ]. #- -> [ :a :b | MALNumber new: a value - b value ]. #* -> [ :a :b | MALNumber new: a value * b value ]. #/ -> [ :a :b | MALNumber new: a value // b value ] }. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step3_env.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] MAL class >> EVAL: sexp env: env [ | ast a0_ a1 a1_ a2 forms function args | a2 := env get: #'DEBUG-EVAL'. (a2 isNil or: [ a2 type = #false or: [ a2 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. ^self EVAL: a2 env: env_ ]. forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. ^function valueWithArguments: args ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. replEnv set: #+ value: [ :a :b | MALNumber new: a value + b value ]. replEnv set: #- value: [ :a :b | MALNumber new: a value - b value ]. replEnv set: #* value: [ :a :b | MALNumber new: a value * b value ]. replEnv set: #/ value: [ :a :b | MALNumber new: a value // b value ]. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step4_if_fn_do.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] MAL class >> EVAL: sexp env: env [ | ast a0_ a1 a1_ a2 a3 forms function args | a1 := env get: #'DEBUG-EVAL'. (a1 isNil or: [ a1 type = #false or: [ a1 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. ^self EVAL: a2 env: env_ ]. a0_ = #do ifTrue: [ ^(self evalList: ast allButFirst env: env) last ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ ^self EVAL: a3 env: env ] ifFalse: [ ^self EVAL: a2 env: env ] ]. a0_ = #'fn*' ifTrue: [ | binds | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. ^Fn new: [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ] ]. forms := self evalList: sexp value env: env. function := forms first fn. args := forms allButFirst asArray. ^function value: args ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step5_tco.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] MAL class >> EVAL: aSexp env: anEnv [ | sexp env ast a0_ a1 a1_ a2 a3 forms function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a1 := env get: #'DEBUG-EVAL'. (a1 isNil or: [ a1 type = #false or: [ a1 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ] '' displayNl. ================================================ FILE: impls/gnu-smalltalk/step6_file.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] MAL class >> EVAL: aSexp env: anEnv [ | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a0 := env get: #'DEBUG-EVAL'. (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0 := ast first. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv argv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. argv := Smalltalk arguments. argv notEmpty ifTrue: [ argv := argv allButFirst ]. argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). replEnv set: #'*ARGV*' value: (MALList new: argv). MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. Smalltalk arguments notEmpty ifTrue: [ MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv ] ifFalse: [ [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ]. '' displayNl. ] ================================================ FILE: impls/gnu-smalltalk/step7_quote.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] 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 acc | (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. (ast type = #list or: [ ast type = #vector ]) ifFalse: [ ^ast ]. (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 [ | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a0 := env get: #'DEBUG-EVAL'. (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0 := ast first. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #quote ifTrue: [ a1 := ast second. ^a1 ]. a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. sexp := self quasiquote: a1. continue value "TCO" ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. forms := self evalList: sexp value env: env. function := forms first. args := forms allButFirst asArray. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv argv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. argv := Smalltalk arguments. argv notEmpty ifTrue: [ argv := argv allButFirst ]. argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). replEnv set: #'*ARGV*' value: (MALList new: argv). MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. Smalltalk arguments notEmpty ifTrue: [ MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv ] ifFalse: [ [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ]. '' displayNl. ] ================================================ FILE: impls/gnu-smalltalk/step8_macros.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] 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 acc | (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. (ast type = #list or: [ ast type = #vector ]) ifFalse: [ ^ast ]. (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 [ | sexp env ast a0 a0_ a1 a1_ a2 a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a0 := env get: #'DEBUG-EVAL'. (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0 := ast first. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'defmacro!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := (self EVAL: a2 env: env) deepCopy. result isMacro: true. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #quote ifTrue: [ a1 := ast second. ^a1 ]. a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. sexp := self quasiquote: a1. continue value "TCO" ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. function := self EVAL: a0 env: env. args := ast allButFirst asArray. (function type = #func and: [ function isMacro ]) ifTrue: [ sexp := function fn value: args. continue value TCO ]. args := self evalList: args env: env. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv argv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. argv := Smalltalk arguments. argv notEmpty ifTrue: [ argv := argv allButFirst ]. argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). replEnv set: #'*ARGV*' value: (MALList new: argv). MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. MAL 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)))))))' env: replEnv. Smalltalk arguments notEmpty ifTrue: [ MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv ] ifFalse: [ [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ]. '' displayNl. ] ================================================ FILE: impls/gnu-smalltalk/step9_try.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] 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 acc | (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. (ast type = #list or: [ ast type = #vector ]) ifFalse: [ ^ast ]. (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 [ | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a0 := env get: #'DEBUG-EVAL'. (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0 := ast first. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'defmacro!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := (self EVAL: a2 env: env) deepCopy. result isMacro: true. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #quote ifTrue: [ a1 := ast second. ^a1 ]. a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. sexp := self quasiquote: a1. continue value "TCO" ]. a0_ = #'try*' ifTrue: [ | A B C | A := ast second. ast at: 3 ifAbsent: [ ^self EVAL: A env: env. ]. a2_ := ast third value. B := a2_ second value. C := a2_ third. ^[ self EVAL: A env: env ] on: MALError do: [ :err | | data env_ result | data := err data. data isString ifTrue: [ data := MALString new: data ]. env_ := Env new: env binds: {B} exprs: {data}. err return: (self EVAL: C env: env_) ] ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. function := self EVAL: a0 env: env. args := ast allButFirst asArray. (function type = #func and: [ function isMacro ]) ifTrue: [ sexp := function fn value: args. continue value TCO ]. args := self evalList: args env: env. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv argv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. argv := Smalltalk arguments. argv notEmpty ifTrue: [ argv := argv allButFirst ]. argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). replEnv set: #'*ARGV*' value: (MALList new: argv). MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. MAL 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)))))))' env: replEnv. Smalltalk arguments notEmpty ifTrue: [ MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv ] ifFalse: [ [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ]. '' displayNl. ] ================================================ FILE: impls/gnu-smalltalk/stepA_mal.st ================================================ String extend [ String >> loadRelative [ | scriptPath scriptDirectory | scriptPath := thisContext currentFileName. scriptDirectory := FilePath stripFileNameFor: scriptPath. FileStream fileIn: (FilePath append: self to: scriptDirectory) ] ] 'readline.st' loadRelative. 'util.st' loadRelative. 'types.st' loadRelative. 'reader.st' loadRelative. 'printer.st' loadRelative. 'env.st' loadRelative. 'func.st' loadRelative. 'core.st' loadRelative. Object subclass: MAL [ MAL class >> READ: input [ ^Reader readStr: input ] MAL class >> evalList: list env: env [ ^list collect: [ :item | self EVAL: item env: env ]. ] 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 acc | (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. (ast type = #list or: [ ast type = #vector ]) ifFalse: [ ^ast ]. (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 [ | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args | "NOTE: redefinition of method arguments is not allowed" sexp := aSexp. env := anEnv. [ [ :continue | a0 := env get: #'DEBUG-EVAL'. (a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] ) ifFalse: [ ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. ]. sexp type = #symbol ifTrue: [ | key value | key := sexp value. value := env get: key. value isNil ifTrue: [ ^MALUnknownSymbol new signal: key ]. ^value ]. sexp type = #vector ifTrue: [ ^MALVector new: (self evalList: sexp value env: env) ]. sexp type = #map ifTrue: [ ^MALMap new: (self evalList: sexp value env: env) ]. sexp type ~= #list ifTrue: [ ^sexp ]. sexp value isEmpty ifTrue: [ ^sexp ]. ast := sexp value. a0 := ast first. a0_ := ast first value. a0_ = #'def!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := self EVAL: a2 env: env. env set: a1_ value: result. ^result ]. a0_ = #'defmacro!' ifTrue: [ | result | a1_ := ast second value. a2 := ast third. result := (self EVAL: a2 env: env) deepCopy. result isMacro: true. env set: a1_ value: result. ^result ]. a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. a1_ := ast second value. a2 := ast third. 1 to: a1_ size by: 2 do: [ :i | env_ set: (a1_ at: i) value value: (self EVAL: (a1_ at: i + 1) env: env_) ]. env := env_. sexp := a2. continue value "TCO" ]. a0_ = #do ifTrue: [ | forms last | ast size < 2 ifTrue: [ forms := {}. last := MALObject Nil. ] ifFalse: [ forms := ast copyFrom: 2 to: ast size - 1. last := ast last. ]. forms do: [ :form | self EVAL: form env: env ]. sexp := last. continue value "TCO" ]. a0_ = #if ifTrue: [ | condition | a1 := ast second. a2 := ast third. a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. condition := self EVAL: a1 env: env. (condition type = #false or: [ condition type = #nil ]) ifTrue: [ sexp := a3 ] ifFalse: [ sexp := a2 ]. continue value "TCO" ]. a0_ = #quote ifTrue: [ a1 := ast second. ^a1 ]. a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. sexp := self quasiquote: a1. continue value "TCO" ]. a0_ = #'try*' ifTrue: [ | A B C | A := ast second. ast at: 3 ifAbsent: [ ^self EVAL: A env: env. ]. a2_ := ast third value. B := a2_ second value. C := a2_ third. ^[ self EVAL: A env: env ] on: MALError do: [ :err | | data env_ result | data := err data. data isString ifTrue: [ data := MALString new: data ]. env_ := Env new: env binds: {B} exprs: {data}. err return: (self EVAL: C env: env_) ] ]. a0_ = #'fn*' ifTrue: [ | binds env_ fn | a1_ := ast second value. binds := a1_ collect: [ :item | item value ]. a2 := ast third. fn := [ :args | self EVAL: a2 env: (Env new: env binds: binds exprs: args) ]. ^Func new: a2 params: binds env: env fn: fn ]. function := self EVAL: a0 env: env. args := ast allButFirst asArray. (function type = #func and: [ function isMacro ]) ifTrue: [ sexp := function fn value: args. continue value TCO ]. args := self evalList: args env: env. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | sexp := function ast. env_ := Env new: function env binds: function params exprs: args. env := env_. continue value "TCO" ] ] valueWithExit ] repeat. ] MAL class >> PRINT: sexp [ ^Printer prStr: sexp printReadably: true ] MAL class >> rep: input env: env [ ^self PRINT: (self EVAL: (self READ: input) env: env) ] ] | input historyFile replEnv argv | historyFile := '.mal_history'. ReadLine readHistory: historyFile. replEnv := Env new: nil. argv := Smalltalk arguments. argv notEmpty ifTrue: [ argv := argv allButFirst ]. argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). replEnv set: #'*ARGV*' value: (MALList new: argv). replEnv set: #'*host-language*' value: (MALString new: 'smalltalk'). MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv. MAL 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)))))))' env: replEnv. Smalltalk arguments notEmpty ifTrue: [ MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv ] ifFalse: [ MAL rep: '(println (str "Mal [" *host-language* "]"))' env: replEnv. [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ input isEmpty ifFalse: [ ReadLine addHistory: input. ReadLine writeHistory: historyFile. [ (MAL rep: input env: replEnv) displayNl ] on: MALEmptyInput do: [ #return ] on: MALError do: [ :err | ('error: ', err messageText) displayNl. #return ]. ] ]. '' displayNl. ] ================================================ FILE: impls/gnu-smalltalk/tests/stepA_mal.mal ================================================ (gst-eval "1 + 1") ;=>2 (gst-eval "{1. 2. 3}") ;=>[1 2 3] (gst-eval "#('a' 'b' 'c') join: ' '") ;=>"a b c" (gst-eval "'Hello World!' displayNl") ;/Hello World! ================================================ FILE: impls/gnu-smalltalk/types.st ================================================ Object subclass: MALObject [ | type value meta | type [ ^type ] value [ ^value ] meta [ ^meta ] value: aValue [ value := aValue. ] meta: aMeta [ meta := aMeta. ] MALObject class >> new: type value: value meta: meta [ | object | object := super new. object init: type value: value meta: meta. ^object ] init: aType value: aValue meta: aMeta [ type := aType. value := aValue. meta := aMeta. ] withMeta: meta [ | object | object := self deepCopy. object meta: meta. ^object ] printOn: stream [ stream nextPutAll: '<'; nextPutAll: self class printString; nextPutAll: ': '; nextPutAll: value printString. meta notNil ifTrue: [ stream nextPutAll: ' | ' nextPutAll: meta printString. ]. stream nextPutAll: '>'. ] = x [ self type ~= x type ifTrue: [ ^false ]. ^self value = x value ] hash [ ^self value hash ] ] MALObject subclass: MALTrue [ MALTrue class >> new [ ^super new: #true value: true meta: nil. ] ] MALObject subclass: MALFalse [ MALFalse class >> new [ ^super new: #false value: false meta: nil. ] ] MALObject subclass: MALNil [ MALNil class >> new [ ^super new: #nil value: nil meta: nil. ] ] MALObject class extend [ True := MALTrue new. False := MALFalse new. Nil := MALNil new. True [ ^True ] False [ ^False ] Nil [ ^Nil ] ] MALObject subclass: MALNumber [ MALNumber class >> new: value [ ^super new: #number value: value meta: nil. ] ] MALObject subclass: MALString [ MALString class >> new: value [ ^super new: #string value: value meta: nil. ] ] MALObject subclass: MALSymbol [ MALSymbol class >> new: value [ ^super new: #symbol value: value meta: nil. ] ] MALObject subclass: MALKeyword [ MALKeyword class >> new: value [ ^super new: #keyword value: value meta: nil. ] ] MALObject subclass: MALList [ MALList class >> new: value [ ^super new: #list value: value meta: nil. ] = x [ (x type ~= #list and: [ x type ~= #vector ]) ifTrue: [ ^false ]. ^self value = x value ] ] MALObject subclass: MALVector [ MALVector class >> new: value [ ^super new: #vector value: value meta: nil. ] = x [ (x type ~= #vector and: [ x type ~= #list ]) ifTrue: [ ^false ]. ^self value = x value ] ] MALObject subclass: MALMap [ MALMap class >> new: value [ ^super new: #map value: value meta: nil. ] ] MALObject subclass: MALAtom [ MALAtom class >> new: value [ ^super new: #atom value: value meta: nil. ] ] MALObject subclass: Fn [ | fn | fn [ ^fn ] Fn class >> new: fn [ | f | f := super new: #fn value: fn meta: nil. f init: fn. ^f ] init: f [ fn := f. ] ] Error subclass: MALError [ description [ ^'A MAL-related error' ] isResumable [ ^true ] data [ ^self messageText ] ] MALError subclass: MALUnterminatedSequence [ MALUnterminatedSequence class >> new [ ^super new ] messageText [ ^'expected ''', self basicMessageText, ''', got EOF' ] ] MALError subclass: MALUnexpectedToken [ MALUnexpectedToken class >> new [ ^super new ] messageText [ ^'unexpected token: ''', self basicMessageText, ''''] ] MALError subclass: MALEmptyInput [ MALEmptyInput class >> new [ ^super new ] messageText [ ^'Empty input' ] ] MALError subclass: MALUnknownSymbol [ MALUnknownSymbol class >> new [ ^super new ] messageText [ ^'''', self basicMessageText, ''' not found'] ] MALError subclass: MALOutOfBounds [ MALOutOfBounds class >> new [ ^super new ] messageText [ ^'Out of bounds' ] ] MALError subclass: MALCustomError [ MALCustomError class >> new [ ^super new ] messageText [ ^Printer prStr: self basicMessageText printReadably: true ] data [ ^self basicMessageText ] ] ================================================ FILE: impls/gnu-smalltalk/util.st ================================================ SequenceableCollection extend [ asDictionary [ | dict assoc | dict := Dictionary new. 1 to: self size by: 2 do: [ :i | dict add: (self at: i) -> (self at: i + 1) ]. ^dict ] ] String extend [ parse [ |text canary| canary := 8r177 asCharacter asString. text := self copyFrom: 2 to: self size - 1. text := text copyReplaceAll: '\\' with: canary. text := text copyReplaceAll: '\"' with: '"'. text := text copyReplaceAll: '\n' with: ' '. text := text copyReplaceAll: canary with: '\'. ^text ] repr [ |text| text := self copyReplaceAll: '\' with: '\\'. text := text copyReplaceAll: ' ' with: '\n'. text := text copyReplaceAll: '"' with: '\"'. ^'"', text, '"' ] ] BlockClosure extend [ valueWithExit [ ^self value: [ ^nil ] ] ] Object extend [ toMALValue [ self = true ifTrue: [ ^MALObject True ]. self = false ifTrue: [ ^MALObject False ]. self = nil ifTrue: [ ^MALObject Nil ]. self isNumber ifTrue: [ ^MALNumber new: self ]. self isString ifTrue: [ ^MALString new: self ]. self isSymbol ifTrue: [ ^MALSymbol new: self ]. self isArray ifTrue: [ ^MALVector new: (self asOrderedCollection collect: [ :item | item toMALValue ]) ]. self isSequenceable ifTrue: [ ^MALList new: (self asOrderedCollection collect: [ :item | item toMALValue ]) ]. self class = Dictionary ifTrue: [ | result | result := Dictionary new. self keysAndValuesDo: [ :key :value | result at: key toMALValue put: value toMALValue ]. ^MALMap new: result ] ] ] "NOTE: bugfix version from 3.2.91 for 3.2.4" Namespace current: Kernel [ MatchingRegexResults extend [ at: anIndex [ | reg text | anIndex = 0 ifTrue: [^self match]. cache isNil ifTrue: [cache := Array new: registers size]. (cache at: anIndex) isNil ifTrue: [reg := registers at: anIndex. text := reg isNil ifTrue: [nil] ifFalse: [ reg isEmpty ifTrue: [''] ifFalse: [self subject copyFrom: reg first to: reg last]]. cache at: anIndex put: text]. ^cache at: anIndex ] ] ] ================================================ FILE: impls/go/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ golang libreadline-dev libedit-dev pkg-config ENV HOME /mal ================================================ FILE: impls/go/Makefile ================================================ ##################### SOURCES_BASE = src/types/types.go src/readline/readline.go \ src/reader/reader.go src/printer/printer.go \ src/env/env.go src/core/core.go ##################### SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \ step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \ step8_macros.go step9_try.go stepA_mal.go BINS = $(SRCS:%.go=%) ##################### all: $(BINS) dist: mal mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ define dep_template $(1): $(SOURCES_BASE) src/$(1)/$(1).go go build -o $$@ ./src/$(1) endef $(foreach b,$(BINS),$(eval $(call dep_template,$(b)))) clean: rm -f $(BINS) mal ================================================ FILE: impls/go/go.mod ================================================ module mal go 1.22.2 ================================================ FILE: impls/go/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/go/src/core/core.go ================================================ package core import ( "errors" "fmt" "io/ioutil" "strings" "time" ) import ( "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // Errors/Exceptions func throw(a []MalType) (MalType, error) { return nil, MalError{a[0]} } func fn_q(a []MalType) (MalType, error) { switch f := a[0].(type) { case MalFunc: return !f.GetMacro(), nil case Func: return true, nil case func([]MalType) (MalType, error): return true, nil default: return false, nil } } // String functions func pr_str(a []MalType) (MalType, error) { return printer.Pr_list(a, true, "", "", " "), nil } func str(a []MalType) (MalType, error) { return printer.Pr_list(a, false, "", "", ""), nil } func prn(a []MalType) (MalType, error) { fmt.Println(printer.Pr_list(a, true, "", "", " ")) return nil, nil } func println(a []MalType) (MalType, error) { fmt.Println(printer.Pr_list(a, false, "", "", " ")) return nil, nil } func slurp(a []MalType) (MalType, error) { b, e := ioutil.ReadFile(a[0].(string)) if e != nil { return nil, e } return string(b), nil } // Number functions func time_ms(a []MalType) (MalType, error) { return int(time.Now().UnixNano() / int64(time.Millisecond)), nil } // Hash Map functions func copy_hash_map(hm HashMap) HashMap { new_hm := HashMap{map[string]MalType{}, nil} for k, v := range hm.Val { new_hm.Val[k] = v } return new_hm } func assoc(a []MalType) (MalType, error) { if len(a) < 3 { return nil, errors.New("assoc requires at least 3 arguments") } if len(a)%2 != 1 { return nil, errors.New("assoc requires odd number of arguments") } if !HashMap_Q(a[0]) { return nil, errors.New("assoc called on non-hash map") } new_hm := copy_hash_map(a[0].(HashMap)) for i := 1; i < len(a); i += 2 { key := a[i] if !String_Q(key) { return nil, errors.New("assoc called with non-string key") } new_hm.Val[key.(string)] = a[i+1] } return new_hm, nil } func dissoc(a []MalType) (MalType, error) { if len(a) < 2 { return nil, errors.New("dissoc requires at least 3 arguments") } if !HashMap_Q(a[0]) { return nil, errors.New("dissoc called on non-hash map") } new_hm := copy_hash_map(a[0].(HashMap)) for i := 1; i < len(a); i += 1 { key := a[i] if !String_Q(key) { return nil, errors.New("dissoc called with non-string key") } delete(new_hm.Val, key.(string)) } return new_hm, nil } func get(a []MalType) (MalType, error) { if Nil_Q(a[0]) { return nil, nil } if !HashMap_Q(a[0]) { return nil, errors.New("get called on non-hash map") } if !String_Q(a[1]) { return nil, errors.New("get called with non-string key") } return a[0].(HashMap).Val[a[1].(string)], nil } func contains_Q(hm MalType, key MalType) (MalType, error) { if Nil_Q(hm) { return false, nil } if !HashMap_Q(hm) { return nil, errors.New("get called on non-hash map") } if !String_Q(key) { return nil, errors.New("get called with non-string key") } _, ok := hm.(HashMap).Val[key.(string)] return ok, nil } func keys(a []MalType) (MalType, error) { if !HashMap_Q(a[0]) { return nil, errors.New("keys called on non-hash map") } slc := []MalType{} for k, _ := range a[0].(HashMap).Val { slc = append(slc, k) } return List{slc, nil}, nil } func vals(a []MalType) (MalType, error) { if !HashMap_Q(a[0]) { return nil, errors.New("keys called on non-hash map") } slc := []MalType{} for _, v := range a[0].(HashMap).Val { slc = append(slc, v) } return List{slc, nil}, nil } // Sequence functions func cons(a []MalType) (MalType, error) { val := a[0] lst, e := GetSlice(a[1]) if e != nil { return nil, e } return List{append([]MalType{val}, lst...), nil}, nil } func concat(a []MalType) (MalType, error) { if len(a) == 0 { return List{}, nil } slc1, e := GetSlice(a[0]) if e != nil { return nil, e } for i := 1; i < len(a); i += 1 { slc2, e := GetSlice(a[i]) if e != nil { return nil, e } slc1 = append(slc1, slc2...) } 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 { return nil, e } idx := a[1].(int) if idx < len(slc) { return slc[idx], nil } else { return nil, errors.New("nth: index out of range") } } func first(a []MalType) (MalType, error) { if len(a) == 0 { return nil, nil } if a[0] == nil { return nil, nil } slc, e := GetSlice(a[0]) if e != nil { return nil, e } if len(slc) == 0 { return nil, nil } return slc[0], nil } func rest(a []MalType) (MalType, error) { if a[0] == nil { return List{}, nil } slc, e := GetSlice(a[0]) if e != nil { return nil, e } if len(slc) == 0 { return List{}, nil } return List{slc[1:], nil}, nil } func empty_Q(a []MalType) (MalType, error) { switch obj := a[0].(type) { case List: return len(obj.Val) == 0, nil case Vector: return len(obj.Val) == 0, nil case nil: return true, nil default: return nil, errors.New("empty? called on non-sequence") } } func count(a []MalType) (MalType, error) { switch obj := a[0].(type) { case List: return len(obj.Val), nil case Vector: return len(obj.Val), nil case map[string]MalType: return len(obj), nil case nil: return 0, nil default: return nil, errors.New("count called on non-sequence") } } func apply(a []MalType) (MalType, error) { if len(a) < 2 { return nil, errors.New("apply requires at least 2 args") } f := a[0] args := []MalType{} for _, b := range a[1 : len(a)-1] { args = append(args, b) } last, e := GetSlice(a[len(a)-1]) if e != nil { return nil, e } args = append(args, last...) return Apply(f, args) } func do_map(a []MalType) (MalType, error) { f := a[0] results := []MalType{} args, e := GetSlice(a[1]) if e != nil { return nil, e } for _, arg := range args { res, e := Apply(f, []MalType{arg}) results = append(results, res) if e != nil { return nil, e } } return List{results, nil}, nil } func conj(a []MalType) (MalType, error) { if len(a) < 2 { return nil, errors.New("conj requires at least 2 arguments") } switch seq := a[0].(type) { case List: new_slc := []MalType{} for i := len(a) - 1; i > 0; i -= 1 { new_slc = append(new_slc, a[i]) } return List{append(new_slc, seq.Val...), nil}, nil case Vector: new_slc := seq.Val for _, x := range a[1:] { new_slc = append(new_slc, x) } return Vector{new_slc, nil}, nil } if !HashMap_Q(a[0]) { return nil, errors.New("dissoc called on non-hash map") } new_hm := copy_hash_map(a[0].(HashMap)) for i := 1; i < len(a); i += 1 { key := a[i] if !String_Q(key) { return nil, errors.New("dissoc called with non-string key") } delete(new_hm.Val, key.(string)) } return new_hm, nil } func seq(a []MalType) (MalType, error) { if a[0] == nil { return nil, nil } switch arg := a[0].(type) { case List: if len(arg.Val) == 0 { return nil, nil } return arg, nil case Vector: if len(arg.Val) == 0 { return nil, nil } return List{arg.Val, nil}, nil case string: if len(arg) == 0 { return nil, nil } new_slc := []MalType{} for _, ch := range strings.Split(arg, "") { new_slc = append(new_slc, ch) } return List{new_slc, nil}, nil } return nil, errors.New("seq requires string or list or vector or nil") } // Metadata functions func with_meta(a []MalType) (MalType, error) { obj := a[0] m := a[1] switch tobj := obj.(type) { case List: return List{tobj.Val, m}, nil case Vector: return Vector{tobj.Val, m}, nil case HashMap: return HashMap{tobj.Val, m}, nil case Func: return Func{tobj.Fn, m}, nil case MalFunc: fn := tobj fn.Meta = m return fn, nil default: return nil, errors.New("with-meta not supported on type") } } func meta(a []MalType) (MalType, error) { obj := a[0] switch tobj := obj.(type) { case List: return tobj.Meta, nil case Vector: return tobj.Meta, nil case HashMap: return tobj.Meta, nil case Func: return tobj.Meta, nil case MalFunc: return tobj.Meta, nil default: return nil, errors.New("meta not supported on type") } } // Atom functions func deref(a []MalType) (MalType, error) { if !Atom_Q(a[0]) { return nil, errors.New("deref called with non-atom") } return a[0].(*Atom).Val, nil } func reset_BANG(a []MalType) (MalType, error) { if !Atom_Q(a[0]) { return nil, errors.New("reset! called with non-atom") } a[0].(*Atom).Set(a[1]) return a[1], nil } func swap_BANG(a []MalType) (MalType, error) { if !Atom_Q(a[0]) { return nil, errors.New("swap! called with non-atom") } atm := a[0].(*Atom) args := []MalType{atm.Val} f := a[1] args = append(args, a[2:]...) res, e := Apply(f, args) if e != nil { return nil, e } atm.Set(res) return res, nil } // core namespace var NS = map[string]MalType{ "=": call2b(Equal_Q), "throw": call1e(throw), "nil?": call1b(Nil_Q), "true?": call1b(True_Q), "false?": call1b(False_Q), "symbol": call1e(func(a []MalType) (MalType, error) { return Symbol{a[0].(string)}, nil }), "symbol?": call1b(Symbol_Q), "string?": call1e(func(a []MalType) (MalType, error) { return (String_Q(a[0]) && !Keyword_Q(a[0])), nil }), "keyword": call1e(func(a []MalType) (MalType, error) { if Keyword_Q(a[0]) { return a[0], nil } else { return NewKeyword(a[0].(string)) } }), "keyword?": call1b(Keyword_Q), "number?": call1b(Number_Q), "fn?": call1e(fn_q), "macro?": call1e(func(a []MalType) (MalType, error) { return MalFunc_Q(a[0]) && a[0].(MalFunc).GetMacro(), nil }), "pr-str": callNe(pr_str), "str": callNe(str), "prn": callNe(prn), "println": callNe(println), "read-string": call1e(func(a []MalType) (MalType, error) { return reader.Read_str(a[0].(string)) }), "slurp": call1e(slurp), "readline": call1e(func(a []MalType) (MalType, error) { return readline.Readline(a[0].(string)) }), "<": call2e(func(a []MalType) (MalType, error) { return a[0].(int) < a[1].(int), nil }), "<=": call2e(func(a []MalType) (MalType, error) { return a[0].(int) <= a[1].(int), nil }), ">": call2e(func(a []MalType) (MalType, error) { return a[0].(int) > a[1].(int), nil }), ">=": call2e(func(a []MalType) (MalType, error) { return a[0].(int) >= a[1].(int), nil }), "+": call2e(func(a []MalType) (MalType, error) { return a[0].(int) + a[1].(int), nil }), "-": call2e(func(a []MalType) (MalType, error) { return a[0].(int) - a[1].(int), nil }), "*": call2e(func(a []MalType) (MalType, error) { return a[0].(int) * a[1].(int), nil }), "/": call2e(func(a []MalType) (MalType, error) { return a[0].(int) / a[1].(int), nil }), "time-ms": call0e(time_ms), "list": callNe(func(a []MalType) (MalType, error) { return List{a, nil}, nil }), "list?": call1b(List_Q), "vector": callNe(func(a []MalType) (MalType, error) { return Vector{a, nil}, nil }), "vector?": call1b(Vector_Q), "hash-map": callNe(func(a []MalType) (MalType, error) { return NewHashMap(List{a, nil}) }), "map?": call1b(HashMap_Q), "assoc": callNe(assoc), // at least 3 "dissoc": callNe(dissoc), // at least 2 "get": call2e(get), "contains?": call2e(func(a []MalType) (MalType, error) { return contains_Q(a[0], a[1]) }), "keys": call1e(keys), "vals": call1e(vals), "sequential?": call1b(Sequential_Q), "cons": call2e(cons), "concat": callNe(concat), "vec": call1e(vec), "nth": call2e(nth), "first": call1e(first), "rest": call1e(rest), "empty?": call1e(empty_Q), "count": call1e(count), "apply": callNe(apply), // at least 2 "map": call2e(do_map), "conj": callNe(conj), // at least 2 "seq": call1e(seq), "with-meta": call2e(with_meta), "meta": call1e(meta), "atom": call1e(func(a []MalType) (MalType, error) { return &Atom{a[0], nil}, nil }), "atom?": call1b(Atom_Q), "deref": call1e(deref), "reset!": call2e(reset_BANG), "swap!": callNe(swap_BANG), } // callXX functions check the number of arguments func call0e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { return func(args []MalType) (MalType, error) { if len(args) != 0 { return nil, fmt.Errorf("wrong number of arguments (%d instead of 0)", len(args)) } return f(args) } } func call1e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { return func(args []MalType) (MalType, error) { if len(args) != 1 { return nil, fmt.Errorf("wrong number of arguments (%d instead of 1)", len(args)) } return f(args) } } func call2e(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { return func(args []MalType) (MalType, error) { if len(args) != 2 { return nil, fmt.Errorf("wrong number of arguments (%d instead of 2)", len(args)) } return f(args) } } func callNe(f func([]MalType) (MalType, error)) func([]MalType) (MalType, error) { // just for documenting purposes, does not check anything return func(args []MalType) (MalType, error) { return f(args) } } func call1b(f func(MalType) bool) func([]MalType) (MalType, error) { return func(args []MalType) (MalType, error) { if len(args) != 1 { return nil, fmt.Errorf("wrong number of arguments (%d instead of 1)", len(args)) } return f(args[0]), nil } } func call2b(f func(MalType, MalType) bool) func([]MalType) (MalType, error) { return func(args []MalType) (MalType, error) { if len(args) != 2 { return nil, fmt.Errorf("wrong number of arguments (%d instead of 2)", len(args)) } return f(args[0], args[1]), nil } } ================================================ FILE: impls/go/src/env/env.go ================================================ package env import ( "errors" //"fmt" ) import ( . "mal/src/types" ) type Env struct { data map[string]MalType outer EnvType } func NewEnv(outer EnvType, binds_mt MalType, exprs_mt MalType) (EnvType, error) { env := Env{map[string]MalType{}, outer} if binds_mt != nil && exprs_mt != nil { binds, e := GetSlice(binds_mt) if e != nil { return nil, e } exprs, e := GetSlice(exprs_mt) if e != nil { return nil, e } // Return a new Env with symbols in binds boudn to // corresponding values in exprs for i := 0; i < len(binds); i += 1 { if Symbol_Q(binds[i]) && binds[i].(Symbol).Val == "&" { env.data[binds[i+1].(Symbol).Val] = List{exprs[i:], nil} break } else { env.data[binds[i].(Symbol).Val] = exprs[i] } } } //return &et, nil return env, nil } func (e Env) Find(key Symbol) EnvType { if _, ok := e.data[key.Val]; ok { return e } else if e.outer != nil { return e.outer.Find(key) } else { return nil } } func (e Env) Set(key Symbol, value MalType) MalType { e.data[key.Val] = value return value } func (e Env) Get(key Symbol) (MalType, error) { env := e.Find(key) if env == nil { return nil, errors.New("'" + key.Val + "' not found") } return env.(Env).data[key.Val], nil } ================================================ FILE: impls/go/src/printer/printer.go ================================================ package printer import ( "fmt" "strings" ) import ( "mal/src/types" ) func Pr_list(lst []types.MalType, pr bool, start string, end string, join string) string { str_list := make([]string, 0, len(lst)) for _, e := range lst { str_list = append(str_list, Pr_str(e, pr)) } return start + strings.Join(str_list, join) + end } func Pr_str(obj types.MalType, print_readably bool) string { switch tobj := obj.(type) { case types.List: return Pr_list(tobj.Val, print_readably, "(", ")", " ") case types.Vector: return Pr_list(tobj.Val, print_readably, "[", "]", " ") case types.HashMap: str_list := make([]string, 0, len(tobj.Val)*2) for k, v := range tobj.Val { str_list = append(str_list, Pr_str(k, print_readably)) str_list = append(str_list, Pr_str(v, print_readably)) } return "{" + strings.Join(str_list, " ") + "}" case string: if strings.HasPrefix(tobj, "\u029e") { return ":" + tobj[2:len(tobj)] } else if print_readably { return `"` + strings.Replace( strings.Replace( strings.Replace(tobj, `\`, `\\`, -1), `"`, `\"`, -1), "\n", `\n`, -1) + `"` } else { return tobj } case types.Symbol: return tobj.Val case nil: return "nil" case types.MalFunc: return "(fn* " + Pr_str(tobj.Params, true) + " " + Pr_str(tobj.Exp, true) + ")" case func([]types.MalType) (types.MalType, error): return fmt.Sprintf("", obj) case *types.Atom: return "(atom " + Pr_str(tobj.Val, true) + ")" default: return fmt.Sprintf("%v", obj) } } ================================================ FILE: impls/go/src/reader/reader.go ================================================ package reader import ( "errors" "regexp" "strconv" "strings" //"fmt" ) import ( . "mal/src/types" ) type Reader interface { next() *string peek() *string } type TokenReader struct { tokens []string position int } func (tr *TokenReader) next() *string { if tr.position >= len(tr.tokens) { return nil } token := tr.tokens[tr.position] tr.position = tr.position + 1 return &token } func (tr *TokenReader) peek() *string { if tr.position >= len(tr.tokens) { return nil } return &tr.tokens[tr.position] } func tokenize(str string) []string { results := make([]string, 0, 1) // Work around lack of quoting in backtick re := regexp.MustCompile(`[\s,]*(~@|[\[\]{}()'` + "`" + `~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"` + "`" + `,;)]*)`) for _, group := range re.FindAllStringSubmatch(str, -1) { if (group[1] == "") || (group[1][0] == ';') { continue } results = append(results, group[1]) } return results } func read_atom(rdr Reader) (MalType, error) { token := rdr.next() if token == nil { return nil, errors.New("read_atom underflow") } if match, _ := regexp.MatchString(`^-?[0-9]+$`, *token); match { var i int var e error if i, e = strconv.Atoi(*token); e != nil { return nil, errors.New("number parse error") } return i, nil } else if match, _ := regexp.MatchString(`^"(?:\\.|[^\\"])*"$`, *token); match { str := (*token)[1 : len(*token)-1] return strings.Replace( strings.Replace( strings.Replace( strings.Replace(str, `\\`, "\u029e", -1), `\"`, `"`, -1), `\n`, "\n", -1), "\u029e", "\\", -1), nil } else if (*token)[0] == '"' { return nil, errors.New("expected '\"', got EOF") } else if (*token)[0] == ':' { return NewKeyword((*token)[1:len(*token)]) } else if *token == "nil" { return nil, nil } else if *token == "true" { return true, nil } else if *token == "false" { return false, nil } else { return Symbol{*token}, nil } return token, nil } func read_list(rdr Reader, start string, end string) (MalType, error) { token := rdr.next() if token == nil { return nil, errors.New("read_list underflow") } if *token != start { return nil, errors.New("expected '" + start + "'") } ast_list := []MalType{} token = rdr.peek() for ; true; token = rdr.peek() { if token == nil { return nil, errors.New("exepected '" + end + "', got EOF") } if *token == end { break } f, e := read_form(rdr) if e != nil { return nil, e } ast_list = append(ast_list, f) } rdr.next() return List{ast_list, nil}, nil } func read_vector(rdr Reader) (MalType, error) { lst, e := read_list(rdr, "[", "]") if e != nil { return nil, e } vec := Vector{lst.(List).Val, nil} return vec, nil } func read_hash_map(rdr Reader) (MalType, error) { mal_lst, e := read_list(rdr, "{", "}") if e != nil { return nil, e } return NewHashMap(mal_lst) } func read_form(rdr Reader) (MalType, error) { token := rdr.peek() if token == nil { return nil, errors.New("read_form underflow") } switch *token { case `'`: rdr.next() form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"quote"}, form}, nil}, nil case "`": rdr.next() form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"quasiquote"}, form}, nil}, nil case `~`: rdr.next() form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"unquote"}, form}, nil}, nil case `~@`: rdr.next() form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"splice-unquote"}, form}, nil}, nil case `^`: rdr.next() meta, e := read_form(rdr) if e != nil { return nil, e } form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"with-meta"}, form, meta}, nil}, nil case `@`: rdr.next() form, e := read_form(rdr) if e != nil { return nil, e } return List{[]MalType{Symbol{"deref"}, form}, nil}, nil // list case ")": return nil, errors.New("unexpected ')'") case "(": return read_list(rdr, "(", ")") // vector case "]": return nil, errors.New("unexpected ']'") case "[": return read_vector(rdr) // hash-map case "}": return nil, errors.New("unexpected '}'") case "{": return read_hash_map(rdr) default: return read_atom(rdr) } return read_atom(rdr) } func Read_str(str string) (MalType, error) { var tokens = tokenize(str) if len(tokens) == 0 { return nil, errors.New("") } return read_form(&TokenReader{tokens: tokens, position: 0}) } ================================================ FILE: impls/go/src/readline/readline.go ================================================ package readline /* // IMPORTANT: choose one #cgo LDFLAGS: -ledit //#cgo LDFLAGS: -lreadline // NOTE: libreadline is GPL // free() #include // readline() #include // FILE * #include // add_history() #include */ import "C" import ( "errors" "fmt" "io/ioutil" "os" "path/filepath" "strings" "unsafe" ) var HISTORY_FILE = ".mal-history" var history_path string func loadHistory(filename string) error { content, err := ioutil.ReadFile(history_path) if err != nil { return err } for _, add_line := range strings.Split(string(content), "\n") { if add_line == "" { continue } c_add_line := C.CString(add_line) C.add_history(c_add_line) C.free(unsafe.Pointer(c_add_line)) } return nil } func init() { history_path = filepath.Join(os.Getenv("HOME"), HISTORY_FILE) loadHistory(history_path) } func Readline(prompt string) (string, error) { c_prompt := C.CString(prompt) defer C.free(unsafe.Pointer(c_prompt)) c_line := C.readline(c_prompt) defer C.free(unsafe.Pointer(c_line)) line := C.GoString(c_line) if c_line == nil { return "", errors.New("C.readline call failed") } C.add_history(c_line) // append to file f, e := os.OpenFile(history_path, os.O_APPEND|os.O_WRONLY, 0600) if e == nil { defer f.Close() _, e = f.WriteString(line + "\n") if e != nil { fmt.Printf("error writing to history") } } return line, nil } ================================================ FILE: impls/go/src/step0_repl/step0_repl.go ================================================ package main import ( "fmt" "strings" ) import ( "mal/src/readline" ) // read func READ(str string) string { return str } // eval func EVAL(ast string, env string) string { return ast } // print func PRINT(exp string) string { return exp } // repl func rep(str string) string { return PRINT(EVAL(READ(str), "")) } func main() { // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } fmt.Println(rep(text)) } } ================================================ FILE: impls/go/src/step1_read_print/step1_read_print.go ================================================ package main import ( "fmt" "strings" ) import ( "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func EVAL(ast MalType, env string) (MalType, error) { return ast, nil } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, ""); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step2_eval/step2_eval.go ================================================ package main import ( "errors" "fmt" "strings" ) import ( "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func eval_ast(ast MalType, env map[string]MalType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { k := ast.(Symbol).Val exp, ok := env[k] if !ok { return nil, errors.New("'" + k + "' not found") } return exp, nil } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env map[string]MalType) (MalType, error) { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list el, e := eval_ast(ast, env) if e != nil { return nil, e } f, ok := el.(List).Val[0].(func([]MalType) (MalType, error)) if !ok { return nil, errors.New("attempt to call non-function") } return f(el.(List).Val[1:]) } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env = map[string]MalType{ "+": func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) + a[1].(int), nil }, "-": func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) - a[1].(int), nil }, "*": func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) * a[1].(int), nil }, "/": func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) / a[1].(int), nil }, } func assertArgNum(a []MalType, n int) error { if len(a) != n { return errors.New("wrong number of arguments") } return nil } // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step3_env/step3_env.go ================================================ package main import ( "errors" "fmt" "strings" ) import ( . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } return EVAL(a2, let_env) default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f, ok := el.(List).Val[0].(func([]MalType) (MalType, error)) if !ok { return nil, errors.New("attempt to call non-function") } return f(el.(List).Val[1:]) } } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { repl_env.Set(Symbol{"+"}, func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) + a[1].(int), nil }) repl_env.Set(Symbol{"-"}, func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) - a[1].(int), nil }) repl_env.Set(Symbol{"*"}, func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) * a[1].(int), nil }) repl_env.Set(Symbol{"/"}, func(a []MalType) (MalType, error) { if e := assertArgNum(a, 2); e != nil { return nil, e } return a[0].(int) / a[1].(int), nil }) // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } func assertArgNum(a []MalType, n int) error { if len(a) != n { return errors.New("wrong number of arguments") } return nil } ================================================ FILE: impls/go/src/step4_if_fn_do/step4_if_fn_do.go ================================================ package main import ( "errors" "fmt" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } return EVAL(a2, let_env) case "do": el, e := eval_ast(List{ast.(List).Val[1:], nil}, env) if e != nil { return nil, e } lst := el.(List).Val if len(lst) == 0 { return nil, nil } return lst[len(lst)-1], nil case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { return EVAL(ast.(List).Val[3], env) } else { return nil, nil } } else { return EVAL(a2, env) } case "fn*": return func(arguments []MalType) (MalType, error) { new_env, e := NewEnv(env, a1, List{arguments, nil}) if e != nil { return nil, e } return EVAL(a2, new_env) }, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f, ok := el.(List).Val[0].(func([]MalType) (MalType, error)) if !ok { return nil, errors.New("attempt to call non-function") } return f(el.(List).Val[1:]) } } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, v) } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step5_tco/step5_tco.go ================================================ package main import ( "errors" "fmt" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "do": lst := ast.(List).Val _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f := el.(List).Val[0] if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(el.(List).Val[1:]) } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step6_file/step6_file.go ================================================ package main import ( "errors" "fmt" "os" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "do": lst := ast.(List).Val _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f := el.(List).Val[0] if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(el.(List).Val[1:]) } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { return EVAL(a[0], repl_env) }, nil}) repl_env.Set(Symbol{"*ARGV*"}, List{}) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") // called with mal script to load and eval if len(os.Args) > 1 { args := make([]MalType, 0, len(os.Args)-2) for _, a := range os.Args[2:] { args = append(args, a) } repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { fmt.Printf("Error: %v\n", e) os.Exit(1) } os.Exit(0) } // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step7_quote/step7_quote.go ================================================ package main import ( "errors" "fmt" "os" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval 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 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 { 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) } default: return ast } } func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } // apply list a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "quote": return a1, nil case "quasiquoteexpand": return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "do": lst := ast.(List).Val _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f := el.(List).Val[0] if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(el.(List).Val[1:]) } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { return EVAL(a[0], repl_env) }, nil}) repl_env.Set(Symbol{"*ARGV*"}, List{}) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") // called with mal script to load and eval if len(os.Args) > 1 { args := make([]MalType, 0, len(os.Args)-2) for _, a := range os.Args[2:] { args = append(args, a) } repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { fmt.Printf("Error: %v\n", e) os.Exit(1) } os.Exit(0) } // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step8_macros/step8_macros.go ================================================ package main import ( "errors" "fmt" "os" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval 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 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 { 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) } default: return ast } } func is_macro_call(ast MalType, env EnvType) bool { if List_Q(ast) { slc, _ := GetSlice(ast) if len(slc) == 0 { return false } a0 := slc[0] if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { mac, e := env.Get(a0.(Symbol)) if e != nil { return false } if MalFunc_Q(mac) { return mac.(MalFunc).GetMacro() } } } return false } func macroexpand(ast MalType, env EnvType) (MalType, error) { var mac MalType var e error for is_macro_call(ast, env) { slc, _ := GetSlice(ast) a0 := slc[0] mac, e = env.Get(a0.(Symbol)) if e != nil { return nil, e } fn := mac.(MalFunc) ast, e = Apply(fn, slc[1:]) if e != nil { return nil, e } } return ast, nil } func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { var e error for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } // apply list ast, e = macroexpand(ast, env) if e != nil { return nil, e } if !List_Q(ast) { return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "quote": return a1, nil case "quasiquoteexpand": return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": fn, e := EVAL(a2, env) fn = fn.(MalFunc).SetMacro() if e != nil { return nil, e } return env.Set(a1.(Symbol), fn), nil case "macroexpand": return macroexpand(a1, env) case "do": lst := ast.(List).Val _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f := el.(List).Val[0] if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(el.(List).Val[1:]) } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { return EVAL(a[0], repl_env) }, nil}) repl_env.Set(Symbol{"*ARGV*"}, List{}) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") // called with mal script to load and eval if len(os.Args) > 1 { args := make([]MalType, 0, len(os.Args)-2) for _, a := range os.Args[2:] { args = append(args, a) } repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { fmt.Printf("Error: %v\n", e) os.Exit(1) } os.Exit(0) } // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/step9_try/step9_try.go ================================================ package main import ( "errors" "fmt" "os" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval 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 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 { 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) } default: return ast } } func is_macro_call(ast MalType, env EnvType) bool { if List_Q(ast) { slc, _ := GetSlice(ast) if len(slc) == 0 { return false } a0 := slc[0] if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { mac, e := env.Get(a0.(Symbol)) if e != nil { return false } if MalFunc_Q(mac) { return mac.(MalFunc).GetMacro() } } } return false } func macroexpand(ast MalType, env EnvType) (MalType, error) { var mac MalType var e error for is_macro_call(ast, env) { slc, _ := GetSlice(ast) a0 := slc[0] mac, e = env.Get(a0.(Symbol)) if e != nil { return nil, e } fn := mac.(MalFunc) ast, e = Apply(fn, slc[1:]) if e != nil { return nil, e } } return ast, nil } func eval_ast(ast MalType, env EnvType) (MalType, error) { //fmt.Printf("eval_ast: %#v\n", ast) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if List_Q(ast) { lst := []MalType{} for _, a := range ast.(List).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return List{lst, nil}, nil } else if Vector_Q(ast) { lst := []MalType{} for _, a := range ast.(Vector).Val { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else { return ast, nil } } func EVAL(ast MalType, env EnvType) (MalType, error) { var e error for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) switch ast.(type) { case List: // continue default: return eval_ast(ast, env) } // apply list ast, e = macroexpand(ast, env) if e != nil { return nil, e } if !List_Q(ast) { return eval_ast(ast, env) } if len(ast.(List).Val) == 0 { return ast, nil } a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "quote": return a1, nil case "quasiquoteexpand": return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": fn, e := EVAL(a2, env) fn = fn.(MalFunc).SetMacro() if e != nil { return nil, e } return env.Set(a1.(Symbol), fn), nil case "macroexpand": return macroexpand(a1, env) case "try*": var exc MalType exp, e := EVAL(a1, env) if e == nil { return exp, nil } else { if a2 != nil && List_Q(a2) { a2s, _ := GetSlice(a2) if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { switch e.(type) { case MalError: exc = e.(MalError).Obj default: exc = e.Error() } binds := NewList(a2s[1]) new_env, e := NewEnv(env, binds, NewList(exc)) if e != nil { return nil, e } exp, e = EVAL(a2s[2], new_env) if e == nil { return exp, nil } } } return nil, e } case "do": lst := ast.(List).Val _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: el, e := eval_ast(ast, env) if e != nil { return nil, e } f := el.(List).Val[0] if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(el.(List).Val[1:]) } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { return EVAL(a[0], repl_env) }, nil}) repl_env.Set(Symbol{"*ARGV*"}, List{}) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") // called with mal script to load and eval if len(os.Args) > 1 { args := make([]MalType, 0, len(os.Args)-2) for _, a := range os.Args[2:] { args = append(args, a) } repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { fmt.Printf("Error: %v\n", e) os.Exit(1) } os.Exit(0) } // repl loop for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/stepA_mal/stepA_mal.go ================================================ package main import ( "errors" "fmt" "os" "strings" ) import ( "mal/src/core" . "mal/src/env" "mal/src/printer" "mal/src/reader" "mal/src/readline" . "mal/src/types" ) // read func READ(str string) (MalType, error) { return reader.Read_str(str) } // eval 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 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 { 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) } default: return ast } } func map_eval(xs []MalType, env EnvType) ([]MalType, error) { lst := []MalType{} for _, a := range xs { exp, e := EVAL(a, env) if e != nil { return nil, e } lst = append(lst, exp) } return lst, nil } func EVAL(ast MalType, env EnvType) (MalType, error) { for { //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) if Symbol_Q(ast) { return env.Get(ast.(Symbol)) } else if Vector_Q(ast) { lst, e := map_eval(ast.(Vector).Val, env) if e != nil { return nil, e } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { m := ast.(HashMap) new_hm := HashMap{map[string]MalType{}, nil} for k, v := range m.Val { kv, e2 := EVAL(v, env) if e2 != nil { return nil, e2 } new_hm.Val[k] = kv } return new_hm, nil } else if !List_Q(ast) { return ast, nil } else { // apply list if len(ast.(List).Val) == 0 { return ast, nil } a0 := ast.(List).Val[0] var a1 MalType = nil var a2 MalType = nil switch len(ast.(List).Val) { case 1: a1 = nil a2 = nil case 2: a1 = ast.(List).Val[1] a2 = nil default: a1 = ast.(List).Val[1] a2 = ast.(List).Val[2] } a0sym := "__<*fn*>__" if Symbol_Q(a0) { a0sym = a0.(Symbol).Val } switch a0sym { case "def!": res, e := EVAL(a2, env) if e != nil { return nil, e } return env.Set(a1.(Symbol), res), nil case "let*": let_env, e := NewEnv(env, nil, nil) if e != nil { return nil, e } arr1, e := GetSlice(a1) if e != nil { return nil, e } for i := 0; i < len(arr1); i += 2 { if !Symbol_Q(arr1[i]) { return nil, errors.New("non-symbol bind value") } exp, e := EVAL(arr1[i+1], let_env) if e != nil { return nil, e } let_env.Set(arr1[i].(Symbol), exp) } ast = a2 env = let_env case "quote": return a1, nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": fn, e := EVAL(a2, env) fn = fn.(MalFunc).SetMacro() if e != nil { return nil, e } return env.Set(a1.(Symbol), fn), nil case "try*": var exc MalType exp, e := EVAL(a1, env) if e == nil { return exp, nil } else { if a2 != nil && List_Q(a2) { a2s, _ := GetSlice(a2) if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") { switch e.(type) { case MalError: exc = e.(MalError).Obj default: exc = e.Error() } binds := NewList(a2s[1]) new_env, e := NewEnv(env, binds, NewList(exc)) if e != nil { return nil, e } exp, e = EVAL(a2s[2], new_env) if e == nil { return exp, nil } } } return nil, e } case "do": lst := ast.(List).Val _, e := map_eval(lst[1 : len(lst)-1], env) if e != nil { return nil, e } if len(lst) == 1 { return nil, nil } ast = lst[len(lst)-1] case "if": cond, e := EVAL(a1, env) if e != nil { return nil, e } if cond == nil || cond == false { if len(ast.(List).Val) >= 4 { ast = ast.(List).Val[3] } else { return nil, nil } } else { ast = a2 } case "fn*": fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: f, e := EVAL(a0, env) if e != nil { return nil, e } args := ast.(List).Val[1:] if MalFunc_Q(f) && f.(MalFunc).GetMacro() { new_ast, e := Apply(f.(MalFunc), args) if e != nil { return nil, e } ast = new_ast continue } args, e = map_eval(args, env) if e != nil { return nil, e } if MalFunc_Q(f) { fn := f.(MalFunc) ast = fn.Exp env, e = NewEnv(fn.Env, fn.Params, List{args, nil}) if e != nil { return nil, e } } else { fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } return fn.Fn(args) } } } } // TCO loop } // print func PRINT(exp MalType) (string, error) { return printer.Pr_str(exp, true), nil } var repl_env, _ = NewEnv(nil, nil, nil) // repl func rep(str string) (MalType, error) { var exp MalType var res string var e error if exp, e = READ(str); e != nil { return nil, e } if exp, e = EVAL(exp, repl_env); e != nil { return nil, e } if res, e = PRINT(exp); e != nil { return nil, e } return res, nil } func main() { // core.go: defined using go for k, v := range core.NS { repl_env.Set(Symbol{k}, Func{v.(func([]MalType) (MalType, error)), nil}) } repl_env.Set(Symbol{"eval"}, Func{func(a []MalType) (MalType, error) { return EVAL(a[0], repl_env) }, nil}) repl_env.Set(Symbol{"*ARGV*"}, List{}) // core.mal: defined using the language itself rep("(def! *host-language* \"go\")") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") // called with mal script to load and eval if len(os.Args) > 1 { args := make([]MalType, 0, len(os.Args)-2) for _, a := range os.Args[2:] { args = append(args, a) } repl_env.Set(Symbol{"*ARGV*"}, List{args, nil}) if _, e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil { fmt.Printf("Error: %v\n", e) os.Exit(1) } os.Exit(0) } // repl loop rep("(println (str \"Mal [\" *host-language* \"]\"))") for { text, err := readline.Readline("user> ") text = strings.TrimRight(text, "\n") if err != nil { return } var out MalType var e error if out, e = rep(text); e != nil { if e.Error() == "" { continue } fmt.Printf("Error: %v\n", e) continue } fmt.Printf("%v\n", out) } } ================================================ FILE: impls/go/src/types/types.go ================================================ package types import ( "errors" "fmt" "reflect" "strings" ) // Errors/Exceptions type MalError struct { Obj MalType } func (e MalError) Error() string { return fmt.Sprintf("%#v", e.Obj) } // General types type MalType interface { } type EnvType interface { Find(key Symbol) EnvType Set(key Symbol, value MalType) MalType Get(key Symbol) (MalType, error) } // Scalars func Nil_Q(obj MalType) bool { return obj == nil } func True_Q(obj MalType) bool { b, ok := obj.(bool) return ok && b == true } func False_Q(obj MalType) bool { b, ok := obj.(bool) return ok && b == false } func Number_Q(obj MalType) bool { _, ok := obj.(int) return ok } // Symbols type Symbol struct { Val string } func Symbol_Q(obj MalType) bool { _, ok := obj.(Symbol) return ok } // Keywords func NewKeyword(s string) (MalType, error) { return "\u029e" + s, nil } func Keyword_Q(obj MalType) bool { s, ok := obj.(string) return ok && strings.HasPrefix(s, "\u029e") } // Strings func String_Q(obj MalType) bool { _, ok := obj.(string) return ok } // Functions type Func struct { Fn func([]MalType) (MalType, error) Meta MalType } func Func_Q(obj MalType) bool { _, ok := obj.(Func) return ok } type MalFunc struct { Eval func(MalType, EnvType) (MalType, error) Exp MalType Env EnvType Params MalType IsMacro bool GenEnv func(EnvType, MalType, MalType) (EnvType, error) Meta MalType } func MalFunc_Q(obj MalType) bool { _, ok := obj.(MalFunc) return ok } func (f MalFunc) SetMacro() MalType { f.IsMacro = true return f } func (f MalFunc) GetMacro() bool { return f.IsMacro } // Take either a MalFunc or regular function and apply it to the // arguments func Apply(f_mt MalType, a []MalType) (MalType, error) { switch f := f_mt.(type) { case MalFunc: env, e := f.GenEnv(f.Env, f.Params, List{a, nil}) if e != nil { return nil, e } return f.Eval(f.Exp, env) case Func: return f.Fn(a) case func([]MalType) (MalType, error): return f(a) default: return nil, errors.New("Invalid function to Apply") } } // Lists type List struct { Val []MalType Meta MalType } func NewList(a ...MalType) MalType { return List{a, nil} } func List_Q(obj MalType) bool { _, ok := obj.(List) return ok } // Vectors type Vector struct { Val []MalType Meta MalType } func Vector_Q(obj MalType) bool { _, ok := obj.(Vector) return ok } func GetSlice(seq MalType) ([]MalType, error) { switch obj := seq.(type) { case List: return obj.Val, nil case Vector: return obj.Val, nil default: return nil, errors.New("GetSlice called on non-sequence") } } // Hash Maps type HashMap struct { Val map[string]MalType Meta MalType } func NewHashMap(seq MalType) (MalType, error) { lst, e := GetSlice(seq) if e != nil { return nil, e } if len(lst)%2 == 1 { return nil, errors.New("Odd number of arguments to NewHashMap") } m := map[string]MalType{} for i := 0; i < len(lst); i += 2 { str, ok := lst[i].(string) if !ok { return nil, errors.New("expected hash-map key string") } m[str] = lst[i+1] } return HashMap{m, nil}, nil } func HashMap_Q(obj MalType) bool { _, ok := obj.(HashMap) return ok } // Atoms type Atom struct { Val MalType Meta MalType } func (a *Atom) Set(val MalType) MalType { a.Val = val return a } func Atom_Q(obj MalType) bool { _, ok := obj.(*Atom) return ok } // General functions func _obj_type(obj MalType) string { if obj == nil { return "nil" } return reflect.TypeOf(obj).Name() } func Sequential_Q(seq MalType) bool { if seq == nil { return false } return (reflect.TypeOf(seq).Name() == "List") || (reflect.TypeOf(seq).Name() == "Vector") } func Equal_Q(a MalType, b MalType) bool { ota := reflect.TypeOf(a) otb := reflect.TypeOf(b) if !((ota == otb) || (Sequential_Q(a) && Sequential_Q(b))) { return false } //av := reflect.ValueOf(a); bv := reflect.ValueOf(b) //fmt.Printf("here2: %#v\n", reflect.TypeOf(a).Name()) //switch reflect.TypeOf(a).Name() { switch a.(type) { case Symbol: return a.(Symbol).Val == b.(Symbol).Val case List: as, _ := GetSlice(a) bs, _ := GetSlice(b) if len(as) != len(bs) { return false } for i := 0; i < len(as); i += 1 { if !Equal_Q(as[i], bs[i]) { return false } } return true case Vector: as, _ := GetSlice(a) bs, _ := GetSlice(b) if len(as) != len(bs) { return false } for i := 0; i < len(as); i += 1 { if !Equal_Q(as[i], bs[i]) { return false } } return true case HashMap: am := a.(HashMap).Val bm := b.(HashMap).Val if len(am) != len(bm) { return false } for k, v := range am { if !Equal_Q(v, bm[k]) { return false } } return true default: return a == b } } ================================================ FILE: impls/go/tests/step2_eval.mal ================================================ ;; Testing evaluation of excessive arguments (+ 1 2 3) ;=>Error: wrong number of arguments ;; Valid call (+ 1 2) ;=>3 ;; Testing evaluation of missing arguments (+ 1) ;=>Error: wrong number of arguments ;; Testing evaluation of missing arguments (+) ;=>Error: wrong number of arguments ;; Testing evaluation of excessive arguments (- 1 2 3) ;=>Error: wrong number of arguments ;; Valid call (- 1 2) ;=>-1 ;; Testing evaluation of missing arguments (- 1) ;=>Error: wrong number of arguments ;; Testing evaluation of missing arguments (-) ;=>Error: wrong number of arguments ================================================ FILE: impls/go/tests/step4_if_fn_do.mal ================================================ ;; Testing evaluation of excessive arguments (+ 1 2 3) ;=>Error: wrong number of arguments (3 instead of 2) ;; Valid call (+ 1 2) ;=>3 ;; Testing evaluation of missing arguments (+ 1) ;=>Error: wrong number of arguments (1 instead of 2) ;; Testing evaluation of missing arguments (+) ;=>Error: wrong number of arguments (0 instead of 2) ;; Testing evaluation of excessive arguments (= 1 2 3) ;=>Error: wrong number of arguments (3 instead of 2) ;; Valid call (= 1 2) ;=>false ;; Testing evaluation of missing arguments (= 1) ;=>Error: wrong number of arguments (1 instead of 2) ;; Testing evaluation of missing arguments (=) ;=>Error: wrong number of arguments (0 instead of 2) ================================================ FILE: impls/go/tests/step5_tco.mal ================================================ ;; Go: skipping non-TCO recursion ;; Reason: completes even at 100,000 ================================================ FILE: impls/groovy/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install groovy ================================================ FILE: impls/groovy/GroovyWrapper.groovy ================================================ /* From: * http://groovy.jmiguel.eu/groovy.codehaus.org/WrappingGroovyScript.html */ /* * Copyright 2002-2007 the original author or authors. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, software * distributed under the License is distributed on an "AS IS" BASIS, * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. */ /** * Wrap a script and groovy jars to an executable jar */ def cli = new CliBuilder() cli.h( longOpt: 'help', required: false, 'show usage information' ) cli.d( longOpt: 'destfile', argName: 'destfile', required: false, args: 1, 'jar destintation filename, defaults to {mainclass}.jar' ) cli.m( longOpt: 'mainclass', argName: 'mainclass', required: true, args: 1, 'fully qualified main class, eg. HelloWorld' ) cli.c( longOpt: 'groovyc', required: false, 'Run groovyc' ) //-------------------------------------------------------------------------- def opt = cli.parse(args) if (!opt) { return } if (opt.h) { cli.usage(); return } def mainClass = opt.m def scriptBase = mainClass.replace( '.', '/' ) def scriptFile = new File( scriptBase + '.groovy' ) if (!scriptFile.canRead()) { println "Cannot read script file: '${scriptFile}'" return } def destFile = scriptBase + '.jar' if (opt.d) { destFile = opt.d } //-------------------------------------------------------------------------- def ant = new AntBuilder() if (opt.c) { ant.echo( "Compiling ${scriptFile}" ) org.codehaus.groovy.tools.FileSystemCompiler.main( [ scriptFile ] as String[] ) } def GROOVY_HOME = new File( System.getenv('GROOVY_HOME') ) if (!GROOVY_HOME.canRead()) { ant.echo( "Missing environment variable GROOVY_HOME: '${GROOVY_HOME}'" ) return } ant.jar( destfile: destFile, compress: true, index: true ) { //fileset( dir: '.', includes: scriptBase + '*.class' ) fileset( dir: '.', includes: '*.class' ) zipgroupfileset( dir: GROOVY_HOME, includes: 'embeddable/groovy-all-*.jar' ) zipgroupfileset( dir: GROOVY_HOME, includes: 'lib/commons*.jar' ) // add more jars here manifest { attribute( name: 'Main-Class', value: mainClass ) } } ant.echo( "Run script using: \'java -jar ${destFile} ...\'" ) ================================================ FILE: impls/groovy/Makefile ================================================ CLASSES = types.class reader.class printer.class env.class core.class all: ${CLASSES} dist: mal.jar step1_read_print.groovy: types.class reader.class printer.class step2_eval.groovy: types.class reader.class printer.class step3_env.groovy: types.class reader.class printer.class env.class step4_if_fn_do.groovy step6_file.groovy step7_quote.groovy step8_macros.groovy step9_try.groovy stepA_mal.groovy: ${CLASSES} types.class: types.groovy groovyc $< env.class: env.groovy groovyc $< reader.class: reader.groovy groovyc $< printer.class: printer.groovy groovyc $< core.class: core.groovy types.class reader.class printer.class groovyc $< mal.jar: ${CLASSES} groovyc stepA_mal.groovy GROOVY_HOME=/usr/share/groovy groovy GroovyWrapper -d $@ -m stepA_mal SHELL := bash mal: mal.jar cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ chmod +x mal clean: rm -f *.class classes/* mal.jar mal rmdir classes || true ================================================ FILE: impls/groovy/core.groovy ================================================ import types import types.MalException import types.MalSymbol import types.MalFunc import reader import printer class core { def static do_pr_str(args) { return printer._pr_list(args, " ", true) } def static do_str(args) { return printer._pr_list(args, "", false) } def static do_prn(args) { println(printer._pr_list(args, " ", true)) } def static do_println(args) { println(printer._pr_list(args, " ", false)) } def static do_concat(args) { args.inject([], { a, b -> a + (b as List) }) } def static do_nth(args) { if (args[0].size() <= args[1]) { throw new MalException("nth: index out of range") } args[0][args[1]] } def static do_apply(args) { def start_args = args.drop(1).take(args.size()-2) as List args[0](start_args + (args.last() as List)) } def static do_swap_BANG(args) { def (atm,f) = [args[0], args[1]] atm.value = f([atm.value] + (args.drop(2) as List)) } def static do_conj(args) { if (types.list_Q(args[0])) { args.drop(1).inject(args[0], { a, b -> [b] + a }) } else { types.vector(args.drop(1).inject(args[0], { a, b -> a + [b] })) } } def static do_seq(args) { def obj = args[0] switch (obj) { case { types.list_Q(obj) }: return obj.size() == 0 ? null : obj case { types.vector_Q(obj) }: return obj.size() == 0 ? null : obj.clone() case { types.string_Q(obj) }: return obj.size() == 0 ? null : obj.collect{ it.toString() } case null: return null default: throw new MalException("seq: called on non-sequence") } } static ns = [ "=": { a -> a[0]==a[1]}, "throw": { a -> throw new MalException(a[0]) }, "nil?": { a -> a[0] == null }, "true?": { a -> a[0] == true }, "false?": { a -> a[0] == false }, "string?": { a -> types.string_Q(a[0]) }, "symbol": { a -> new MalSymbol(a[0]) }, "symbol?": { a -> a[0] instanceof MalSymbol }, "keyword": { a -> types.keyword(a[0]) }, "keyword?": { a -> types.keyword_Q(a[0]) }, "number?": { a -> a[0] instanceof Integer }, "fn?": { a -> (a[0] instanceof MalFunc && !a[0].ismacro) || a[0] instanceof Closure }, "macro?": { a -> a[0] instanceof MalFunc && a[0].ismacro }, "pr-str": core.&do_pr_str, "str": core.&do_str, "prn": core.&do_prn, "println": core.&do_println, "read-string": reader.&read_str, "readline": { a -> System.console().readLine(a[0]) }, "slurp": { a -> new File(a[0]).text }, "<": { a -> a[0]": { a -> a[0]>a[1]}, ">=": { a -> a[0]>=a[1]}, "+": { a -> a[0]+a[1]}, "-": { a -> a[0]-a[1]}, "*": { a -> a[0]*a[1]}, "/": { a -> a[0]/a[1]}, // / "time-ms": { a -> System.currentTimeMillis() }, "list": { a -> a}, "list?": { a -> types.list_Q(a[0]) }, "vector": { a -> types.vector(a) }, "vector?": { a -> types.vector_Q(a[0]) }, "hash-map": { a -> types.hash_map(a) }, "map?": { a -> types.hash_map_Q(a[0]) }, "assoc": { a -> types.assoc_BANG(types.copy(a[0]), a.drop(1)) }, "dissoc": { a -> types.dissoc_BANG(types.copy(a[0]), a.drop(1)) }, "get": { a -> a[0] == null ? null : a[0][a[1]] }, "contains?": { a -> a[0].containsKey(a[1]) }, "keys": { a -> a[0].keySet() as List }, "vals": { a -> a[0].values() as List }, "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) }, "empty?": { a -> a[0] == null || a[0].size() == 0 }, "count": { a -> a[0] == null ? 0 : a[0].size() }, "apply": core.&do_apply, "map": { a -> a[1].collect { x -> a[0].call([x]) } }, "conj": core.&do_conj, "seq": core.&do_seq, "meta": { a -> a[0].hasProperty("meta") ? a[0].getProperties().meta : null }, "with-meta": { a -> def b = types.copy(a[0]); b.getMetaClass().meta = a[1]; b }, "atom": { a -> new types.MalAtom(a[0]) }, "atom?": { a -> a[0] instanceof types.MalAtom }, "deref": { a -> a[0].value }, "reset!": { a -> a[0].value = a[1] }, "swap!": core.&do_swap_BANG ] } ================================================ FILE: impls/groovy/env.groovy ================================================ import types.MalException import types.MalSymbol class env { static class Env { def data def outer Env() { outer = null data = [:] } Env(Env outer_env) { outer = outer_env data = [:] } Env(Env outer_env, binds, exprs) { outer = outer_env data = [:] for (int i=0; i i) ? exprs[i..-1] : [] break } else { data[binds[i].value] = exprs[i] } } } def set(MalSymbol key, def val) { data[key.value] = val } def find(String key) { if (data.containsKey(key)) { this } else if (outer != null) { outer.find(key) } else { null } } def get(String key) { def e = find(key) if (e == null) { throw new MalException("'${key}' not found") } else { e.data.get(key) } } } } ================================================ FILE: impls/groovy/printer.groovy ================================================ import groovy.json.StringEscapeUtils import types import types.MalSymbol import types.MalAtom class printer { def static _pr_list(lst, sep, Boolean print_readably) { return lst.collect{ e -> pr_str(e, print_readably) }.join(sep) } def static pr_str(exp, Boolean print_readably) { def _r = print_readably switch (exp) { case { types.list_Q(exp) }: def lst = exp.collect { pr_str(it, _r) } return "(${lst.join(" ")})" case { types.vector_Q(exp) }: def lst = exp.collect { pr_str(it, _r) } return "[${lst.join(" ")}]" case Map: def lst = [] exp.each { k,v -> lst.add(pr_str(k,_r)); lst.add(pr_str(v,_r)) } return "{${lst.join(" ")}}" case String: if (types.keyword_Q(exp)) { return ":" + exp.drop(1) } else if (print_readably) { return "\"${StringEscapeUtils.escapeJava(exp)}\"" } else { return exp } case null: return 'nil' case MalSymbol: return exp.value case MalAtom: return "(atom ${exp.value})" default: return exp.toString() } } } ================================================ FILE: impls/groovy/reader.groovy ================================================ import groovy.json.StringEscapeUtils import types import types.MalException import types.MalSymbol class reader { static class Reader { def tokens def position Reader(def toks) { tokens = toks position = 0 } def peek() { if (position >= tokens.size) { null } else { tokens[position] } } def next() { if (position >= tokens.size) { null } else { tokens[position++] } } } def static tokenizer(String str) { def m = str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ def tokens = [] while (m.find()) { String token = m.group(1) if (token != null && !(token == "") && !(token[0] == ';')) { tokens.add(token) } } return tokens } def static read_atom(Reader rdr) { def token = rdr.next() def m = token =~ /(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^"((?:\\.|[^\\"])*)"$|^"(.*)$|:(.*)|(^[^"]*$)/ if (!m.find()) { throw new MalException("unrecognized token '$token'") } if (m.group(1) != null) { Integer.parseInt(m.group(1)) } else if (m.group(3) != null) { null } else if (m.group(4) != null) { true } else if (m.group(5) != null) { false } else if (m.group(6) != null) { if (token[token.length() - 1] != '"') { throw new MalException("expected '\"', got EOF") } StringEscapeUtils.unescapeJava(m.group(6)) } else if (m.group(7) != null) { throw new MalException("expected '\"', got EOF") } else if (m.group(8) != null) { "\u029e" + m.group(8) } else if (m.group(9) != null) { new MalSymbol(m.group(9)) } else { throw new MalException("unrecognized '${m.group(0)}'") } } def static read_list(Reader rdr, char start, char end) { def token = rdr.next() def lst = [] if (token.charAt(0) != start) { throw new MalException("expected '${start}'") } while ((token = rdr.peek()) != null && token.charAt(0) != end) { lst.add(read_form(rdr)) } if (token == null) { throw new MalException("expected '${end}', got EOF") } rdr.next() return lst } def static read_vector(Reader rdr) { def lst = read_list(rdr, '[' as char, ']' as char) return types.vector(lst) } def static read_hash_map(Reader rdr) { def lst = read_list(rdr, '{' as char, '}' as char) return types.hash_map(lst) } def static read_form(Reader rdr) { def token = rdr.peek() switch (token) { // reader macros/transforms case "'": rdr.next() return [new MalSymbol("quote"), read_form(rdr)] case '`': rdr.next() return [new MalSymbol("quasiquote"), read_form(rdr)] case '~': rdr.next() return [new MalSymbol("unquote"), read_form(rdr)] case '~@': rdr.next() return [new MalSymbol("splice-unquote"), read_form(rdr)] case '^': rdr.next() def meta = read_form(rdr); return [new MalSymbol("with-meta"), read_form(rdr), meta] case '@': rdr.next() return [new MalSymbol("deref"), read_form(rdr)] // list case ')': throw new MalException("unexpected ')'") case '(': return read_list(rdr, '(' as char, ')' as char) // vector case ']': throw new MalException("unexpected ']'") case '[': return read_vector(rdr) // hash-map case '}': throw new MalException("unexpected '}'") case '{': return read_hash_map(rdr) // atom default: return read_atom(rdr) } } def static read_str(String str) { def tokens = tokenizer(str) if (tokens.size() == 0) { return null; } //println "tokens ${tokens}" def rdr = new Reader(tokens) read_form(rdr) } } ================================================ FILE: impls/groovy/run ================================================ #!/usr/bin/env bash exec groovy $(dirname $0)/${STEP:-stepA_mal}.groovy "${@}" ================================================ FILE: impls/groovy/step0_repl.groovy ================================================ // READ READ = { str -> str } // EVAL EVAL = { ast, env -> ast } // PRINT PRINT = { exp -> exp } // REPL REP = { str -> PRINT(EVAL(READ(str), [:])) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break } try { println REP(line) } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step1_read_print.groovy ================================================ import reader import printer import types.MalException // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> ast } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL REP = { str -> PRINT(EVAL(READ(str), [:])) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step2_eval.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> // println("EVAL: ${printer.pr_str(ast,true)}") switch (ast) { case MalSymbol: if (env.containsKey(ast.value)) return env.get(ast.value) throw new MalException("'${ast.value}' not found") case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el[1..-1]] f(args) } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = [ "+": { a -> a[0]+a[1]}, "-": { a -> a[0]-a[1]}, "*": { a -> a[0]*a[1]}, "/": { a -> a[0]/a[1]}] // / REP = { str -> PRINT(EVAL(READ(str), repl_env)) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step3_env.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import env.Env // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } return EVAL(ast[2], let_env) default: def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el[1..-1]] f(args) } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); repl_env.set(new MalSymbol("+"), { a -> a[0]+a[1]}); repl_env.set(new MalSymbol("-"), { a -> a[0]-a[1]}); repl_env.set(new MalSymbol("*"), { a -> a[0]*a[1]}); repl_env.set(new MalSymbol("/"), { a -> a[0]/a[1]}); // / REP = { str -> PRINT(EVAL(READ(str), repl_env)) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step4_if_fn_do.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } return EVAL(ast[2], let_env) case { it instanceof MalSymbol && it.value == "do" }: return (ast[1..-1].collect { EVAL(it, env) })[-1] case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { return EVAL(ast[3], env) } else { return null } } else { return EVAL(ast[2], env) } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el.size() > 1 ? el[1..-1] : []] f(args) } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step5_tco.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el.size() > 1 ? el[1..-1] : []] if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step6_file.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el.drop(1)] if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) repl_env.set(new MalSymbol("*ARGV*"), this.args as List) // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (this.args.size() > 0) { repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) REP("(load-file \"${this.args[0]}\")") System.exit(0) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step7_quote.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL 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 { 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 } } EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def el = ast.collect { EVAL(it, env) } def (f, args) = [el[0], el.drop(1)] if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) repl_env.set(new MalSymbol("*ARGV*"), this.args as List) // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (this.args.size() > 0) { repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) REP("(load-file \"${this.args[0]}\")") System.exit(0) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step8_macros.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL 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 { 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 } } EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO case { it instanceof MalSymbol && it.value == "defmacro!" }: def f = EVAL(ast[2], env) f = f.clone() f.ismacro = true return env.set(ast[1], f) case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def f = EVAL(ast[0], env) def args = ast.drop(1) if (f instanceof MalFunc && f.ismacro) { ast = f(args) break // TCO } args = args.collect { EVAL(it, env) } if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) repl_env.set(new MalSymbol("*ARGV*"), this.args as List) // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (this.args.size() > 0) { repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) REP("(load-file \"${this.args[0]}\")") System.exit(0) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/step9_try.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL 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 { 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 } } EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO case { it instanceof MalSymbol && it.value == "defmacro!" }: def f = EVAL(ast[2], env) f = f.clone() f.ismacro = true return env.set(ast[1], f) case { it instanceof MalSymbol && it.value == "try*" }: try { return EVAL(ast[1], env) } catch(exc) { if (ast.size() > 2 && ast[2][0] instanceof MalSymbol && ast[2][0].value == "catch*") { def e = null if (exc instanceof MalException) { e = exc.obj } else { e = exc.message } return EVAL(ast[2][2], new Env(env, [ast[2][1]], [e])) } else { throw exc } } case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def f = EVAL(ast[0], env) def args = ast.drop(1) if (f instanceof MalFunc && f.ismacro) { ast = f(args) break // TCO } args = args.collect { EVAL(it, env) } if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) repl_env.set(new MalSymbol("*ARGV*"), this.args as List) // core.mal: defined using mal itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (this.args.size() > 0) { repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) REP("(load-file \"${this.args[0]}\")") System.exit(0) } while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/stepA_mal.groovy ================================================ import reader import printer import types import types.MalException import types.MalSymbol import types.MalFunc import env.Env import core // READ READ = { str -> reader.read_str str } // EVAL 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 { 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 } } EVAL = { ast, env -> while (true) { def dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv != null) { def dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != false) { println("EVAL: ${printer.pr_str(ast,true)}") } } switch (ast) { case MalSymbol: return env.get(ast.value); case List: if (types.vector_Q(ast)) { return types.vector(ast.collect { EVAL(it, env) }) } break; case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) } return new_hm default: return ast } if (ast.size() == 0) return ast switch (ast[0]) { case { it instanceof MalSymbol && it.value == "def!" }: return env.set(ast[1], EVAL(ast[2], env)) case { it instanceof MalSymbol && it.value == "let*" }: def let_env = new Env(env) for (int i=0; i < ast[1].size(); i += 2) { let_env.set(ast[1][i], EVAL(ast[1][i+1], let_env)) } env = let_env ast = ast[2] break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO case { it instanceof MalSymbol && it.value == "defmacro!" }: def f = EVAL(ast[2], env) f = f.clone() f.ismacro = true return env.set(ast[1], f) case { it instanceof MalSymbol && it.value == "try*" }: try { return EVAL(ast[1], env) } catch(exc) { if (ast.size() > 2 && ast[2][0] instanceof MalSymbol && ast[2][0].value == "catch*") { def e = null if (exc instanceof MalException) { e = exc.obj } else { e = exc.message } return EVAL(ast[2][2], new Env(env, [ast[2][1]], [e])) } else { throw exc } } case { it instanceof MalSymbol && it.value == "do" }: ast.size() > 2 ? ast[1..-2].collect { EVAL(it, env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: def cond = EVAL(ast[1], env) if (cond == false || cond == null) { if (ast.size > 3) { ast = ast[3] break // TCO } else { return null } } else { ast = ast[2] break // TCO } case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: def f = EVAL(ast[0], env) def args = ast.drop(1) if (f instanceof MalFunc && f.ismacro) { ast = f(args) break // TCO } args = args.collect { EVAL(it, env) } if (f instanceof MalFunc) { env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { return f(args) } } } } // PRINT PRINT = { exp -> printer.pr_str exp, true } // REPL repl_env = new Env(); REP = { str -> PRINT(EVAL(READ(str), repl_env)) } // core.EXT: defined using Groovy core.ns.each { k,v -> repl_env.set(new MalSymbol(k), v) } repl_env.set(new MalSymbol("eval"), { a -> EVAL(a[0], repl_env)}) repl_env.set(new MalSymbol("*ARGV*"), this.args as List) // core.mal: defined using mal itself REP("(def! *host-language* \"groovy\")") REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (this.args.size() > 0) { repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List) REP("(load-file \"${this.args[0]}\")") System.exit(0) } REP("(println (str \"Mal [\" *host-language* \"]\"))") while (true) { line = System.console().readLine 'user> ' if (line == null) { break; } try { println REP(line) } catch(MalException ex) { println "Error: ${printer.pr_str(ex.obj, true)}" } catch(StackOverflowError ex) { println "Error: ${ex}" } catch(ex) { println "Error: $ex" ex.printStackTrace() } } ================================================ FILE: impls/groovy/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/groovy/types.groovy ================================================ import groovy.transform.InheritConstructors import groovy.transform.AutoClone class types { def static copy(obj) { def new_obj = obj if (obj instanceof Collection || obj instanceof Map) { new_obj = obj.clone() if (obj.hasProperty("meta")) { new_obj.getMetaClass().meta = obj.getProperties().meta } if (obj.hasProperty("isvector")) { new_obj.getMetaClass().isvector = obj.getProperties().isvector } } else if (obj instanceof Object) { new_obj = obj.clone() } return new_obj } @InheritConstructors static class MalException extends Exception { def obj MalException(String message) { super(message) obj = message } MalException(_obj) { super("mal exception containing object") obj = _obj } } def static string_Q(o) { return o instanceof String && (o.size() == 0 || o[0] != "\u029e") } @AutoClone static class MalSymbol implements Comparable { String value MalSymbol(String name) { value = name } int compareTo(o) { value <=> o.value } } def static keyword(o) { types.&keyword_Q(o) ? o : ("\u029e" + o) } def static keyword_Q(o) { return o instanceof String && o.size() > 0 && o[0] == "\u029e" } def static list_Q(o) { //return (o instanceof List || o instanceof Object[]) && return o instanceof List && !o.hasProperty("isvector") } def static vector(o) { def v = o.collect() v.metaClass.isvector = true v } def static vector_Q(o) { return o instanceof List && o.hasProperty("isvector") && o.isvector } def static hash_map(lst) { def m = [:] assoc_BANG(m, lst) } def static assoc_BANG(m, kvs) { for (int i=0; i ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Guile RUN apt-get -y install guile-3.0 libpcre3-dev ================================================ FILE: impls/guile/Makefile ================================================ SOURCES_BASE = readline.scm types.scm reader.scm printer.scm SOURCES_LISP = env.scm core.scm stepA_mal.scm SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.scm mal.scm: $(SOURCES) echo "#! /usr/bin/env guile" > $@ echo "!#" >> $@ cat $+ | sed $(foreach f,$(+),-e 's/(readline)//') >> $@ chmod +x $@ clean: rm -f mal.scm ================================================ FILE: impls/guile/core.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (core) (export core.ns ->list) (import (guile) (rnrs) (types) (reader) (printer) (ice-9 match) (readline))) (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) ((vector? obj) (vector-length obj)) (else (length obj)))) (define (_empty? obj) (zero? (_count obj))) ;; Well, strange spec... (define (_equal? o1 o2) (define (equal-lists? lst1 lst2) (and (= (length lst1) (length lst2)) (for-all _equal? lst1 lst2))) (define (equal-hash-tables? ht1 ht2) (define (equal-values? k) (_equal? (_get ht1 k) (_get ht2 k))) (let ((keys1 (_keys ht1))) (and (= (length keys1) (length (_keys ht2))) (for-all equal-values? keys1)))) (cond ((and (_sequential? o1) (_sequential? o2)) (equal-lists? (->list o1) (->list o2))) ((and (hash-table? o1) (hash-table? o2)) (equal-hash-tables? o1 o2)) (else (equal? o1 o2)))) (define (pr-str . args) (define (pr x) (pr_str x #t)) (string-join (map pr args) " ")) (define (str . args) (define (pr x) (pr_str x #f)) (string-join (map pr args) "")) (define (prn . args) (format #t "~a~%" (apply pr-str args)) nil) (define (println . args) (define (pr x) (pr_str x #f)) (format #t "~{~a~^ ~}~%" (map pr args)) nil) (define (slurp filename) (when (not (file-exists? filename)) (throw 'mal-error (format #f "File/dir '~a' doesn't exist" filename))) (call-with-input-file filename get-string-all)) (define (_cons x y) (cons x (->list y))) (define (concat . args) (apply append (map ->list args))) (define (_nth lst n) (define ll (->list lst)) (when (>= n (length ll)) (throw 'mal-error "nth: index out of range")) (list-ref ll n)) (define (_first lst) (define ll (->list lst)) (cond ((_nil? lst) nil) ((null? ll) nil) (else (car ll)))) (define (_rest lst) (define ll (->list lst)) (cond ((_nil? lst) '()) ((null? ll) '()) (else (cdr ll)))) (define (_map f lst) (map (callable-closure f) (->list lst))) (define (_apply f . args) (define ll (let lp((next args) (ret '())) (cond ((null? next) (reverse ret)) (else (let ((n (->list (car next)))) (lp (cdr next) (if (list? n) (append (reverse n) ret) (cons n ret)))))))) (callable-apply f ll)) (define (->symbol x) ((if (symbol? x) identity string->symbol) x)) (define (->keyword x) ((if (_keyword? x) identity string->keyword) x)) (define (_hash-map . lst) (list->hash-map lst)) (define (_assoc ht . lst) (list->hash-map lst (hash-table-clone ht))) (define (_get ht k) (if (_nil? ht) nil (hash-ref ht k nil))) (define (_dissoc ht . lst) (define ht2 (hash-table-clone ht)) (for-each (lambda (k) (hash-remove! ht2 k)) lst) ht2) (define (_keys ht) (hash-map->list (lambda (k v) k) ht)) (define (_vals ht) (hash-map->list (lambda (k v) v) ht)) (define (_contains? ht k) (let ((v (hash-ref ht k '*mal-null*))) (if (eq? v '*mal-null*) #f #t))) (define (_sequential? o) (or (list? o) (vector? o))) (define (_meta c) (if (callable? c) (callable-meta-info c) (or (object-property c 'meta) nil))) (define (_with-meta c ht) (cond ((callable? c) (let ((cc (make-callable ht (callable-unbox c) #f (callable-closure c)))) cc)) (else (let ((cc (box c))) (set-object-property! cc 'meta ht) cc)))) ;; Apply closure 'c' with atom-val as one of arguments, then ;; set the result as the new val of atom. (define (_swap! atom c . rest) (let* ((args (cons (atom-val atom) rest)) (val (callable-apply c args))) (atom-val-set! atom val) val)) (define (_conj lst . args) (cond ((vector? lst) (list->vector (append (->list lst) args))) ((list? lst) (append (reverse args) (->list lst))) (else (throw 'mal-error (format #f "conj: '~a' is not list/vector" lst))))) (define (_seq obj) (cond ((_nil? obj) nil) ((_string? obj) (if (string-null? obj) nil (map string (string->list obj)))) ((_empty? obj) nil) (else (->list obj)))) (define (__readline prompt) (let ((str (_readline prompt))) (if (eof-object? str) #f str))) (define (_true? x) (eq? x #t)) (define (_false? x) (eq? x #f)) ;; We need regular named procedure for better debug (define (_atom x) (make-atom x)) (define (_atom? x) (atom? x)) (define (_deref x) (atom-val x)) (define (_reset! x v) (atom-val-set! x v)) (define (time-ms) (let ((t (gettimeofday))) (round (+ (* (car t) 1000.0) (/ (cdr t) 1000.0) 0.5)))) (define *primitives* `((list ,list) (list? ,list?) (empty? ,_empty?) (count ,_count) (= ,_equal?) (< ,<) (<= ,<=) (> ,>) (>= ,>=) (+ ,+) (- ,-) (* ,*) (/ ,/) (pr-str ,pr-str) (str ,str) (prn ,prn) (println ,println) (read-string ,read_str) (slurp ,slurp) (cons ,_cons) (concat ,concat) (vec ,vec) (nth ,_nth) (first ,_first) (rest ,_rest) (map ,_map) (apply ,_apply) (nil? ,_nil?) (true? ,_true?) (false? ,_false?) (number? ,number?) (symbol? ,symbol?) (symbol ,->symbol) (string? ,_string?) (keyword ,->keyword) (keyword? ,_keyword?) (vector? ,vector?) (vector ,vector) (hash-map ,_hash-map) (map? ,hash-table?) (assoc ,_assoc) (get ,_get) (dissoc ,_dissoc) (keys ,_keys) (vals ,_vals) (contains? ,_contains?) (sequential? ,_sequential?) (fn? ,is-func?) (macro? ,is-macro?) (readline ,__readline) (meta ,_meta) (with-meta ,_with-meta) (atom ,_atom) (atom? ,_atom?) (deref ,_deref) (reset! ,_reset!) (swap! ,_swap!) (conj ,_conj) (seq ,_seq) (time-ms ,time-ms))) ;; Well, we have to rename it to this strange name... (define core.ns *primitives*) ================================================ FILE: impls/guile/env.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (env) (export make-Env env-has env-check) (import (guile) (types))) (define (env-check sym env) (env-has sym env (lambda _ #f))) (define (sym-err-throw sym) (throw 'mal-error (format #f "'~a' not found" sym))) (define* (env-has sym env #:optional (err sym-err-throw)) (let ((v ((env 'get) sym))) (if (equal? v '*mal-null*) (err sym) v))) (define* (make-Env #:key (outer nil) (binds '()) (exprs '())) (define _env (make-hash-table)) (define (_set k v) (hash-set! _env k v)) (define (_get k) (let ((v (hash-ref _env k '*mal-null*))) (if (equal? v '*mal-null*) (if (_nil? outer) '*mal-null* ((outer 'get) k)) v))) (define (_find k) (_get k)) (define (_show) (hash-for-each (lambda (k v) (format #t "~a : ~a~%" k v)) _env) (display "outer:\n") (and (not (_nil? outer)) ((outer 'show)))) (let lp((b binds) (e exprs)) (cond ((null? b) #t) ((eq? (car b) '&) (hash-set! _env (cadr b) e)) ; handle varglist (else ; normal binding (when (not (symbol? (car b))) (throw 'mal-error (format #f "Invalid binding key! '~a'" (car b)))) (when (null? e) (throw 'mal-error "Invalid pattern for this macro")) (hash-set! _env (car b) (car e)) (lp (cdr b) (cdr e))))) (lambda (cmd) (case cmd ((set) _set) ((find) _find) ((get) _get) ((show) _show) (else (throw 'mal-error (format #f "BUG: Invalid cmd '~a'" cmd)))))) ================================================ FILE: impls/guile/pcre.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (pcre) (export new-pcre pcre-match pcre-get-substring pcre-search) (import (guile) (rnrs) (system foreign))) (define (make-blob-pointer len) (bytevector->pointer (make-bytevector len))) (define pcre-ffi (dynamic-link "libpcre")) (define %pcre-compile2 (pointer->procedure '* (dynamic-func "pcre_compile2" pcre-ffi) (list '* int '* '* '* '*))) (define %pcre-compile (pointer->procedure '* (dynamic-func "pcre_compile" pcre-ffi) (list '* int '* '* '*))) (define %pcre-exec (pointer->procedure int (dynamic-func "pcre_exec" pcre-ffi) (list '* '* '* int int int '* int))) (define %pcre-study (pointer->procedure '* (dynamic-func "pcre_study" pcre-ffi) (list '* int '*))) (define %pcre-get-substring (pointer->procedure '* (dynamic-func "pcre_get_substring" pcre-ffi) (list '* '* int int '*))) (define %pcre-free (pointer->procedure void (dynamic-func "pcre_free" pcre-ffi) (list '*))) (define %pcre-free-study (dynamic-func "pcre_free_study" pcre-ffi)) (define %pcre-free-substring (dynamic-func "pcre_free_substring" pcre-ffi)) (define-record-type pcre (fields errptr (mutable strptr) (mutable ovector) (mutable matched) (mutable code) (mutable extra))) (define (%new-pcre) (make-pcre (make-blob-pointer (sizeof ptrdiff_t)) ; errptr #f #f 0 #f #f)) (define* (new-pcre re #:optional (options 0)) (let ((reptr (string->pointer re)) ;;(errcodeptr (make-blob-pointer int)) (erroffset (make-blob-pointer int)) (tableptr %null-pointer) (pcre (%new-pcre))) ;; FIXME: add exception handling (pcre-code-set! pcre (%pcre-compile reptr options (pcre-errptr pcre) erroffset tableptr)) ;;(set-pointer-finalizer! (pcre-code pcre) %pcre-free) pcre)) (define* (pcre-match pcre str #:key (study-options 0) (exec-options 0) (ovecsize 30) (offset 0)) (let ((extra (%pcre-study (pcre-code pcre) study-options (pcre-errptr pcre))) (strptr (string->pointer str)) (ovector (make-blob-pointer (* int ovecsize)))) (pcre-matched-set! pcre (%pcre-exec (pcre-code pcre) extra strptr (string-length str) offset exec-options ovector ovecsize)) (pcre-ovector-set! pcre ovector) (pcre-strptr-set! pcre strptr) (set-pointer-finalizer! extra %pcre-free-study) pcre)) (define (pcre-get-substring pcre index) (let ((strptr (pcre-strptr pcre)) (ovector (pcre-ovector pcre)) (matched (pcre-matched pcre)) (buf (make-blob-pointer (sizeof ptrdiff_t)))) (%pcre-get-substring strptr ovector matched index buf) (let ((ret (pointer->string (dereference-pointer buf)))) (set-pointer-finalizer! (dereference-pointer buf) %pcre-free-substring) ret))) (define* (pcre-search pcre str #:key (study-options 0) (exec-options 0) (exclude " ")) (define (trim s) (string-trim-both s (lambda (x) (string-contains exclude (string x))))) (define len (string-length str)) (let lp((i 0) (ret '())) (cond ((>= i len) (reverse ret)) (else (pcre-match pcre str #:study-options study-options #:exec-options exec-options #:offset i) (if (<= (pcre-matched pcre) 0) (lp len ret) (let ((hit (trim (pcre-get-substring pcre 1))) (sublen (string-length (pcre-get-substring pcre 0)))) (if (zero? sublen) (lp len ret) (lp (+ i sublen) (cons hit ret))))))))) (define (pcre-free pcre) (and (not (null-pointer? (pcre-code pcre))) (%pcre-free (pcre-code pcre)))) ================================================ FILE: impls/guile/printer.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (printer) (export pr_str) (import (guile) (types) (ice-9 match) (ice-9 regex))) (define (print-hashmap hm p) (call-with-output-string (lambda (port) (display "{" port) (display (string-join (hash-map->list (lambda (k v) (format #f "~a ~a" (p k) (p v))) hm) " ") port) (display "}" port)))) (define (pr_str obj readable?) (define (->str s) (string-sub (string-sub (string-sub s "\\\\" "\\\\") "\"" "\\\"") "\n" "\\n")) (define (%pr_str o) (pr_str o readable?)) (match obj ((? box?) (%pr_str (unbox obj))) ((? is-func?) "#") ((? is-macro?) "#") ((? list?) (format #f "(~{~a~^ ~})" (map %pr_str obj))) ((? vector?) (format #f "[~{~a~^ ~}]" (map %pr_str (vector->list obj)))) ((? hash-table?) (print-hashmap obj %pr_str)) ((? string?) (cond ((_keyword? obj) => (lambda (m) (format #f ":~a" (substring obj 1)))) (else (if readable? (format #f "\"~a\"" (->str obj)) obj)))) ;;((? number?) (format #f "~a" obj)) ;;((? symbol?) (format #f "~a" obj)) ((? atom?) (format #f "(atom ~a)" (%pr_str (atom-val obj)))) ((? _nil?) "nil") (#t "true") (#f "false") (else (format #f "~a" obj)))) ================================================ FILE: impls/guile/reader.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (reader) (export read_str) (import (guile) (pcre) (ice-9 match) (srfi srfi-1) (ice-9 regex) (types) (ice-9 format))) (define (make-Reader tokens) (lambda (cmd) (case cmd ((next) (if (null? tokens) '() (let ((r (car tokens))) (set! tokens (cdr tokens)) r))) ((peek) (if (null? tokens) '() (car tokens))) (else (error "Reader: Invalid cmd!" cmd))))) (define *token-re* (new-pcre "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)")) (define *str-re* (new-pcre "^(\"(?:\\\\.|[^\\\\\"])*\")$")) (define (tokenizer str) (filter (lambda (s) (and (not (string-null? s)) (not (string=? (substring s 0 1) ";")))) (pcre-search *token-re* str))) (define (delim-read reader delim) (let lp((next (reader 'peek)) (ret '())) (cond ((null? next) (throw 'mal-error (format #f "expected '~a', got EOF" delim))) ((string=? next delim) (reader 'next) (reverse ret)) (else (let* ((cur (read_form reader)) (n (reader 'peek))) (lp n (cons cur ret))))))) (define (read_list reader) (cond ((string=? ")" (reader 'peek)) (reader 'next) '()) (else (delim-read reader ")")))) (define (read_vector reader) (cond ((string=? "]" (reader 'peek)) (reader 'next) #()) (else (list->vector (delim-read reader "]"))))) (define (read_hashmap reader) (define ht (make-hash-table)) (define lst (delim-read reader "}")) (cond ((null? lst) ht) (else (let lp((next lst)) (cond ((null? next) ht) (else (when (null? (cdr next)) (throw 'mal-error (format #f "read_hashmap: '~a' lack of value" (car next)))) (let ((k (car next)) (v (cadr next))) (hash-set! ht k v) (lp (cddr next))))))))) (define (read_atom reader) (let ((token (reader 'next))) (cond ((string-match "^-?[0-9][0-9.]*$" token) => (lambda (m) (string->number (match:substring m 0)))) ((> (length (pcre-search *str-re* token)) 0) (with-input-from-string token read)) ((eqv? (string-ref token 0) #\") (throw 'mal-error "expected '\"', got EOF")) ((string-match "^:(.*)" token) => (lambda (m) (string->keyword (match:substring m 1)))) ((string=? "nil" token) nil) ((string=? "true" token) #t) ((string=? "false" token) #f) (else (string->symbol token))))) (define (read_form reader) (define (clean x) (if (string? x) (string-trim-both x (lambda (c) (char-set-contains? char-set:whitespace c))) x)) (define (next) (reader 'next)) (define (more) (read_form reader)) (match (clean (reader 'peek)) (() (throw 'mal-error "blank line")) ; FIXME: what should be returned? ("'" (next) (list 'quote (more))) ("`" (next) (list 'quasiquote (more))) ("~" (next) (list 'unquote (more))) ("~@" (next) (list 'splice-unquote (more))) ("^" (next) (let ((meta (more))) `(with-meta ,(more) ,meta))) ("@" (next) `(deref ,(more))) (")" (next) (throw 'mal-error "unexpected ')'")) ("(" (next) (read_list reader)) ("]" (throw 'mal-error "unexpected ']'")) ("[" (next) (read_vector reader)) ("}" (throw 'mal-error "unexpected '}'")) ("{" (next) (read_hashmap reader)) ("" (next) (read_form reader)) (else (read_atom reader)))) (define (read_str str) (if (eof-object? str) str (let* ((tokens (tokenizer str)) (t (if (null? tokens) (if (char=? (string-ref str 0) #\;) '() (list str)) tokens))) (read_form (make-Reader t))))) ================================================ FILE: impls/guile/readline.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;(use-modules (ice-9 readline)) (library (readline) (export _readline) (import (guile) (ice-9 readline))) (define mal-history (format #f "~a/.mal-history" (getenv "HOME"))) (setenv "GUILE_HISTORY" mal-history) (readline-set! bounce-parens 0) (activate-readline) (define (_readline prompt) (let ((str (readline prompt))) (and (not (eof-object? str)) (add-history str)) str)) ================================================ FILE: impls/guile/run ================================================ #!/usr/bin/env bash # XDG_CACHE_HOME is where guile stores the compiled files XDG_CACHE_HOME=.cache/ exec guile -L $(dirname $0) $(dirname $0)/${STEP:-stepA_mal}.scm "${@}" ================================================ FILE: impls/guile/step0_repl.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline)) (define (READ str) str) (define (EVAL ast env) ast) (define (PRINT str) (format #t "~a~%" str)) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (PRINT (EVAL (READ line) '()))))))) (REPL) ================================================ FILE: impls/guile/step1_read_print.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer)) (define (READ str) (read_str str)) (define (EVAL ast env) ast) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) '()))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) (REPL) ================================================ FILE: impls/guile/step2_eval.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (types)) (define *toplevel* `((+ . ,+) (- . ,-) (* . ,*) (/ . ,/))) (define (READ str) (read_str str)) (define (EVAL ast env) ; (format #t "EVAL: ~a~%" (pr_str ast #t)) (match ast ((? symbol? sym) (or (assoc-ref env sym) (throw 'mal-error (format #f "'~a' not found" sym)))) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (apply (car el) (cdr el)))))) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) (REPL) ================================================ FILE: impls/guile/step3_env.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (types)) (define *primitives* `((+ ,+) (- ,-) (* ,*) (/ ,/))) (define *toplevel* (receive (b e) (unzip2 *primitives*) (make-Env #:binds b #:exprs e))) (define (READ str) (read_str str)) (define (EVAL ast env) (define (->list kvs) ((if (vector? kvs) vector->list identity) kvs)) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (EVAL body new-env))) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (apply (car el) (cdr el)))))) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) (REPL) ================================================ FILE: impls/guile/step4_if_fn_do.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) (define *toplevel* (receive (b e) (unzip2 core.ns) (make-Env #:binds b #:exprs e))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (EVAL (car ast) env) (eval_seq (cdr ast) env)))) (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (EVAL body new-env))) (('do rest ...) (eval_seq rest env)) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (EVAL thn env)) (else (if (null? els) nil (EVAL (car els) env))))) (('fn* params body ...) ; function definition (lambda args (eval_seq body (make-Env #:outer env #:binds (->list params) #:exprs args)))) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (apply (car el) (cdr el)))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) (EVAL-string "(def! not (fn* (x) (if x false true)))") (REPL) ================================================ FILE: impls/guile/step5_tco.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) (define *toplevel* (receive (b e) (unzip2 core.ns) (make-Env #:binds b #:exprs (map make-func e)))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (EVAL (car ast) env) (eval_seq (cdr ast) env)))) (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) ;; 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)) (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (callable-apply (car el) (cdr el))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) (EVAL-string "(def! not (fn* (x) (if x false true)))") (REPL) ================================================ FILE: impls/guile/step6_file.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) (define *toplevel* (receive (b e) (unzip2 core.ns) (make-Env #:binds b #:exprs (map make-func e)))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (EVAL (car ast) env) (eval_seq (cdr ast) env)))) (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) ;; 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)) (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (callable-apply (car el) (cdr el))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) ;; initialization ((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) ((*toplevel* 'set) '*ARGV* '()) (EVAL-string "(def! not (fn* (x) (if x false true)))") (EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (let ((args (cdr (command-line)))) (cond ((> (length args) 0) ((*toplevel* 'set) '*ARGV* (cdr args)) (EVAL-string (string-append "(load-file \"" (car args) "\")"))) (else (REPL)))) ================================================ FILE: impls/guile/step7_quote.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) (define *toplevel* (receive (b e) (unzip2 core.ns) (make-Env #:binds b #:exprs (map make-func e)))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (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 '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (let tco-loop((ast ast) (env env)) (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('quote obj) 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)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (else (let ((el (map (lambda (x) (EVAL x env)) ast))) (callable-apply (car el) (cdr el))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) ;; initialization ((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) ((*toplevel* 'set) '*ARGV* '()) (EVAL-string "(def! not (fn* (x) (if x false true)))") (EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (let ((args (cdr (command-line)))) (cond ((> (length args) 0) ((*toplevel* 'set) '*ARGV* (cdr args)) (EVAL-string (string-append "(load-file \"" (car args) "\")"))) (else (REPL)))) ================================================ FILE: impls/guile/step8_macros.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) (define *toplevel* (receive (b e) (unzip2 core.ns) (make-Env #:binds b #:exprs (map make-func e)))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (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 '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (let tco-loop((ast ast) (env env)) ; expand as possible (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('defmacro! k v) (let ((c (EVAL v env))) ((env 'set) k (callable-as-macro c)))) (('quote obj) 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)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-anonymous-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (else (let ((f (EVAL (car ast) env)) (args (cdr ast))) (if (is-macro f) (EVAL (callable-apply f args) env) (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) ;; initialization ((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) ((*toplevel* 'set) '*ARGV* '()) (EVAL-string "(def! not (fn* (x) (if x false true)))") (EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (EVAL-string "(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)))))))") (let ((args (cdr (command-line)))) (cond ((> (length args) 0) ((*toplevel* 'set) '*ARGV* (cdr args)) (EVAL-string (string-append "(load-file \"" (car args) "\")"))) (else (REPL)))) ================================================ FILE: impls/guile/step9_try.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) ;; Primitives which doesn't unbox args in default. ;; This is a trick to implement meta-info taking advange of the original ;; types of Guile as possible. (define *unbox-exception* '(meta assoc swap!)) (define *toplevel* (receive (b e) (unzip2 core.ns) (let ((env (make-Env #:binds b #:exprs (map make-func e)))) (for-each (lambda (f) (callable-unbox-set! ((env 'get) f) #f)) *unbox-exception*) env))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (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 '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (let tco-loop((ast ast) (env env)) ; expand as possible (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('defmacro! k v) (let ((c (EVAL v env))) ((env 'set) k (callable-as-macro c)))) (('quote obj) 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)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-anonymous-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (('try* A) (EVAL A env)) (('try* A ('catch* B C)) (catch #t (lambda () (EVAL A env)) (lambda e (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else (let ((f (EVAL (car ast) env)) (args (cdr ast))) (if (is-macro f) (EVAL (callable-apply f args) env) (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) ;; initialization ((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) ((*toplevel* 'set) 'throw (make-func (lambda (val) (throw 'mal-error val)))) ((*toplevel* 'set) '*ARGV* '()) (EVAL-string "(def! not (fn* (x) (if x false true)))") (EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (EVAL-string "(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)))))))") (let ((args (cdr (command-line)))) (cond ((> (length args) 0) ((*toplevel* 'set) '*ARGV* (cdr args)) (EVAL-string (string-append "(load-file \"" (car args) "\")"))) (else (REPL)))) ================================================ FILE: impls/guile/stepA_mal.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) (srfi srfi-1) (ice-9 receive) (env) (core) (types)) ;; Primitives which doesn't unbox args in default. ;; This is a trick to implement meta-info taking advange of the original ;; types of Guile as possible. (define *unbox-exception* '(meta assoc swap!)) (define *toplevel* (receive (b e) (unzip2 core.ns) (let ((env (make-Env #:binds b #:exprs (map make-func e)))) (for-each (lambda (f) (callable-unbox-set! ((env 'get) f) #f)) *unbox-exception*) env))) (define (READ str) (read_str str)) (define (eval_seq ast env) (cond ((null? ast) nil) ((null? (cdr ast)) (EVAL (car ast) env)) (else (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 '())) (cond ;; NOTE: reverse is very important here! ((null? next) (values (reverse k) (reverse v))) ((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)))))) (let tco-loop((ast ast) (env env)) ; expand as possible (when (cond-true? (env-check 'DEBUG-EVAL env)) (format #t "EVAL: ~a~%" (pr_str ast #t))) (match ast ((? symbol? sym) (env-has sym env)) ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) ((? hash-table? ht) (define new-ht (make-hash-table)) (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) new-ht) ((? non-list?) ast) (() ast) (('defmacro! k v) (let ((c (EVAL v env))) ((env 'set) k (callable-as-macro c)))) (('quote obj) 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)) (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) (receive (keys vals) (%unzip2 (->list kvs)) (for-each setter keys vals)) (tco-loop body new-env))) (('do rest ...) (cond ((null? rest) (throw 'mal-error (format #f "do: Invalid form! '~a'" rest))) ((= 1 (length rest)) (tco-loop (car rest) env)) (else (let ((mexpr (take rest (1- (length rest)))) (tail-call (car (take-right rest 1)))) (eval_seq mexpr env) (tco-loop tail-call env))))) (('if cnd thn els ...) (cond ((and (not (null? els)) (not (null? (cdr els)))) ;; Invalid `if' form (throw 'mal-error (format #f "if: failed to match any pattern in form '~a'" ast))) ((cond-true? (EVAL cnd env)) (tco-loop thn env)) (else (if (null? els) nil (tco-loop (car els) env))))) (('fn* params body ...) ; function definition (make-anonymous-func (lambda args (let ((nenv (make-Env #:outer env #:binds (->list params) #:exprs args))) (cond ((null? body) (throw 'mal-error (format #f "fn*: bad lambda in form '~a'" ast))) ((= 1 (length body)) (tco-loop (car body) nenv)) (else (let ((mexpr (take body (1- (length body)))) (tail-call (car (take-right body 1)))) (eval_seq mexpr nenv) (tco-loop tail-call nenv)))))))) (('try* A) (EVAL A env)) (('try* A ('catch* B C)) (catch #t (lambda () (EVAL A env)) (lambda e (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else (let ((f (EVAL (car ast) env)) (args (cdr ast))) (if (is-macro f) (EVAL (callable-apply f args) env) (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) (define (PRINT exp) (and (not (eof-object? exp)) (format #t "~a~%" (pr_str exp #t)))) (define (LOOP continue?) (and continue? (REPL))) (define (REPL) (LOOP (let ((line (_readline "user> "))) (cond ((eof-object? line) #f) ((string=? line "") #t) (else (catch 'mal-error (lambda () (PRINT (EVAL (READ line) *toplevel*))) (lambda (k . e) (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) ;; initialization ((*toplevel* 'set) 'eval (make-func (lambda (ast) (EVAL ast *toplevel*)))) ((*toplevel* 'set) 'throw (make-func (lambda (val) (throw 'mal-error val)))) ((*toplevel* 'set) '*ARGV* '()) (EVAL-string "(def! not (fn* (x) (if x false true)))") (EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (EVAL-string "(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)))))))") (EVAL-string "(def! *host-language* \"guile\")") (let ((args (cdr (command-line)))) (cond ((> (length args) 0) ((*toplevel* 'set) '*ARGV* (cdr args)) (EVAL-string (string-append "(load-file \"" (car args) "\")"))) (else (EVAL-string "(println (str \"Mal (\" *host-language* \")\"))") (REPL)))) ================================================ FILE: impls/guile/types.scm ================================================ ;; Copyright (C) 2015 ;; "Mu Lei" known as "NalaGinrut" ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (library (types) (export string-sub *eof* non-list? string->keyword _keyword? _string? nil _nil? list->hash-map cond-true? make-anonymous-func make-atom atom? atom-val atom-val-set! make-callable callable? callable-is_macro callable-as-macro callable-closure is-func is-func? is-macro is-macro? make-func callable-apply callable-unbox-set! callable-unbox callable-meta-info hash-table-clone box? box unbox) (import (guile) (only (rnrs) define-record-type) (ice-9 regex) (ice-9 session))) (define (non-list? x) (not (list? x))) (define (string-sub str p1 p2) (regexp-substitute/global #f p1 str 'pre p2 'post)) (define *eof* (call-with-input-string "" read)) (define (string->keyword str) (when (not (string? str)) (throw 'mal-error (format #f "string->keyword: '~a' is not a string" str))) (string-append "\u029e" str)) (define (_keyword? k) (and (string? k) (> (string-length k) 0) (char=? #\1236 (string-ref k 0)))) (define (_string? s) (and (string? s) (not (_keyword? s)))) (define-record-type mal-nil) (define nil (make-mal-nil)) (define (_nil? obj) (mal-nil? obj)) (define (cond-true? obj) (and (not (_nil? obj)) obj)) (define-record-type atom (fields (mutable val))) (define-record-type callable (fields meta-info (mutable unbox) (mutable is_macro) closure)) (define (make-func closure) (make-callable nil #t #f closure)) (define (make-anonymous-func closure) (make-callable nil #f #f closure)) (define (callable-apply c arglst) (apply (callable-closure c) (if (callable-unbox c) (map unbox arglst) arglst))) (define (callable-check c b) (and (callable? c) (eq? (callable-is_macro c) b) c)) (define (is-func c) (callable-check c #f)) (define (is-func? c) (and (is-func c) #t)) (define (is-macro c) (callable-check c #t)) (define (is-macro? c) (and (is-macro c) #t)) (define (callable-as-macro c) (make-callable nil (callable-unbox c) #t (callable-closure c))) (define (hash-table-clone ht) (list->hash-map (hash-fold (lambda (k v p) (cons k (cons v p))) '() ht))) (define-record-type box (fields val)) (define (box o) (make-box o)) (define (unbox o) (if (box? o) (box-val o) o)) (define* (list->hash-map lst #:optional (ht (make-hash-table))) (cond ((null? lst) ht) (else (let lp((next lst)) (cond ((null? next) ht) (else (when (null? (cdr next)) (throw 'mal-error (format #f "hash-map: '~a' lack of value" (car next)))) (let ((k (car next)) (v (cadr next))) (hash-set! ht k v) (lp (cddr next))))))))) ================================================ FILE: impls/hare/.gitignore ================================================ !mal ================================================ FILE: impls/hare/Dockerfile ================================================ FROM debian:testing MAINTAINER Lou Woell LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: hare" ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## ENV HARECACHE='/mal/.cache/hare/' RUN apt-get -y install binutils hare ================================================ FILE: impls/hare/makefile ================================================ CC= hare build BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal .PHONY: all all: $(BINS) %: %.ha $(wildcard mal/*.ha) $(CC) -o $@ $< .PHONY: clean clean: rm $(BINS) ================================================ FILE: impls/hare/mal/core.ha ================================================ use fmt; use os; use io; use memio; use strings; use bufio; use time; export type ns_entry = (str, (MalType | *fn([]MalType) (MalType | error))); export type namespace = []ns_entry; export fn load_namespace(ns: namespace, env: *env) (void | error) = { for(let e.. ns){ let v: MalType = match(e.1){ case let v: MalType => yield v; case let f: *fn([]MalType) (MalType | error) => yield make_intrinsic(f); case => return ("MalType", nil): type_error; }; env_set(env, e.0: symbol, v); }; }; export let core: namespace = [ ("pr", &prn), ("list", &mallist), ("count", &count), ("list?", &listp), ("empty?", &emptyp), ("not", ¬), ("+", &plus), ("-", &minus), ("*", &mult), ("/", &div), (">", &greater_than), ("<", &smaller_than), (">=", &greq_than), ("<=", &seq_than), ("=", &mal_eq), ("prn", &prn), ("println", &prn_line), ("pr-str", &pr_str), ("str", &pr_str_ugly), ("read-string", &r_string), ("slurp", &slurp), ("atom", &mal_atom), ("atom?", &atomp), ("deref", &atom_deref), ("reset!", &atom_reset), ("swap!", &atom_swap), ("cons", &cons), ("concat", &concat), ("vec", &vec), ("nth", &nth), ("first", &first), ("rest", &rest), ("macro?", ¯op), ("throw", &throw), ("apply", &apply), ("map", &map), ("nil?", &nilp), ("true?", &truep), ("false?", &falsep), ("symbol?", &symbolp), ("map?", &mapp), ("vector", &malvector), ("vector?", &vectorp), ("sequential?", &sequentialp), ("symbol", &malsymbol), ("keyword?", &keywordp), ("keyword", &malkeyword), ("hash-map", &malhash_map), ("get", &malhmget), ("contains?", &containsp), ("assoc", &assoc), ("dissoc", &dissoc), ("vals", &vals), ("keys", &keys), ("readline", &readline), ("time-ms", &time_ms), ("string?", &stringp), ("number?", &numberp), ("seq", &seq), ("conj", &conj), ("meta", &meta), ("with-meta", &with_meta), ("fn?", &fnp), ]; export fn plus (args: []MalType) (MalType | error) = { let result: number = 0; for(let n .. args) { match(n){ case let n: number => result += n; case => return ("number", args): type_error; }; }; return result; }; export fn minus (args: []MalType) (MalType | error) = { let result: number = args[0] as number; for(let n .. args[1..]) { match(n){ case let n: number => result -= n; case => return ("number", args): type_error; }; }; return result; }; export fn mult (args: []MalType) (MalType | error) = { let result: number = 1; for(let n .. args) { match(n){ case let n: number => result *= n; case => return ("number", args): type_error; }; }; return result; }; export fn div (args: []MalType) (MalType | error) = { let x = match(args[0]){ case let x: number => yield x; case => return ("number", args): type_error; }; let y = switch(len(args)){ case 2 => yield match(args[1]){ case let y: number => yield y; case => return ("number", args): type_error; }; case 1 => yield 1: number; case 0 => yield 1: number; case => yield div(args[1..])? as number; }; return x / y; }; fn mallist (args: []MalType) (MalType | error) = { return make_list(len(args), args); }; fn listp (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'listp': Too few arguments", args): syntax_error; return args[0] is list; }; fn emptyp (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'emptyp': Too few arguments", args): syntax_error; let a: []MalType = match(args[0]){ case let a: vector => yield a.data; case let a: list => yield a.data; case => return nil; }; return len(a) == 0; }; fn count (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'count': Too few arguments", args): syntax_error; const arg: []MalType = match(args[0]) { case let a: list => yield a.data; case let a: vector => yield a.data; case nil => return 0; case => return ("list", args): type_error; }; return len(arg): number; }; fn greater_than (args: []MalType) (MalType | error) = { if(len(args) != 2) return ("> expected exactly 2 args, got:", args): syntax_error; const x = match(args[0]){ case let x: number => yield x; case => return ("number", args): type_error; }; const y = match(args[1]){ case let y: number => yield y; case => return ("number", args): type_error; }; return x > y; }; fn smaller_than (args: []MalType) (MalType | error) = { if(len(args) != 2) return ("< expected exactly 2 args, got:", args): syntax_error; const x = match(args[0]){ case let x: number => yield x; case => return ("number", args): type_error; }; const y = match(args[1]){ case let y: number => yield y; case => return ("number", args): type_error; }; return x < y; }; fn greq_than (args: []MalType) (MalType | error) = { if(len(args) != 2) return (">= expected exactly 2 args, got:", args): syntax_error; const x = match(args[0]){ case let x: number => yield x; case => return ("number", args): type_error; }; const y = match(args[1]){ case let y: number => yield y; case => return ("number", args): type_error; }; return x >= y; }; fn seq_than (args: []MalType) (MalType | error) = { if(len(args) != 2) return ("<= expected exactly 2 args, got:", args): syntax_error; const x = match(args[0]){ case let x: number => yield x; case => return ("number", args): type_error; }; const y = match(args[1]){ case let y: number => yield y; case => return ("number", args): type_error; }; return x <= y; }; fn list_cmp (ls: []MalType, ls2: []MalType) bool = { if(!(len(ls) == len(ls2))) return false; for(let i: size = 0; i < len(ls); i += 1){ if(!(mal_eq(([ls[i], ls2[i]]: []MalType)) as bool)){ return false; }; }; return true; }; fn mal_eq (args: []MalType) (MalType | error) = { if(len(args) != 2) return ("'=': expected exactly 2 args, got:", args): syntax_error; match(args[0]){ case let x: number => if(args[1] is number) { return x == args[1] as number; }; case let x: bool => if(args[1] is bool) { return x == args[1] as bool; }; case let x: list => match(args[1]){ case let y: vector => return list_cmp(x.data, y.data); case let y: list => return list_cmp(x.data, y.data); case => void; }; case let x: vector => match(args[1]){ case let y: vector => return list_cmp(x.data, y.data); case let y: list => return list_cmp(x.data, y.data); case => void; }; case let x: nil => if(args[1] is nil) { return true; }; case let x: string => match(args[1]){ case let y: string => return x.data == y.data; case => void; }; case let s: symbol => if(args[1] is symbol){ return s == args[1] as symbol; }; case let hm: hashmap => if(args[1] is hashmap){ return hash_cmp(hm, args[1] as hashmap); }; case => void; }; return false; }; fn not (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'not': too few arguments", args): syntax_error; match(args[0]){ case let b: bool => return !b; case nil => return true; case => return false; }; }; fn prn (args: []MalType) (MalType | error) = { for(let i: size = 0; i < len(args); i += 1) { print_form(os::stdout, args[i]); if (i < len(args) - 1) fmt::fprint(os::stdout, " ")!; }; fmt::fprint(os::stdout, "\n")!; return nil; }; fn prn_line (args: []MalType) (MalType | error) = { for(let i: size = 0; i < len(args); i += 1) { print_form(os::stdout, args[i], false); if (i < len(args) - 1) fmt::fprint(os::stdout, " ")!; }; fmt::fprint(os::stdout, "\n")!; return nil; }; fn pr_str(args: []MalType) (MalType | error) = { let strbuf = memio::dynamic(); defer io::close(&strbuf)!; for(let i: size = 0; i < len(args); i += 1) { print_form(&strbuf, args[i]); if (i < len(args) - 1) fmt::fprint(&strbuf, " ")!; }; let s: str = memio::string(&strbuf)!; return make_string(s); }; fn pr_str_ugly(args: []MalType) (MalType | error) = { let strbuf = memio::dynamic(); defer io::close(&strbuf)!; for(let i: size = 0; i < len(args); i += 1) { print_form(&strbuf, args[i], false); }; let s: str = memio::string(&strbuf)!; return make_string(s); }; fn r_string(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'read-string': too few arguments", args): syntax_error; let input: str = match(args[0]){ case let s: string => yield s.data; case => return ("string", args[0]): type_error; }; match(read_str(strings::toutf8(input))) { case io::EOF => return unexpected_eof; case let res: (MalType | error) => return res; }; }; fn slurp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'slurp': too few arguments", args): syntax_error; let file_name: str = match(args[0]) { case let s: string => yield s.data; case => return ("string", args[0]): type_error; }; let file = os::open(file_name)?; let fcontent = io::drain(file)?; io::close(file)?; let s: str = strings::fromutf8(fcontent)!; return make_string(s); }; fn mal_atom (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'atom': too few arguments", args): syntax_error; return make_atom(args[0]); }; fn atomp (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'atomp': too few arguments", args): syntax_error; return args[0] is atom; }; fn atom_deref (args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'deref': too few arguments", args): syntax_error; match(args[0]){ case let a: atom => return *a; case => return ("atom", args[0]): type_error; }; }; fn atom_reset (args: []MalType) (MalType | error) ={ if(len(args) < 2) return ("'reset': too few arguments", args): syntax_error; let a: atom = match(args[0]){ case let a: atom => yield a; case => return ("atom", args[0]): type_error; }; let v: MalType = match(args[1]){ case let v: MalType => yield v; case => return ("atom", args[0]): type_error; }; *a = v; return v; }; fn atom_swap (args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'swap': too few arguments", args): syntax_error; let a: atom = match(args[0]){ case let a: atom => yield a; case => return ("atom", args[0]): type_error; }; let func = match(args[1]){ case let f: (function | intrinsic) => yield f; case => return ("function", args[1]): type_error; }; let appls: list = make_list(len(args[1..]), args[1..]); appls.data[0] = *a; *a = apply([func, appls])?; return *a; }; fn cons(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'cons': too few arguments", args): syntax_error; let ls: []MalType = match(args[1]){ case let ls: list => yield ls.data; case let ls: vector => yield ls.data; case => return("list", args[1]): type_error; }; let new: list = make_list(len(ls)+1); new.data[0] = args[0]; new.data[1..] = ls; return new; }; fn concat(args: []MalType) (MalType | error) = { let length: size = 0; for(let i: size = 0; i < len(args); i += 1){ match(args[i]){ case let ls: list => length += len(ls.data); case let ls: vector => length += len(ls.data); case => return("list", args[1]): type_error; }; }; if(length == 0) return make_list(0); let new: list = make_list(length); let nlen: size = 0; for(let i: size = 0; i < len(args); i += 1){ let ls: []MalType = match(args[i]){ case let ls: list => yield ls.data; case let ls: vector => yield ls.data; }; const n = nlen + len(ls); new.data[nlen..n] = ls; nlen = n; }; return new; }; fn vec(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'vec': too few arguments", args): syntax_error; let ls: []MalType = match(args[0]){ case let ls: vector => return ls; case let ls: list => yield ls.data; case => return ("list or vector", args[0]): type_error; }; let new: vector = make_vec(len(ls)); if(len(ls) > 0){ new.data[0..] = ls; }; return new; }; fn nth(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'nth': too few arguments", args): syntax_error; let ls: []MalType = match(args[0]){ case let ls: list => yield ls.data; case let ls: vector => yield ls.data; case => return ("list", args): type_error; }; let index: number = match(args[1]){ case let i: number => yield i; case => return ("number", args): type_error; }; if(index >= len(ls): int) return ("bounds error", args): syntax_error; return ls[index]; }; fn first(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'first': too few arguments", args): syntax_error; let ls: []MalType = match(args[0]){ case let ls: list => yield ls.data; case let ls: vector => yield ls.data; case let ls: nil => return nil; case => return ("list", args): type_error; }; if(0 == len(ls)) return nil; return ls[0]; }; fn rest(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'rest': too few arguments", args): syntax_error; let ls: []MalType = match(args[0]){ case let ls: list => yield ls.data; case let ls: vector => yield ls.data; case let ls: nil => return make_list(0); case => return ("list", args): type_error; }; if(0 == len(ls) || 0 == len(ls[1..])) return make_list(0); return make_list(len(ls[1..]), ls[1..]); }; fn macrop(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'macrop': too few arguments", args): syntax_error; return args[0] is macro; }; fn throw(args: []MalType) (MalType | error) ={ if(len(args) == 0) return ("'throw': too few arguments", args): syntax_error; return ("error", args[0]): malerror; }; fn map(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'map': too few arguments", args): syntax_error; const ls: []MalType = match(args[1]){ case let l: list => yield l.data; case let l: vector => yield l.data; case => return ("list", args): type_error; }; const length = len(ls); const new = make_list(length); for(let i: size = 0; i < len(ls); i += 1){ let argls: []MalType = [ls[i]]; new.data[i] = apply([args[0], &argls: list])?; }; return new; }; fn apply(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'apply': too few arguments", args): syntax_error; const last = args[len(args)-1]; const rest = args[1..len(args)-1]; const last: []MalType = match(args[len(args)-1]){ case let l: list => yield l.data; case let l: vector => yield l.data; case => return ("list", args): type_error; }; const length: size = len(rest) + len(last); const ls: []MalType = switch(length){ case 0 => yield []; case => yield alloc([nil...], length)!; }; defer free(ls); ls[0 .. len(rest)] = rest; ls[len(rest)..] = last; match(args[0]){ case let func: function => let env = env_init(func.envi); env_bind(env, func.args, ls); return func.eval(func.body, env); case let func: macro => let env = env_init(func.envi); env_bind(env, func.args, ls); return func.eval(func.body, env); case let f: intrinsic => return f.eval(ls); case => return ("function", args): type_error; }; }; fn nilp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'nilp': too few arguments", args): syntax_error; return args[0] is nil; }; fn symbolp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'symbolp': too few arguments", args): syntax_error; match(args[0]){ case let s: symbol => if (!(strings::hasprefix(s, ":"))) return true; case => void; }; return false; }; fn keywordp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'keywordp': too few arguments", args): syntax_error; match(args[0]){ case let s: symbol => if (strings::hasprefix(s, ":")) return true; case => void; }; return false; }; fn vectorp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'vectorp': too few arguments", args): syntax_error; return args[0] is vector; }; fn sequentialp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'sequentialp': too few arguments", args): syntax_error; return args[0] is (list | vector); }; fn mapp(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'mapp': too few arguments", args): syntax_error; return args[0] is hashmap; }; fn truep(args: []MalType) (MalType | error) = { match(args[0]){ case let b: bool => return b; case => return false; }; }; fn falsep(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'falsep': too few arguments", args): syntax_error; match(args[0]){ case let b: bool => return !b; case => return false; }; }; fn malvector(args: []MalType) (MalType | error) = { return make_vec(len(args), args); }; fn malsymbol(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'symbol': too few arguments", args): syntax_error; let s: str = match(args[0]){ case let s: string => yield s.data; case => return ("string", args): type_error; }; return make_symbol(s); }; fn malkeyword(args: []MalType) (MalType | error) = { if(len(args) == 0) return ("'keyword': too few arguments", args): syntax_error; match(args[0]){ case let s: string => let name = strings::lpad(s.data, ':', len(s.data) + 1)!; defer free(name); return make_symbol(name); case let k: symbol => if(strings::hasprefix(k, ':')) return k; return false; case => return ("string", args): type_error; }; }; fn malhash_map(args: []MalType) (MalType | error) = { let new = hm_init(); if (len(args) % 2 != 0) return ("odd number of arguments", args): syntax_error; for(let i: size = 0; i < len(args); i += 2){ match(args[i]){ case let s: (symbol | string) => hm_add(new, s, args[i+1]); case => return ("symbol or string", args): type_error; }; }; return new; }; fn malhmget(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'get': too few arguments", args): syntax_error; const hm = match(args[0]){ case let hm: hashmap => yield hm; case nil => return nil; case => return ("hashmap", args): type_error; }; const key = match(args[1]){ case let hm: (string | symbol) => yield hm; case => return ("symbol or string", args): type_error; }; match (hm_get(hm, key)){ case let e: undefined_key => return nil; case let v: MalType => return v; }; }; fn containsp(args: []MalType) (MalType | error) = { if(len(args) < 2) return ("'containsp': too few arguments", args): syntax_error; const hm = match(args[0]){ case let hm: hashmap => yield hm; case => return ("hashmap", args): type_error; }; const key = match(args[1]){ case let hm: (string | symbol) => yield hm; case => return ("symbol or string", args): type_error; }; match(hm_get(hm, key)){ case undefined_key => return false; case => return true; }; }; fn assoc(args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'assoc': too few arguments", args): syntax_error; let hm: hashmap = match(args[0]){ case let hm: hashmap => yield hm; case => return ("hashmap", args): type_error; }; let new: hashmap = hm_copy(hm); assert(len(hm.data) == len(new.data)); let ls = args[1..]; for(let i: size = 0; i < len(ls); i += 2){ match(ls[i]){ case let s: (symbol | string) => hm_set(new, s, ls[i+1]); case => return ("symbol or string", args): type_error; }; }; return new; }; fn dissoc(args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'dissoc': too few arguments", args): syntax_error; let hm: hashmap = match(args[0]){ case let hm: hashmap => yield hm; case => return ("hashmap", args): type_error; }; let ls = args[1..]; let new: hashmap = hm_copy(hm, ls: [](string | symbol)); return new; }; fn vals(args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'vals': too few arguments", args): syntax_error; let hm: hashmap = match(args[0]){ case let hm: hashmap => yield hm; case => return ("hashmap", args): type_error; }; return hm_val_list(hm); }; fn keys(args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'keys': too few arguments", args): syntax_error; let hm: hashmap = match(args[0]){ case let hm: hashmap => yield hm; case => return ("hashmap", args): type_error; }; return hm_key_list(hm); }; fn readline (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'readline': too few arguments", args): syntax_error; const prompt: str = match(args[0]){ case let p: string => yield p.data; case => return ("string", args): type_error; }; fmt::printf(prompt)!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => return nil; case let e: io::error => return e; }; const s = strings::fromutf8(input)!; const ret = make_string(s); free(input); return ret; }; fn time_ms (args: []MalType) (MalType | error) = { let now = time::now(time::clock::REALTIME); let base = time::instant{sec = 0, ...}; let diff = time::diff(base, now) / time::MILLISECOND; return diff: number; }; fn stringp (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'stringp': too few arguments", args): syntax_error; return args[0] is string; }; fn numberp (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'numberp': too few arguments", args): syntax_error; return args[0] is number; }; fn fnp (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'fnp': too few arguments", args): syntax_error; return args[0] is (function | intrinsic); }; fn seq (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'seq': too few arguments", args): syntax_error; match(args[0]){ case let s: string => if(len(s.data) == 0) return nil; let new = make_list(len(s.data)); let it = strings::iter(s.data); for(let i: size = 0; i < len(s.data); i += 1){ match(strings::next(&it)){ case let rn: rune => let s: str = strings::fromutf8([rn: u8])!; new.data[i] = make_string(s); case => break; }; }; return new; case let s: list => if(len(s.data) == 0) return nil; return s; case let s: vector => if(len(s.data) == 0) return nil; return make_list(len(s.data), s.data); case let s: nil => return nil; }; }; fn conj (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'conj': too few arguments", args): syntax_error; let old = args[1..]; let length = len(old); match(args[0]){ case let ls: list => length += len(ls.data); let new = make_list(length); new.data[len(old)..] = ls.data; for(let i: size = len(old); i > 0; i -= 1){ new.data[i-1] = old[len(old) - i]; }; return new; case let ls: vector => length += len(ls.data); let new = make_vec(length, ls.data); new.data[len(ls.data)..] = old; return new; case => return ("list or vector", args): type_error; }; }; fn meta (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'meta': too few arguments", args): syntax_error; match(args[0]){ case let func: function => return func.meta; case let func: intrinsic => return func.meta; case let hm: hashmap => return hm.meta; case let s: string => return s.meta; case let l: list => return l.meta; case let v: vector => return v.meta; case => return not_implemented; }; }; fn with_meta (args: []MalType) (MalType | error) = { if(len(args) < 1) return ("'with-meta': too few arguments", args): syntax_error; match(args[0]){ case let func: function => let new = make_func(func.eval, func.envi, func.args, func.body); new.meta = args[1]; return new; case let hm: hashmap => let new = assoc([hm])?:hashmap; new.meta = args[1]; return new; case let s: string => let new = make_string(s.data); new.meta = args[1]; return new; case let f: intrinsic => let new = make_intrinsic(f.eval); new.meta = args[1]; return new; case let ls: list => let new: list = make_list(len(ls.data), ls.data); new.meta = args[1]; return new; case let v: vector => let new: vector = make_vec(len(v.data), v.data); new.meta = args[1]; return new; case => return not_implemented; }; }; ================================================ FILE: impls/hare/mal/env.ha ================================================ export type env = struct { outer: nullable *env, data: hashmap, }; export fn env_init(outer: nullable * env = null) *env ={ const new = alloc(env { outer = outer, data = hm_init(), })!; append(gc.memory.envs, new)!; return new; }; export fn env_bind( env: *env, bindings: []MalType, exprs: []MalType ) void = { let more: bool = false; for(let i: size = 0; i < len(bindings); i += 1){ if (!(bindings[i] is symbol)){ return void; }; if (more) { let tail = exprs[i - 1..]; let new = make_list(len(tail), tail); env_set(env, bindings[i] as symbol, new); break; } else if (bindings[i] as symbol == "&": symbol){ more = true; continue; } else { env_set(env, bindings[i] as symbol, exprs[i]); }; }; }; export fn env_set(env: *env, key: symbol, val: MalType) void = { hm_set(env.data, key, val); return void; }; export fn env_get(envi: *env, key: symbol) (MalType | undefined_symbol) = { match(hm_get(envi.data, key)) { case undefined_key => match(envi.outer){ case null => return ("env_get", key): undefined_symbol; case let outer: *env => return env_get(outer, key); }; case let result: MalType => return result; }; }; ================================================ FILE: impls/hare/mal/error.ha ================================================ use bufio; use io; use fmt; use os; use fs; export type malerror = !(str, MalType); export type not_implemented = !void; export type unexpected_eof = !void; export type unbalanced = !void; export type undefined_key = !(str, (symbol | string)); export type undefined_symbol = !(str, symbol); export type syntax_error = !(str, (MalType | []MalType)); export type type_error = !(str, (MalType | []MalType)); export type error = !(malerror | fs::error | io::error | unexpected_eof | unbalanced | not_implemented | undefined_symbol | undefined_key | syntax_error | type_error); export fn format_error(strbuf: io::handle, e: error) void = { match(e){ case let e: type_error => fmt::fprint(strbuf, "Type Error: expected", e.0, "got:")!; print_form(strbuf, e.1, false); fmt::fprint(strbuf, "\n")!; case let e: syntax_error => fmt::fprintln(strbuf, "Syntax Error:", e.0)!; print_form(strbuf, e.1, false); fmt::fprint(strbuf, "\n")!; case let e: undefined_symbol => fmt::fprintf(strbuf, "'{}' not found", e.1)!; fmt::print("\n")!; case unexpected_eof => fmt::fprintln(strbuf, "Unexpected EOF!")!; case let e: malerror => print_form(strbuf, e.1, false); fmt::print("\n")!; case unbalanced => fmt::fprintln(strbuf, "Unbalanced Delimiters")!; case not_implemented => fmt::fprintln(strbuf, "not implemented")!; case let e: io::error => fmt::fprintln(strbuf, io::strerror(e))!; case let e: fs::error => fmt::fprintln(strbuf, fs::strerror(e))!; case => fmt::fatal("unknown error"); }; }; ================================================ FILE: impls/hare/mal/gc.ha ================================================ // Some inspirations taken from https://git.sr.ht/~jummit/rekkyo type memory = struct { envs: []*env, hashs: []hashmap, symbols: (void | hashmap), funcs: []function, lists: []list, vecs: []vector, strings: []string, atoms: []atom, intrinsics: []intrinsic, }; type garbage_collector = struct { marked: memory, memory: memory, }; let gc = garbage_collector { marked = memory { symbols = void, funcs = [], ... }, memory = memory { symbols = void, funcs = [], ... }, }; fn reset_memory(memory: *memory) void = { memory.envs = memory.envs[..0]; memory.hashs = memory.hashs[..0]; memory.funcs = memory.funcs[..0]; memory.lists = memory.lists[..0]; memory.vecs = memory.vecs[..0]; memory.strings = memory.strings[..0]; memory.atoms = memory.atoms[..0]; memory.intrinsics = memory.intrinsics[..0]; match(memory.symbols){ case let hm: hashmap => hm.data = hm.data[..0]; case void => void; }; }; fn finish_memory(memory: memory) void = { free(memory.envs); free(memory.hashs); free(memory.funcs); free(memory.lists); free(memory.vecs); free(memory.strings); free(memory.atoms); free(memory.intrinsics); match(memory.symbols){ case let hm: hashmap => hm_free(hm); case void => void; }; }; fn mark_hash(hm: hashmap) void = { append(gc.marked.hashs, hm)!; mark(hm.meta); for(let v .. hm.data){ mark(v.key); mark(v.val); }; }; fn mark_env(envi: *env) void = { for(let e .. gc.marked.envs){ if(e == envi) return void; }; append(gc.marked.envs, envi)!; mark(envi.data); match(envi.outer){ case null => void; case let e: *env => mark_env(e); }; }; fn mark_col(col: []MalType) void = { for(let v .. col) { mark(v); }; }; fn mark (val: MalType) void = { match(gc.marked.symbols){ case void => gc.marked.symbols = hm_init(false); case => void; }; match(val){ case let v: vector => for(let x .. gc.marked.vecs){ if(x == v) return void; }; append(gc.marked.vecs, v)!; mark_col(v.data); mark(v.meta); case let l: list => for(let x .. gc.marked.lists){ if(x == l) return void; }; append(gc.marked.lists, l)!; mark_col(l.data); mark(l.meta); case let f: function => for(let x .. gc.marked.funcs){ if(x == f) return void; }; append(gc.marked.funcs, f)!; mark(f.meta); mark(f.body); mark_col(f.args); mark_env(f.envi); case let i: intrinsic => for(let x .. gc.marked.intrinsics){ if(x == i) return void; }; append(gc.marked.intrinsics, i)!; mark(i.meta); case let m: macro => let m = m:function; for(let x .. gc.marked.funcs){ if(x == m) return void; }; append(gc.marked.funcs, m)!; mark(m.meta); mark(m.body); mark_col(m.args); mark_env(m.envi); case let h: hashmap => for(let x .. gc.marked.hashs){ if(x == h) return void; }; mark_hash(h); case let s: symbol => match(hm_get(gc.marked.symbols: hashmap, s)){ case undefined_key => hm_add(gc.marked.symbols: hashmap, s, s); case => void; }; case let s: string => for(let x .. gc.marked.strings){ if(x == s) return void; }; append(gc.marked.strings, s)!; mark(s.meta); case let a: atom => for(let x .. gc.marked.atoms){ if(x == a) return void; }; append(gc.marked.atoms, a)!; mark(*a); case => void; }; }; fn sweep() void ={ const marked_symbols = match(gc.marked.symbols){ case void => gc.marked.symbols = hm_init(false); yield gc.marked.symbols: hashmap; case let hm: hashmap => yield hm; }; const memory_symbols = match(gc.memory.symbols){ case void => gc.memory.symbols = hm_init(false); yield gc.memory.symbols: hashmap; case let hm: hashmap => yield hm; }; for (let i: size = 0; len(memory_symbols.data) > i; i += 1) { match(hm_get(marked_symbols, memory_symbols.data[i].key)){ case undefined_key => free(memory_symbols.data[i].key: symbol); case => void; }; }; for :sweep (let i: size = 0; len(gc.memory.atoms) > i; i += 1) { for(let x .. gc.marked.atoms){ if(x == gc.memory.atoms[i]) continue :sweep; }; free(gc.memory.atoms[i]); }; for :sweep (let i: size = 0; len(gc.memory.strings) > i; i += 1) { for(let x .. gc.marked.strings){ if(x == gc.memory.strings[i]) continue :sweep; }; free_string(gc.memory.strings[i]); }; for :sweep (let i: size = 0; len(gc.memory.hashs) > i; i += 1) { for(let x .. gc.marked.hashs){ if(x == gc.memory.hashs[i]) continue :sweep; }; hm_free(gc.memory.hashs[i]); }; for :sweep (let i: size = 0; len(gc.memory.envs) > i; i += 1) { for(let x .. gc.marked.envs){ if(x == gc.memory.envs[i]) continue :sweep; }; free(gc.memory.envs[i]); //.data is collected as a hashmap }; for :sweep (let i: size = 0; len(gc.memory.vecs) > i; i += 1) { for(let x .. gc.marked.vecs){ if(x == gc.memory.vecs[i]) continue :sweep; }; free_vec(gc.memory.vecs[i]); }; for :sweep (let i: size = 0; len(gc.memory.lists) > i; i += 1) { for(let x .. gc.marked.lists){ if(x == gc.memory.lists[i]) continue :sweep; }; free_list(gc.memory.lists[i]); }; for :sweep (let i: size = 0; len(gc.memory.funcs) > i; i += 1) { for(let x .. gc.marked.funcs){ if(x == gc.memory.funcs[i]) continue :sweep; }; free_func(gc.memory.funcs[i]); }; for :sweep (let i: size = 0; len(gc.memory.intrinsics) > i; i += 1) { for(let x .. gc.marked.intrinsics){ if(x == gc.memory.intrinsics[i]) continue :sweep; }; free(gc.memory.intrinsics[i]); }; reset_memory(&gc.memory); gc = garbage_collector { marked = gc.memory, memory = gc.marked, }; }; // it doesn't make sense to call this with anything but the global repl_env, // because as of this version there's no way to keep track of objects reachable // through the ast of the current evaluation and it's possible continuations. export fn run_gc(envi: *env) void = { mark_env(envi); sweep(); }; ================================================ FILE: impls/hare/mal/hashmap.ha ================================================ // The hashmap implmentation follows this idea: // https://nullprogram.com/blog/2023/09/30/ use io; use fmt; use hash::fnv; export type hashmap = *struct { data: []hmap, meta: MalType, }; export type hmap = struct { key: (symbol | string), val: MalType, child: [4](size | void), }; type pos = struct { exists: bool, index: size, child: (size | void), }; export fn hm_init(gcd: bool = true) hashmap = { let new: hashmap = alloc(struct { data: []hmap = [], meta: MalType = nil, })!; if(gcd) append(gc.memory.hashs, new)!; return new; }; fn hm_free(hm: hashmap) void = { free(hm.data); free(hm); }; fn new( hm: hashmap, p: pos, k: (symbol | string), v: MalType ) void = { const new = hmap { key = k, val = v, child: [4](size | void) = [void...], }; append(hm.data, new)!; match(p.child) { case void => return void; case let i: size => hm.data[p.index].child[i] = len(hm.data) - 1; }; }; export fn keycmp(x: (symbol | string), y: (symbol | string)) bool = { const kx: str = match(x){ case let k: symbol => yield k: str; case let k: string => yield k.data; }; const ky: str = match(y){ case let k: symbol => yield k: str; case let k: string => yield k.data; }; return kx == ky; }; fn hm_find(hm: hashmap, key: (symbol | string)) pos = { let index: size = 0; const k: str = match(key){ case let k: symbol => yield k: str; case let k: string => yield k.data; }; let hash: u32 = fnv::string32(k); if(len(hm.data) == 0) return pos { exists = false, index = 0, child = void, }; for(true){ if (keycmp(key, hm.data[index].key)){ return pos { exists = true, index = index, child = void, }; }; let c = hash >> 30; match(hm.data[index].child[c]){ case void => return pos { exists = false, index = index, child = c, }; case let i: size => index = i; hash <<= 2; continue; }; }; }; export fn hm_set( hm: hashmap, key: (symbol | string), val: MalType, ) void = { let p: pos = hm_find(hm, key); if(p.exists){ hm.data[p.index].val = val; } else { new(hm, p, key, val); }; }; export fn hm_add( hm: hashmap, key: (symbol | string), val: MalType, ) void = { let p: pos = hm_find(hm, key); if(p.exists){ return void; } else { new(hm, p, key, val); }; }; export fn hm_get( hm: hashmap, key: (symbol | string) ) (MalType | error) = { if(len(hm.data) == 0){ return ("hm_get 0", key):undefined_key; }; let p: pos = hm_find(hm, key); if(p.exists) { return hm.data[p.index].val; } else { return ("hm_get", key):undefined_key; }; }; fn hm_copy(hm: hashmap, filter: [](string | symbol) = []) hashmap = { const new = hm_init(); if(len(filter) == 0){ for(let e .. hm.data) { append(new.data, e)!; }; } else { for :map (let e .. hm.data) { for(let f .. filter) { if(keycmp(f, e.key)) continue :map; }; hm_add(new, e.key, e.val); }; }; return new; }; fn hm_print( strbuf: io::handle, hm: hashmap, pp: bool, ) void = { for (let i: size = 0; i < len(hm.data); i += 1){ let e = hm.data[i]; print_form(strbuf, e.key, pp); fmt::fprint(strbuf, " ")!; print_form(strbuf, e.val, pp); if(!(i + 1 == len(hm.data))) fmt::fprint(strbuf, " ")!; }; }; fn hash_cmp(hm1: hashmap, hm2: hashmap) bool = { if(len(hm1.data) != len(hm2.data)){ return false; }; for(let i: size = 0; i < len(hm1.data); i += 1) { match(hm_get(hm2, hm1.data[i].key)){ case undefined_key => return false; case let v: MalType => if(!(mal_eq([hm1.data[i].val, v]) as bool)) return false; }; }; return true; }; fn hm_val_list(hm: hashmap) list = { const length = len(hm.data); const new = make_list(length); for(let i: size = 0; i < length; i += 1){ new.data[i] = hm.data[i].val; }; return new; }; fn hm_key_list(hm: hashmap) list = { const length = len(hm.data); const new = make_list(length); for(let i: size = 0; i < length; i += 1){ new.data[i] = hm.data[i].key; }; return new; }; export fn eval_hash( hm: hashmap, eval: *fn(MalType, *env) (MalType | error), env: *env, ) (hashmap | error) = { const new = hm_init(); for(let e .. hm.data){ hm_add(new, e.key, eval(e.val, env)?); }; return new; }; ================================================ FILE: impls/hare/mal/printer.ha ================================================ use io; use memio; use fmt; use strings; export fn print_form( strbuf: io::handle, form: (MalType | []MalType), print_readably: bool = true ) void = { match(form){ case let l: list => print_list(strbuf, l.data, list_beg, print_readably); case let v: vector => print_list(strbuf, v.data, vec_beg, print_readably); case let c: []MalType => print_list(strbuf, c, list_beg, print_readably); case let h: hashmap => print_hash(strbuf, h, print_readably); case let s: string => print_string(strbuf, s, print_readably); case nil => memio::concat(strbuf, "nil")!; case let b: bool => fmt::fprint(strbuf, b)!; case let s: symbol => memio::concat(strbuf, s: str)!; case let i: number => fmt::fprint(strbuf, i: int)!; case let a: atom => print_list(strbuf, ["atom": symbol, *a], list_beg, print_readably); case let func: (intrinsic | function) => memio::concat(strbuf, "#")!; case => void; }; }; fn print_string( strbuf: io::handle, s: string, print_readable: bool ) void = { let runes = strings::torunes(s.data)!; if(!print_readable){ memio::concat(strbuf, s.data)!; } else { memio::appendrune(strbuf, '"')!; for(let rn .. runes){ let ret = switch (rn) { case '"' => yield "\\\""; case '\\' => yield "\\\\"; case '\b' => yield "\\b"; case '\f' => yield "\\f"; case '\n' => yield "\\n"; case '\r' => yield "\\r"; case '\t' => yield "\\t"; case => yield rn; }; match(ret) { case let rn: rune => memio::appendrune(strbuf, rn)!; case let rn: str => memio::concat(strbuf, rn)!; }; }; memio::appendrune(strbuf, '"')!; }; }; fn print_hash(strbuf: io::handle, hm: hashmap, pp: bool) void ={ const open = '{'; const close = '}'; fmt::fprint(strbuf, open)!; hm_print(strbuf, hm, pp); fmt::fprint(strbuf, close)!; }; fn print_list( strbuf: io::handle, ls: []MalType, t: coll_beg, pp: bool ) void = { let open = '('; let close = ')'; if(t is vec_beg){ open = '['; close = ']'; }; memio::appendrune(strbuf, open)!; for(let i: size = 0; i < len(ls); i += 1) { let form = print_form(strbuf, ls[i], pp); if(!(i == len(ls)-1)){ fmt::fprint(strbuf, " ")!; }; }; memio::appendrune(strbuf, close)!; }; ================================================ FILE: impls/hare/mal/reader.ha ================================================ use io; use fmt; use memio; use strings; export fn read_str(input: []u8) (MalType | error | io::EOF) = { const tk: tokenizer = tokenizer_init(input); match(read_form(&tk)?){ case let res: MalType => return res; case let e: coll_end => return unbalanced; case let res: io::EOF => return io::EOF; }; }; fn read_form(tk: *tokenizer) (...MalType | ...coll_end | io::EOF | error) = { for(true){ match(tokenizer_next(tk)?) { case let t: coll_beg => return read_collection(tk, t); case let t: coll_end => return t; case let s: str => return read_string(s); case let c: comment => void; case let a: word => return read_symbol(a); case let q: quote_tk => return read_quote(tk, q); case let m: mal_meta => return read_meta(tk); case let i: int => return i: number; case io::EOF => return io::EOF; }; }; }; fn read_meta(tk: *tokenizer) (list | error) = { let res: []MalType = []; defer free(res); const meta = match(read_form(tk)?){ case let l: MalType => yield l; case coll_end => return unbalanced; case io::EOF => return unexpected_eof; }; const next_form = match(read_form(tk)?){ case let l: MalType => yield l; case coll_end => return unbalanced; case io::EOF => return unexpected_eof; }; return make_list(3, ["with-meta": symbol, next_form, meta]); }; fn read_quote(tk: *tokenizer, t: quote_tk) (list | error) = { const qs: symbol = match(t){ case quote => yield "quote"; case unquote => yield "unquote"; case quasiquote => yield "quasiquote"; case unquote_splice => yield "splice-unquote"; case at => yield "deref"; }; const form: MalType = match(read_form(tk)?){ case let l: MalType => yield l; case coll_end => return unbalanced; case io::EOF => return unexpected_eof; }; return make_list(2, [qs: symbol, form]); }; fn read_hashmap(tk: *tokenizer) (hashmap | error) = { const res = hm_init(); for(true){ let key = match(read_form(tk)?){ case hash_end => break; case let key: (string | symbol) => yield key; case io::EOF => return unexpected_eof; }; let val = match(read_form(tk)?){ case hash_end => return unbalanced; case let form: MalType => yield form; case io::EOF => return unexpected_eof; }; let d = hm_add(res, key, val); }; return res; }; fn read_collection( tk: *tokenizer, t: coll_beg ) (hashmap | list | vector | error) = { if(t is hash_beg){ return read_hashmap(tk); }; let res: []MalType = []; defer free(res); for(true){ match(read_form(tk)?){ case list_end => if(!(t is list_beg)){ return unbalanced; }; return make_list(len(res), res); case vec_end => if(!(t is vec_beg)){ return unbalanced; }; return make_vec(len(res), res); case hash_end => return unbalanced; case let form: MalType => append(res, form)!; continue; case io::EOF => return unexpected_eof; }; }; }; //todo: keywords as a distinct type fn read_symbol(s: word) MalType = { switch(s){ case "true" => return true; case "false" => return false; case "nil" => return nil; case => return make_symbol(s); }; }; fn read_string(s: str) (string | error) = { let strbuf = memio::dynamic(); defer io::close(&strbuf)!; let runes = strings::torunes(s)!; for (let i: size = 0; i < len(runes); i += 1) { let rn = switch (runes[i]) { case '\\' => i += 1; yield scan_escape(runes[i]); case => yield runes[i]; }; memio::appendrune(&strbuf, rn)!; }; let s: str = memio::string(&strbuf)!; return make_string(s); }; fn scan_escape(rn: rune) rune = { switch (rn) { case '\"' => return '\"'; case '\\' => return '\\'; case 'b' => return '\b'; case 'f' => return '\f'; case 'n' => return '\n'; case 'r' => return '\r'; case 't' => return '\t'; case => return rn; }; }; ================================================ FILE: impls/hare/mal/tokenizer.ha ================================================ use fmt; use io; use strings; use strconv; use ascii; type undefined = !void; type comment = str; type list_beg = void; type vec_beg = void; type hash_beg = void; type coll_beg = (list_beg | vec_beg | hash_beg); type list_end = void; type vec_end = void; type hash_end = void; type coll_end = (list_end | vec_end | hash_end); type mal_meta = void; type at = void; type unquote = void; type unquote_splice = void; type quote = void; type quasiquote = void; type quote_tk = ( unquote_splice | unquote | quote | quasiquote | at); type word = str; type token = (int | str | io::EOF | undefined | ...coll_beg | mal_meta | ...quote_tk | vec_beg | ...coll_end | comment | word); type tokenizer = struct { buffer: []u8, un: (token | void), rb: (rune | void), cursor: size, loc: size, prev_rn: size, prev_t: size, next_t: size, }; fn tokenizer_init(input: []u8) tokenizer = { return tokenizer { buffer = input, un = void, rb = void, cursor = 0, ... }; }; fn unget_rune(tk: *tokenizer, rn: rune) void = { assert(tk.rb is void); tk.rb = rn; tk.loc = tk.prev_rn; }; fn unget_token(tk: *tokenizer, tok: token) void = { assert(tk.un is void); tk.un = tok; tk.next_t = tk.loc; tk.loc = tk.prev_t; }; fn nextrune(tk: *tokenizer) (rune | io::EOF) = { if(tk.rb is rune){ const rn = tk.rb as rune; tk.rb = void; tk.prev_rn = tk.loc; tk.loc += 1; return rn; }; if (tk.cursor >= len(tk.buffer)) { return io::EOF; }; let rn: rune = tk.buffer[tk.cursor]: rune; tk.prev_rn = tk.loc; tk.loc = tk.cursor; tk.cursor += 1; return rn; }; fn iswhitespace(rn: rune) bool = { if(ascii::isspace(rn) || rn == ','){ return true; }; return false; }; fn nextrunews(tk: *tokenizer) (rune | io::EOF ) = { for (true) { match (nextrune(tk)) { case let rn: rune => if (iswhitespace(rn)) { continue; }; return rn; case io::EOF => return io::EOF; }; }; }; fn scan_string(tk: *tokenizer) (token | error) = { const start = tk.cursor; let esc: bool = false; for(true){ const rn = match(nextrune(tk)) { case let rn: rune => yield rn; case io::EOF => return unexpected_eof; }; switch(rn){ case '\\' => esc = !esc; continue; case '"' => if(esc){ esc = false; continue; } else { break; }; case => esc = false; continue; }; }; return strings::fromutf8(tk.buffer[start .. tk.loc])!; }; fn scan_comment(tk: *tokenizer) comment = { const start = tk.loc; let end = start; for(true){ const rn = match(nextrune(tk)){ case let rn: rune => yield rn; case io::EOF => end = tk.cursor; break; }; switch(rn){ case '\n' => end = tk.loc; break; case => continue; }; }; return (strings::fromutf8(tk.buffer[start .. end])!); }; fn tokenizer_next(tk: *tokenizer) (token | error) = { match(tk.un){ case let tok: token => tk.un = void; tk.prev_t = tk.loc; tk.loc = tk.next_t; return tok; case void => tk.prev_t = tk.loc; }; const rn = match(nextrunews(tk)) { case let rn: rune => yield rn; case io::EOF => return io::EOF; }; switch (rn) { case '(' => return list_beg; case ')' => return list_end; case '[' => return vec_beg; case ']' => return vec_end; case '{' => return hash_beg; case '}' => return hash_end; case '"' => return scan_string(tk); case ';' => return scan_comment(tk); case '^' => return mal_meta; case '\'' => return quote; case '`' => return quasiquote; case '~' => return scan_quote(tk); case '@' => return at; case => return scan_atom(tk, rn); }; }; fn scan_atom(tk: *tokenizer, rn: rune) (token | error) = { if (rn == '-') { let nrn = match(nextrune(tk)){ case io::EOF => yield 'n'; case let nrn: rune => unget_rune(tk, nrn); yield nrn; }; if(ascii::isdigit(nrn)){ return scan_number(tk); }; } else if(ascii::isdigit(rn)){ return scan_number(tk); }; return scan_word(tk)!; }; fn scan_number(tk: *tokenizer) (token | error) = { const start = tk.loc; let end: size = start; for(true){ const rn = match(nextrune(tk)){ case io::EOF => end = tk.cursor; break; case let rn: rune => yield rn; }; if(!ascii::isdigit(rn)){ end = tk.loc; unget_rune(tk, rn); break; }; }; return strconv::stoi(strings::fromutf8(tk.buffer[start .. end])!)!; }; fn scan_word(tk: *tokenizer) (token | error) = { const start = tk.loc; let end: size = start; for(true){ const rn = match(nextrune(tk)){ case io::EOF => end = tk.cursor; break; case let rn: rune => yield rn; }; if(!iswordrn(rn)){ end = tk.loc; unget_rune(tk, rn); break; }; }; return strings::fromutf8(tk.buffer[start .. end])!: word; }; fn iswordrn(rn: rune) bool = { if(ascii::isalnum(rn)){ return true; }; switch(rn){ case '-' => return true; case '_' => return true; case '?' => return true; case '!' => return true; case '>' => return true; case '=' => return true; case '<' => return true; case '*' => return true; case '/' => return true; case ':' => return true; case => void; }; return false; }; fn scan_quote(tk: *tokenizer) (token | error) = { match(tokenizer_next(tk)?){ case at => return unquote_splice; case let res: token => unget_token(tk, res); return unquote; }; }; ================================================ FILE: impls/hare/mal/types.ha ================================================ use strings; use types; export type nil = void; export type symbol = str; export type number = i64; export type atom = *MalType; export type vector = *struct { data: []MalType, meta: MalType, }; export type list = *struct { data: []MalType, meta: MalType, }; export type string = *struct { data: str, meta: MalType, }; export type intrinsic = *struct { eval: *fn([]MalType) (MalType | error), meta: MalType, }; export type function = *struct { eval: *fn(MalType, *env) (MalType | error), envi: *env, args: []MalType, body: MalType, meta: MalType, }; export type macro = function; export type MalType = (macro | function | intrinsic | atom | bool | string | hashmap | list | vector | number | symbol | nil); // Any mal object that is supposed to persist should be created by one of these // functions. Any allocations done by other functions should be freed manually. // // Envs & Hashmaps are treated separately in their implementation files. export fn make_intrinsic( func: *fn([]MalType) (MalType | error), ) intrinsic = { const new = alloc(struct { eval: *fn([]MalType) (MalType | error) = func, meta: MalType = nil, })!; append(gc.memory.intrinsics, new)!; return new; }; export fn make_func( eval: *fn(MalType, *env) (MalType | error), envi: *env, args: []MalType, body: MalType, ) function = { let arg_list: []MalType = []; if(len(args) > 0) { arg_list = alloc([nil...], len(args))!; arg_list[0..] = args; }; const new = alloc(struct{ eval: *fn(MalType, *env) (MalType | error) = eval, envi: *env= envi, args: []MalType = arg_list, body: MalType = body, meta: MalType = nil })!; append(gc.memory.funcs, new)!; return new; }; fn free_func(f: function) void = { free(f.args); free(f); }; export fn make_list(s: size, init: []MalType = []) list = { const new: list = alloc(struct { data: []MalType = [], meta: MalType = nil, })!; if (s == 0) return new; new.data = alloc([nil...], s)!; new.data[0..len(init)] = init; append(gc.memory.lists, new)!; return new; }; fn free_list(l: list) void = { free(l.data); free(l); }; export fn make_vec(s: size, init: []MalType = []) vector = { const new: vector = alloc(struct { data: []MalType = [], meta: MalType = nil, })!; if (s == 0) return new; new.data = alloc([nil...], s)!; new.data[0..len(init)] = init; append(gc.memory.vecs, new)!; return new; }; fn free_vec(v: vector) void = { free(v.data); free(v); }; export fn make_symbol(name: str) symbol = { let hm: hashmap = match(gc.memory.symbols){ case void => gc.memory.symbols = hm_init(false); yield gc.memory.symbols: hashmap; case let hm: hashmap => yield hm; }; match(hm_get(hm, name: symbol)) { case undefined_key => void; case let s: symbol => return s; }; const new = strings::dup(name)!: symbol; hm_add(gc.memory.symbols: hashmap, new, new); return new; }; export fn make_string(s: str) string = { const new_str = strings::dup(s)!; const new = alloc(struct { data: str = new_str, meta: MalType = nil, })!; append(gc.memory.strings, new)!; return new; }; fn free_string(s: string) void = { free(s.data); free(s); }; export fn make_atom(ref: MalType) atom = { const new = alloc(ref)!; append(gc.memory.atoms, new)!; return new; }; // check if two strings share the same buffer in memory // Does not check for substrings! fn str_memeq(s1: str, s2: str) bool = { const ts1 = &s1: *types::string; const ts2 = &s2: *types::string; return ts1.data == ts2.data; }; ================================================ FILE: impls/hare/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/hare/step0_repl.ha ================================================ use bufio; use fmt; use io; use os; use strings; fn read (input: []u8) []u8 = { return input; }; fn eval (input: []u8) []u8 = { return input; }; fn print (input: []u8) str = { return strings::fromutf8(input)!; }; fn rep (input: []u8) str = { return print(eval(read(input))); }; export fn main() void = { for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); fmt::println(rep(input))!; }; }; ================================================ FILE: impls/hare/step1_read_print.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input)?; }; fn eval (input: mal::MalType) mal::MalType = { return input; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8) void = { match (read(input)){ case let e: mal::error => mal::format_error(os::stderr, e); case let form: mal::MalType => print(eval(form)); case io::EOF => return void; }; }; export fn main() void = { for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); rep(input); }; }; ================================================ FILE: impls/hare/step2_eval.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input)?; }; fn eval_list(ls: mal::list, env: mal::hashmap) mal::MalType = { if(len(ls.data) == 0) return ls; const func = match(eval(ls.data[0], env)){ case let func: mal::intrinsic => yield func; case => return ls; }; for(let i: size = 1; i < len(ls.data); i += 1){ ls.data[i] = eval(ls.data[i], env); }; return func.eval(ls.data[1..])!; }; fn eval_vec(vec: mal::vector, env: mal::hashmap) mal::vector ={ if(len(vec.data) == 0) return vec; for(let i: size = 0; i < len(vec.data); i += 1){ vec.data[i] = eval(vec.data[i], env); }; return vec; }; fn eval_hash( map: mal::hashmap, env: mal::hashmap, ) mal::hashmap = { let res = mal::hm_init(); for(let e .. map.data) { mal::hm_add(res, e.key, eval(e.val, env)); }; return res; }; fn eval (ast: mal::MalType, env: mal::hashmap) mal::MalType = { let res: mal::MalType = match(ast){ case let key: mal::symbol => let v: mal::MalType = match(mal::hm_get(env, key)){ case let v: mal::MalType => yield v; case => yield mal::nil; }; yield eval(v, env); case let ls: mal::list => yield eval_list(ls, env); case let vec: mal::vector => yield eval_vec(vec, env); case let hash: mal::hashmap => yield eval_hash(hash, env); case let func: mal::intrinsic => yield func; case => yield ast; }; return res; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: mal::hashmap) void = { match (read(input)){ case let e: mal::error => mal::format_error(os::stderr, e); case let form: mal::MalType => print(eval(form, env)); case io::EOF => return void; }; }; export fn main() void = { const env = mal::hm_init(); mal::hm_add(env, "+": mal::symbol, mal::make_intrinsic(&mal::plus)); mal::hm_add(env, "-": mal::symbol, mal::make_intrinsic(&mal::minus)); mal::hm_add(env, "*": mal::symbol, mal::make_intrinsic(&mal::mult)); mal::hm_add(env, "/": mal::symbol, mal::make_intrinsic(&mal::div)); for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); rep(input, env); }; }; ================================================ FILE: impls/hare/step3_env.ha ================================================ use bufio; use fmt; use io; use mal; use os; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input)?; }; fn eval_let( env: *mal::env, bindings: []mal::MalType, body: mal::MalType... ) (mal::MalType | mal::error) = { let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ mal::env_set(let_env, bindings[i] as mal::symbol, eval(bindings[i+1], let_env)?); }; let result: mal::MalType = mal::nil; for(let form .. body){ result = eval(form, let_env)?; }; return result; }; fn eval_list(ls: mal::list, env: *mal::env) (mal::MalType | mal::error) = { if(len(ls.data) == 0) return ls; // handle special cases of 'let*' and 'def!' forms match(ls.data[0]){ case let sym: mal::symbol => if(sym == "def!"){ if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; mal::env_set(env, ls.data[1] as mal::symbol, val); return val; } else if(sym == "let*"){ if(len(ls.data) < 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; return eval_let(env, bindings, ls.data[2..]...); }; case => void; }; const func = match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => yield func; case => return ls; }; for(let i: size = 1; i < len(ls.data); i += 1){ ls.data[i] = eval(ls.data[i], env)?; }; return func.eval(ls.data[1..]); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ let res: mal::vector = mal::make_vec(len(vec.data)); if(len(vec.data) == 0) return vec; for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let res: mal::MalType = match(ast){ case let key: mal::symbol => yield eval(mal::env_get(env, key)?, env)?; case let ls: mal::list => yield eval_list(ls, env)?; case let vec: mal::vector => yield eval_vec(vec, env)?; case let hash: mal::hashmap => yield mal::eval_hash(hash, &eval, env)?; case let func: mal::intrinsic => yield func; case => yield ast; }; return res; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env) void = { let ast = match (read(input)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; print(result); }; export fn main() void = { const env = mal::env_init(); mal::env_set(env, "nil":mal::symbol, mal::nil); mal::load_namespace(mal::core, env)!; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); rep(input, env); }; }; ================================================ FILE: impls/hare/step4_if_fn_do.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_let( env: *mal::env, bindings: []mal::MalType, body: mal::MalType... ) (mal::MalType | mal::error) = { let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ mal::env_set(let_env, bindings[i] as mal::symbol, eval(bindings[i+1], let_env)?); }; let result: mal::MalType = mal::nil; for(let form .. body){ result = eval(form, let_env)?; }; return result; }; fn eval_list(ls: mal::list, env: *mal::env) (mal::MalType | mal::error) = { if(len(ls.data) == 0) return ls; // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; mal::env_set(env, ls.data[1] as mal::symbol, val); return val; case "let*" => if(len(ls.data) < 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; return eval_let(env, bindings, ls.data[2..]...); case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..]){ result = eval(form, env)?; }; return result; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ return eval(ls.data[3], env); } else { return mal::nil; }; case let b: bool => if(b){ return eval(ls.data[2], env); } else if(len(ls.data) == 4){ return eval(ls.data[3], env); } else { return mal::nil; }; case => return eval(ls.data[2], env); }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::list => yield a.data; case let a: mal::vector => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let func: mal::function => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; let local = mal::env_init(func.envi); mal::env_bind(local, func.args, args); return eval(func.body, local); case => return ls; }; }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i],env)?; }; return res; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let res: mal::MalType = match(ast){ case let key: mal::symbol => yield if(strings::hasprefix(key, ':')){ yield key; } else { yield mal::env_get(env, key)?; }; case let ls: mal::list => yield eval_list(ls, env)?; case let vec: mal::vector => yield eval_vec(vec, env)?; case let hash: mal::hashmap => yield mal::eval_hash(hash, &eval, env)?; case let func: mal::intrinsic => yield func; case let func: mal::function => yield func; case => yield ast; }; return res; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env) void = { let ast = match(read(input)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; print(result); }; export fn main() void = { const env = mal::env_init(); mal::load_namespace(mal::core, env)!; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); rep(input, env); }; }; ================================================ FILE: impls/hare/step5_tco.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; mal::env_set(env, ls.data[1] as mal::symbol, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ mal::env_set(let_env, bindings[i] as mal::symbol, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::list => yield a.data; case let a: mal::vector => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); ast = func.body; free(args); continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env) void = { let ast = match(read(input)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; print(result); }; export fn main() void = { const env = mal::env_init(); mal::load_namespace(mal::core, env)!; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; defer free(input); rep(input, env); }; }; ================================================ FILE: impls/hare/step6_file.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; mal::env_set(env, ls.data[1] as mal::symbol, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ mal::env_set(let_env, bindings[i] as mal::symbol, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::list => yield a.data; case let a: mal::vector => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); ast = func.body; continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { let ast = match(read(input)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; if(printp) print(result); }; let repl_env: nullable *mal::env = null; fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { if(len(args) < 1) return ("'do_eval': too few arguments", args): mal::syntax_error; const env = match(repl_env){ case let env: *mal::env => yield env; case => return mal::not_implemented; }; return eval(args[0], env); }; export fn main() void = { repl_env = mal::env_init(); const env = match(repl_env){ case let env: *mal::env => yield env; case => fmt::fatal("No repl environment initialized!"); }; mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); mal::load_namespace(mal::core, env)!; let load_file = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; rep(strings::toutf8(load_file), env, false); const args = os::args; let argvlen: size = if (len(args) > 2) { yield len(args)-2; } else { yield 0; }; let argv = mal::make_list(argvlen); if (len(args) > 2){ for(let i: size = 2; i < len(args); i += 1){ argv.data[i-2] = &args[i]: mal::string; }; }; mal::env_set(env, "*ARGV*", argv); if(len(args) > 1){ let exec_str = strings::join("", "(load-file \"", args[1], "\")")!; rep(strings::toutf8(exec_str), env, false); free(exec_str); os::exit(0); }; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; rep(input, env); free(input); }; }; ================================================ FILE: impls/hare/step7_quote.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn starts_with(ast: mal::MalType, sym: str) bool = { match(ast){ case let ls: mal::list=> if(len(ls.data) < 1) return false; match(ls.data[0]){ case let s: mal::symbol => return s == sym; case => return false; }; case => return false; }; }; fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { let acc = mal::make_list(0); for(let i: size = len(ast); 0 < i ; i -= 1){ let elt: mal::MalType = ast[i - 1]; if(starts_with(elt, "splice-unquote")){ let elt: mal::list = match(elt){ case let l: mal::list => yield l; case => return ("list", ast): mal::type_error; }; acc = mal::make_list(3, ["concat":mal::symbol, elt.data[1], acc]); } else { acc = mal::make_list(3, ["cons":mal::symbol, quasiquote(elt)?, acc]); }; }; return acc; }; fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { match(ast) { case let ls: mal::list => if(starts_with(ls, "unquote")) { return ls.data[1]; } else { return qq_iter(ls.data); }; case let ls: mal::vector => let res: mal::list = mal::make_list(2, ["vec":mal::symbol, qq_iter(ls.data)?]); return res; case let hm: (mal::symbol | mal::hashmap) => let res: mal::list = mal::make_list(2, ["quote":mal::symbol, ast]); return res; case => return ast; }; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*' and 'def!' forms match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "quasiquote" => ast = quasiquote(ls.data[1])?; continue; case "quote" => return ls.data[1]; case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; mal::env_set(env, ls.data[1] as mal::symbol, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ mal::env_set(let_env, bindings[i] as mal::symbol, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::vector => yield a.data; case let a: mal::list => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); free(args); ast = func.body; continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { let ast = match(read(input)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; if(printp) print(result); }; let repl_env: nullable *mal::env = null; fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { if(len(args) < 1) return ("'do_eval': too few arguments", args): mal::syntax_error; const env = match(repl_env){ case let env: *mal::env => yield env; case => return mal::not_implemented; }; return eval(args[0], env); }; export fn main() void = { repl_env = mal::env_init(); const env = match(repl_env){ case let env: *mal::env => yield env; case => fmt::fatal("No repl environment initialized!"); }; mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); mal::load_namespace(mal::core, env)!; let load_file = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; rep(strings::toutf8(load_file), env, false); // handle command line arguments const args = os::args; let argvlen: size = if (len(args) > 2) { yield len(args)-2; } else { yield 0; }; let argv = mal::make_list(argvlen); if (len(args) > 2){ for(let i: size = 2; i < len(args); i += 1){ argv.data[i-2] = &args[i]: mal::string; }; }; mal::env_set(env, "*ARGV*", argv); if(len(args) > 1){ let exec_str = strings::join("", "(load-file \"", args[1], "\")")!; rep(strings::toutf8(exec_str), env, false); free(exec_str); os::exit(0); }; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; rep(input, env); free(input); }; }; ================================================ FILE: impls/hare/step8_macros.ha ================================================ use bufio; use fmt; use io; use mal; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn starts_with(ast: mal::MalType, sym: str) bool = { match(ast){ case let ls: mal::list=> if(len(ls.data) < 1) return false; match(ls.data[0]){ case let s: mal::symbol => return s == sym; case => return false; }; case => return false; }; }; fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { let acc = mal::make_list(0); for(let i: size = len(ast); 0 < i ; i -= 1){ let elt: mal::MalType = ast[i - 1]; if(starts_with(elt, "splice-unquote")){ let elt: mal::list = match(elt){ case let l: mal::list => yield l; case => return ("list", ast): mal::type_error; }; acc = mal::make_list(3, ["concat":mal::symbol, elt.data[1], acc]); } else { acc = mal::make_list(3, ["cons":mal::symbol, quasiquote(elt)?, acc]); }; }; return acc; }; fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { match(ast) { case let ls: mal::list => if(starts_with(ls, "unquote")) { return ls.data[1]; } else { return qq_iter(ls.data); }; case let ls: mal::vector => let res: mal::list = mal::make_list(2, ["vec":mal::symbol, qq_iter(ls.data)?]); return res; case let hm: (mal::symbol | mal::hashmap) => let res: mal::list = mal::make_list(2, ["quote":mal::symbol, ast]); return res; case => return ast; }; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and // 'def!' forms. match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "quasiquote" => ast = quasiquote(ls.data[1])?; continue; case "quote" => return ls.data[1]; case "defmacro!" => if(len(ls.data) != 3) return ("defmacro! expects 2 arguments", ls): mal::syntax_error; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; let res: mal::macro = match(eval(ls.data[2], env)) { case let func: mal::function => yield func; case => return ("function", ls.data[2]): mal::type_error; }; mal::env_set(env, name, res); return res; case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(env, name, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ let name: mal::symbol = match(bindings[i]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(let_env, name, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::vector => yield a.data; case let a: mal::list => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; // apply match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let mac: mal::macro => ast = _apply(mac, ls.data[1..])?; continue; case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); free(args); ast = func.body; continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn _apply( func: (mal::function | mal::intrinsic), args: []mal::MalType ) (mal::MalType | mal::error) = { match(func){ case let func: mal::function => let env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); return func.eval(func.body, env); case let func: mal::intrinsic => return func.eval(args); }; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { let ast = match(read(input)){ case let e :mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; if(printp) print(result); }; let repl_env: nullable *mal::env = null; fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { if(len(args) < 1) return ("'do_eval': too few arguments", args): mal::syntax_error; const env = match(repl_env){ case let env: *mal::env => yield env; case => return mal::not_implemented; }; return eval(args[0], env); }; export fn main() void = { repl_env = mal::env_init(); const env = match(repl_env){ case let env: *mal::env => yield env; case => fmt::fatal("No repl environment initialized!"); }; mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); mal::load_namespace(mal::core, env)!; let load_file = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; let cond = "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"; rep(strings::toutf8(cond), env, false); rep(strings::toutf8(load_file), env, false); // handle command line arguments const args = os::args; let argvlen: size = if (len(args) > 2) { yield len(args)-2; } else { yield 0; }; let argv = mal::make_list(argvlen); if (len(args) > 2){ for(let i: size = 2; i < len(args); i += 1){ argv.data[i-2] = &args[i]: mal::string; }; }; mal::env_set(env, "*ARGV*", argv); if(len(args) > 1){ let exec_str = strings::join("", "(load-file \"", args[1], "\")")!; rep(strings::toutf8(exec_str), env, false); free(exec_str); os::exit(0); }; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; rep(input, env); free(input); }; }; ================================================ FILE: impls/hare/step9_try.ha ================================================ use bufio; use fmt; use io; use mal; use memio; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn starts_with(ast: mal::MalType, sym: str) bool = { match(ast){ case let ls: mal::list=> if(len(ls.data) < 1) return false; match(ls.data[0]){ case let s: mal::symbol => return s == sym; case => return false; }; case => return false; }; }; fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { let acc = mal::make_list(0); for(let i: size = len(ast); 0 < i ; i -= 1){ let elt: mal::MalType = ast[i - 1]; if(starts_with(elt, "splice-unquote")){ let elt: mal::list = match(elt){ case let l: mal::list => yield l; case => return ("list", ast): mal::type_error; }; acc = mal::make_list(3, ["concat":mal::symbol, elt.data[1], acc]); } else { acc = mal::make_list(3, ["cons":mal::symbol, quasiquote(elt)?, acc]); }; }; return acc; }; fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { match(ast) { case let ls: mal::list => if(starts_with(ls, "unquote")) { return ls.data[1]; } else { return qq_iter(ls.data); }; case let ls: mal::vector => let res: mal::list = mal::make_list(2, ["vec":mal::symbol, qq_iter(ls.data)?]); return res; case let hm: (mal::symbol | mal::hashmap) => let res: mal::list = mal::make_list(2, ["quote":mal::symbol, ast]); return res; case => return ast; }; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and // 'def!' forms. match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "try*" => match(eval(ls.data[1], env)){ case let e: mal::error => let s: mal::MalType = match(e){ case let e: mal::malerror => yield e.1; case => let buf = memio::dynamic(); mal::format_error(&buf, e); let s = memio::string(&buf)!; let ret = mal::make_string(s); io::close(&buf)!; yield ret; }; env = mal::env_init(env); if (len(ls.data) < 3) return e; match(ls.data[2]){ case let l: mal::list => if(!(starts_with(l, "catch*"))) return ("expected catch* phrase", l): mal::syntax_error; mal::env_set( env, l.data[1] as mal::symbol, s); ast = l.data[2]; continue; case => return ("list", ls): mal::type_error; }; case let c: mal::MalType=> return c; }; case "quasiquote" => ast = quasiquote(ls.data[1])?; continue; case "quote" => return ls.data[1]; case "defmacro!" => if(len(ls.data) != 3) return ("defmacro! expects 2 arguments", ls): mal::syntax_error; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; let res: mal::macro = match(eval(ls.data[2], env)) { case let func: mal::function => yield func; case => return ("function", ls.data[2]): mal::type_error; }; mal::env_set(env, name, res); return res; case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(env, name, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ let name: mal::symbol = match(bindings[i]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(let_env, name, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::vector => yield a.data; case let a: mal::list => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; // apply match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let mac: mal::macro => ast = _apply(mac, ls.data[1..])?; continue; case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); free(args); ast = func.body; continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn _apply(func: (mal::function | mal::intrinsic), args: []mal::MalType) (mal::MalType | mal::error) = { match(func){ case let func: mal::function => let env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); return func.eval(func.body, env); case let func: mal::intrinsic => return func.eval(args); }; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { let ast = match(read(input)){ case let e: mal::error => fmt::errorln("Exception:")!; return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => fmt::errorln("Exception:")!; return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; if(printp) print(result); }; let repl_env: nullable *mal::env = null; fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { if(len(args) < 1) return ("'do_eval': too few arguments", args): mal::syntax_error; const env = match(repl_env){ case let env: *mal::env => yield env; case => return mal::not_implemented; }; return eval(args[0], env); }; export fn main() void = { repl_env = mal::env_init(); const env = match(repl_env){ case let env: *mal::env => yield env; case => fmt::fatal("No repl environment initialized!"); }; mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); mal::load_namespace(mal::core, env)!; let load_file = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; let cond = "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"; rep(strings::toutf8(cond), env, false); rep(strings::toutf8(load_file), env, false); // handle command line arguments const args = os::args; let argvlen: size = if (len(args) > 2) { yield len(args)-2; } else { yield 0; }; let argv = mal::make_list(argvlen); if (len(args) > 2){ for(let i: size = 2; i < len(args); i += 1){ argv.data[i-2] = &args[i]: mal::string; }; }; mal::env_set(env, "*ARGV*", argv); if(len(args) > 1){ let exec_str = strings::join("", "(load-file \"", args[1], "\")")!; rep(strings::toutf8(exec_str), env, false); free(exec_str); os::exit(0); }; for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; rep(input, env); free(input); }; }; ================================================ FILE: impls/hare/stepA_mal.ha ================================================ use bufio; use fmt; use io; use mal; use memio; use os; use strings; fn read (input: []u8) (mal::MalType | io::EOF | mal::error) = { return mal::read_str(input); }; fn eval_vec(vec: mal::vector, env: *mal::env) (mal::vector | mal::error) ={ if(len(vec.data) == 0) return vec; let res: mal::vector = mal::make_vec(len(vec.data)); for(let i: size = 0; i < len(vec.data); i += 1){ res.data[i] = eval(vec.data[i], env)?; }; return res; }; fn starts_with(ast: mal::MalType, sym: str) bool = { match(ast){ case let ls: mal::list=> if(len(ls.data) < 1) return false; match(ls.data[0]){ case let s: mal::symbol => return s == sym; case => return false; }; case => return false; }; }; fn qq_iter(ast: []mal::MalType) (mal::MalType | mal::error) = { let acc = mal::make_list(0); for(let i: size = len(ast); 0 < i ; i -= 1){ let elt: mal::MalType = ast[i - 1]; if(starts_with(elt, "splice-unquote")){ let elt: mal::list = match(elt){ case let l: mal::list => yield l; case => return ("list", ast): mal::type_error; }; acc = mal::make_list(3, ["concat":mal::symbol, elt.data[1], acc]); } else { acc = mal::make_list(3, ["cons":mal::symbol, quasiquote(elt)?, acc]); }; }; return acc; }; fn quasiquote(ast: mal::MalType) (mal::MalType | mal::error) = { match(ast) { case let ls: mal::list => if(starts_with(ls, "unquote")) { return ls.data[1]; } else { return qq_iter(ls.data); }; case let ls: mal::vector => let res: mal::list = mal::make_list(2, ["vec":mal::symbol, qq_iter(ls.data)?]); return res; case let hm: (mal::symbol | mal::hashmap) => let res: mal::list = mal::make_list(2, ["quote":mal::symbol, ast]); return res; case => return ast; }; }; fn eval (ast: mal::MalType, env: *mal::env) (mal::MalType | mal::error) = { for(true){ match(mal::env_get(env, "DEBUG-EVAL")){ case mal::undefined_symbol => void; case mal::nil => void; case => fmt::print("EVAL: ")!; mal::print_form(os::stdout, ast); fmt::print("\n")!; mal::print_form(os::stdout, env.data); fmt::print("\n")!; }; let ls: mal::list = match(ast){ case let key: mal::symbol => if(strings::hasprefix(key, ':')){ return key; } else { return mal::env_get(env, key)?; }; case let vec: mal::vector => return eval_vec(vec, env)?; case let hash: mal::hashmap => return mal::eval_hash(hash, &eval, env)?; case let ls: mal::list => yield ls; case => return ast; }; if(len(ls.data) == 0) return ast; // handle special cases of 'if' 'fn*', 'do', 'let*', 'defmacro!' and // 'def!' forms. match(ls.data[0]){ case let sym: mal::symbol => switch(sym){ case "try*" => match(eval(ls.data[1], env)){ case let e: mal::error => let s: mal::MalType = match(e){ case let e: mal::malerror => yield e.1; case => let buf = memio::dynamic(); mal::format_error(&buf, e); let s = memio::string(&buf)!; let ret = mal::make_string(s); io::close(&buf)!; yield ret; }; env = mal::env_init(env); if (len(ls.data) < 3) return e; match(ls.data[2]){ case let l: mal::list => if(!(starts_with(l, "catch*"))) return ("expected catch* phrase", l): mal::syntax_error; mal::env_set(env, l.data[1] as mal::symbol, s); ast = l.data[2]; continue; case => return ("list", ls): mal::type_error; }; case let c: mal::MalType=> return c; }; case "quasiquote" => ast = quasiquote(ls.data[1])?; continue; case "quote" => return ls.data[1]; case "defmacro!" => if(len(ls.data) != 3) return ("defmacro! expects 2 arguments", ls): mal::syntax_error; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; let res: mal::macro = match(eval(ls.data[2], env)) { case let func: mal::function => yield func; case => return ("function", ls.data[2]): mal::type_error; }; mal::env_set(env, name, res); return res; case "def!" => if(len(ls.data) != 3) return ("def! expects 2 arguments", ls): mal::syntax_error; let val = eval(ls.data[2], env)?; let name: mal::symbol = match(ls.data[1]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(env, name, val); return val; case "let*" => if(len(ls.data) != 3) return ("let*: too few arguments", ls): mal::syntax_error; let bindings: []mal::MalType = match(ls.data[1]){ case let b: mal::list => yield b.data; case let b: mal::vector => yield b.data; case => return ("let*", ls): mal::syntax_error; }; let let_env = mal::env_init(env); for(let i: size = 0; i < len(bindings); i += 2){ let name: mal::symbol = match(bindings[i]){ case let name: mal::symbol => yield name; case => return ("symbol", ls.data[1]): mal::type_error; }; mal::env_set(let_env, name, eval(bindings[i+1], let_env)?); }; env = let_env; ast = ls.data[2]; continue; case "do" => let result: mal::MalType = mal::nil; for(let form .. ls.data[1..len(ls.data)-1]){ result = eval(form, env)?; }; ast = ls.data[len(ls.data)-1]; continue; case "if" => if(len(ls.data) > 4 || len(ls.data) < 3) return ("if expects 2 or 3 arguments", ls): mal::syntax_error; match(eval(ls.data[1], env)?){ case mal::nil => if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case let b: bool => if(b){ ast = ls.data[2]; continue; } else if(len(ls.data) == 4){ ast = ls.data[3]; continue; } else { return mal::nil; }; case => ast = ls.data[2]; continue; }; case "fn*" => let args = match(ls.data[1]){ case let a: mal::vector => yield a.data; case let a: mal::list => yield a.data; }; let body = match(ls.data[2]){ case let b: mal::MalType => yield b; case => return mal::nil; }; return mal::make_func(&eval, env, args, body); case => void; }; case => void; }; // apply match(eval(ls.data[0], env)?){ case let func: mal::intrinsic => let args: []mal::MalType = []; defer free(args); for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; return func.eval(args); case let mac: mal::macro => ast = _apply(mac, ls.data[1..])?; continue; case let func: mal::function => let args: []mal::MalType = []; for(let arg .. ls.data[1..]){ append(args, eval(arg, env)?)!; }; env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); free(args); ast = func.body; continue; case => return ("not a function:", ls.data[0]): mal::syntax_error; }; };}; fn _apply(func: (mal::function | mal::intrinsic), args: []mal::MalType) (mal::MalType | mal::error) = { match(func){ case let func: mal::function => let env = mal::env_init(func.envi); mal::env_bind(env, func.args, args); return func.eval(func.body, env); case let func: mal::intrinsic => return func.eval(args); }; }; fn print (input: mal::MalType) void = { mal::print_form(os::stdout, input); fmt::print("\n")!; }; fn rep (input: []u8, env: *mal::env, printp: bool = true) void = { let ast = match(read(input)){ case let e: mal::error => fmt::errorln("Exception:")!; return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; case io::EOF => return void; }; let result = match(eval(ast, env)){ case let e: mal::error => fmt::errorln("Exception:")!; return mal::format_error(os::stderr, e); case let form: mal::MalType => yield form; }; if(printp) print(result); mal::run_gc(env); }; let repl_env: nullable *mal::env = null; fn do_eval(args: []mal::MalType) (mal::MalType | mal::error) = { if(len(args) < 1) return ("'do_eval': too few arguments", args): mal::syntax_error; const env = match(repl_env){ case let env: *mal::env => yield env; case => return mal::not_implemented; }; return eval(args[0], env); }; export fn main() void = { repl_env = mal::env_init(); const env = match(repl_env){ case let env: *mal::env => yield env; case => fmt::fatal("No repl environment initialized!"); }; mal::env_set(env, "*host-language*", mal::make_string("hare")); mal::env_set(env, "eval", mal::make_intrinsic(&do_eval)); mal::load_namespace(mal::core, env)!; let load_file = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"; let cond = "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"; rep(strings::toutf8(load_file), env, false); rep(strings::toutf8(cond), env, false); // handle command line arguments const args = os::args; let argvlen: size = if (len(args) > 2) { yield len(args)-2; } else { yield 0; }; let argv = mal::make_list(argvlen); if (len(args) > 2){ for(let i: size = 2; i < len(args); i += 1){ argv.data[i-2] = &args[i]: mal::string; }; }; mal::env_set(env, "*ARGV*", argv); if(len(args) > 1){ let exec_str = strings::join("", "(load-file \"", args[1], "\")")!; rep(strings::toutf8(exec_str), env, false); free(exec_str); os::exit(0); }; rep(strings::toutf8("(println (str \"Mal [\" *host-language* \"]\"))"), env, false); for(true){ fmt::printf("user> ")!; bufio::flush(os::stdout)!; const input = match(bufio::read_line(os::stdin)){ case let input: []u8 => yield input; case io::EOF => break; case io::error => break; }; rep(input, env); free(input); }; }; ================================================ FILE: impls/haskell/Core.hs ================================================ module Core ( ns ) where import Control.Monad.Except (throwError) import Control.Monad.Trans (liftIO) import qualified Data.Map.Strict as Map import Data.Time.Clock.POSIX (getPOSIXTime) import Data.IORef (newIORef, readIORef, writeIORef) import Readline (readline) import Reader (read_str) import Types import Printer (_pr_list) -- General functions equal_Q :: Fn equal_Q [a, b] = return $ MalBoolean $ a == b equal_Q _ = throwStr "illegal arguments to =" -- Error/Exception functions throw :: Fn throw [mv] = throwError mv throw _ = throwStr "illegal arguments to throw" -- Unary predicates pred1 :: String -> (MalVal -> Bool) -> (String, Fn) pred1 name op = (name, fn) where fn :: Fn fn [a] = return $ MalBoolean $ op a fn _ = throwStr $ "illegal arguments to " ++ name atom_Q :: MalVal -> Bool atom_Q (MalAtom _ _) = True atom_Q _ = False false_Q :: MalVal -> Bool false_Q (MalBoolean False) = True false_Q _ = False fn_Q :: MalVal -> Bool fn_Q (MalFunction _ _) = True fn_Q _ = False macro_Q :: MalVal -> Bool macro_Q (MalMacro _) = True macro_Q _ = False map_Q :: MalVal -> Bool map_Q (MalHashMap _ _) = True map_Q _ = False keyword_Q :: MalVal -> Bool keyword_Q (MalKeyword _) = True keyword_Q _ = False list_Q :: MalVal -> Bool list_Q (MalSeq _ (Vect False) _) = True list_Q _ = False nil_Q :: MalVal -> Bool nil_Q Nil = True nil_Q _ = False number_Q :: MalVal -> Bool number_Q (MalNumber _) = True number_Q _ = False string_Q :: MalVal -> Bool string_Q (MalString _) = True string_Q _ = False symbol_Q :: MalVal -> Bool symbol_Q (MalSymbol _) = True symbol_Q _ = False true_Q :: MalVal -> Bool true_Q (MalBoolean True) = True true_Q _ = False vector_Q :: MalVal -> Bool vector_Q (MalSeq _ (Vect True) _) = True vector_Q _ = False -- Scalar functions symbol :: Fn symbol [MalString s] = return $ MalSymbol s symbol _ = throwStr "symbol called with non-string" keyword :: Fn keyword [kw@(MalKeyword _)] = return kw keyword [MalString s] = return $ MalKeyword s keyword _ = throwStr "keyword called with non-string" -- String functions pr_str :: Fn pr_str args = liftIO $ MalString <$> _pr_list True " " args str :: Fn str args = liftIO $ MalString <$> _pr_list False "" args prn :: Fn prn args = liftIO $ do putStrLn =<< _pr_list True " " args return Nil println :: Fn println args = liftIO $ do putStrLn =<< _pr_list False " " args return Nil slurp :: Fn slurp [MalString path] = MalString <$> liftIO (readFile path) slurp _ = throwStr "invalid arguments to slurp" do_readline :: Fn do_readline [MalString prompt] = do maybeLine <- liftIO $ readline prompt case maybeLine of Nothing -> return Nil Just line -> return $ MalString line do_readline _ = throwStr "invalid arguments to readline" read_string :: Fn read_string [MalString s] = read_str s read_string _ = throwStr "invalid read-string" -- Numeric functions num_op :: String -> (Int -> Int -> a) -> (a -> MalVal) -> (String, Fn) num_op name op constructor = (name, fn) where fn :: Fn fn [MalNumber a, MalNumber b] = return $ constructor $ op a b fn _ = throwStr $ "illegal arguments to " ++ name time_ms :: Fn time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime time_ms _ = throwStr "invalid time-ms" -- List functions list :: Fn list = return . toList -- Vector functions vector :: Fn vector = return . MalSeq (MetaData Nil) (Vect True) -- Hash Map functions hash_map :: Fn hash_map kvs = case kv2map Map.empty kvs of Just m -> return m Nothing -> throwStr "invalid call to hash-map" assoc :: Fn assoc (MalHashMap _ hm : kvs) = case kv2map hm kvs of Just m -> return m Nothing -> throwStr "invalid assoc" assoc _ = throwStr "invalid call to assoc" dissoc :: Fn dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) . foldl (flip Map.delete) hm <$> mapM encodeKey ks dissoc _ = throwStr "invalid call to dissoc" get :: Fn get [MalHashMap _ hm, k] = orNil . flip Map.lookup hm <$> encodeKey k where orNil (Just v) = v orNil Nothing = Nil get [Nil, k] = const Nil <$> encodeKey k get _ = throwStr "invalid call to get" contains_Q :: Fn contains_Q [MalHashMap _ m, k] = MalBoolean . flip Map.member m <$> encodeKey k contains_Q [Nil, k] = MalBoolean . const False <$> encodeKey k contains_Q _ = throwStr "invalid call to contains?" keys :: Fn keys [MalHashMap _ hm] = return $ toList $ decodeKey <$> Map.keys hm keys _ = throwStr "invalid call to keys" vals :: Fn vals [MalHashMap _ hm] = return $ toList $ Map.elems hm vals _ = throwStr "invalid call to vals" -- Sequence functions sequential_Q :: MalVal -> Bool sequential_Q (MalSeq _ _ _) = True sequential_Q _ = False cons :: Fn cons [x, Nil ] = return $ toList [x] cons [x, MalSeq _ _ lst] = return $ toList (x : lst) cons _ = throwStr "illegal call to cons" unwrapSeq :: MalVal -> IOThrows [MalVal] unwrapSeq (MalSeq _ _ xs) = return xs 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 x : _ -> return x [] -> throwStr "nth: index out of range" -- See https://wiki.haskell.org/Avoiding_partial_functions nth _ = throwStr "invalid call to nth" first :: Fn first [Nil ] = return Nil first [MalSeq _ _ [] ] = return Nil first [MalSeq _ _ (x : _)] = return x first _ = throwStr "illegal call to first" rest :: Fn rest [Nil ] = return $ toList [] rest [MalSeq _ _ [] ] = return $ toList [] rest [MalSeq _ _ (_ : xs)] = return $ toList xs rest _ = throwStr "illegal call to rest" empty_Q :: Fn empty_Q [Nil] = return $ MalBoolean True empty_Q [MalSeq _ _ xs] = return $ MalBoolean $ xs == [] empty_Q _ = throwStr "illegal call to empty?" count :: Fn count [Nil ] = return $ MalNumber 0 count [MalSeq _ _ lst] = return $ MalNumber $ length lst count _ = throwStr "non-sequence passed to count" concatLast :: [MalVal] -> IOThrows [MalVal] concatLast [MalSeq _ _ lst] = return lst concatLast (a : as) = (a :) <$> concatLast as concatLast _ = throwStr "last argument of apply must be a sequence" apply :: Fn apply (MalFunction _ f : xs) = f =<< concatLast xs apply (MalMacro f : xs) = f =<< concatLast xs apply _ = throwStr "Illegal call to apply" do_map :: Fn do_map [MalFunction _ f, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args do_map _ = throwStr "Illegal call to map" conj :: Fn conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst conj (MalSeq _ (Vect True) lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args conj _ = throwStr "illegal arguments to conj" do_seq :: Fn do_seq [Nil ] = return Nil do_seq [MalSeq _ _ [] ] = return Nil do_seq [MalSeq _ _ lst ] = return $ toList lst do_seq [MalString "" ] = return Nil do_seq [MalString s ] = return $ toList $ MalString <$> pure <$> s do_seq _ = throwStr "seq: called on non-sequence" -- Metadata functions with_meta :: Fn with_meta [MalSeq _ v x, m] = return $ MalSeq (MetaData m) v x with_meta [MalHashMap _ x, m] = return $ MalHashMap (MetaData m) x with_meta [MalAtom _ x, m] = return $ MalAtom (MetaData m) x with_meta [MalFunction _ f, m] = return $ MalFunction (MetaData m) f with_meta _ = throwStr "invalid with-meta call" do_meta :: Fn do_meta [MalSeq (MetaData m) _ _ ] = return m do_meta [MalHashMap (MetaData m) _] = return m do_meta [MalAtom (MetaData m) _ ] = return m do_meta [MalFunction (MetaData m) _] = return m do_meta _ = throwStr "invalid meta call" -- Atom functions atom :: Fn atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val) atom _ = throwStr "invalid atom call" deref :: Fn deref [MalAtom _ ref] = liftIO $ readIORef ref deref _ = throwStr "invalid deref call" reset_BANG :: Fn reset_BANG [MalAtom _ ref, val] = do liftIO $ writeIORef ref val return val reset_BANG _ = throwStr "invalid reset!" swap_BANG :: Fn swap_BANG (MalAtom _ ref : MalFunction _ f : args) = do val <- liftIO $ readIORef ref new_val <- f (val : args) liftIO $ writeIORef ref new_val return new_val swap_BANG _ = throwStr "Illegal swap!" ns :: [(String, Fn)] ns = [ ("=", equal_Q), ("throw", throw), (pred1 "nil?" nil_Q), (pred1 "true?" true_Q), (pred1 "false?" false_Q), (pred1 "string?" string_Q), ("symbol", symbol), (pred1 "symbol?" symbol_Q), ("keyword", keyword), (pred1 "keyword?" keyword_Q), (pred1 "number?" number_Q), (pred1 "fn?" fn_Q), (pred1 "macro?" macro_Q), ("pr-str", pr_str), ("str", str), ("prn", prn), ("println", println), ("readline", do_readline), ("read-string", read_string), ("slurp", slurp), num_op "<" (<) MalBoolean, num_op "<=" (<=) MalBoolean, num_op ">" (>) MalBoolean, num_op ">=" (>=) MalBoolean, num_op "+" (+) MalNumber, num_op "-" (-) MalNumber, num_op "*" (*) MalNumber, num_op "/" div MalNumber, ("time-ms", time_ms), ("list", list), (pred1 "list?" list_Q), ("vector", vector), (pred1 "vector?" vector_Q), ("hash-map", hash_map), (pred1 "map?" map_Q), ("assoc", assoc), ("dissoc", dissoc), ("get", get), ("contains?", contains_Q), ("keys", keys), ("vals", vals), (pred1 "sequential?" sequential_Q), ("cons", cons), ("concat", do_concat), ("vec", vec), ("nth", nth), ("first", first), ("rest", rest), ("empty?", empty_Q), ("count", count), ("apply", apply), ("map", do_map), ("conj", conj), ("seq", do_seq), ("with-meta", with_meta), ("meta", do_meta), ("atom", atom), (pred1 "atom?" atom_Q), ("deref", deref), ("reset!", reset_BANG), ("swap!", swap_BANG)] ================================================ FILE: impls/haskell/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install make python RUN apt-get install -y ghc libghc-readline-dev ================================================ FILE: impls/haskell/Env.hs ================================================ module Env ( Env, env_get, env_new, env_put, env_set ) where import Data.IORef (IORef, modifyIORef, newIORef, readIORef) import qualified Data.Map.Strict as Map import Printer (_pr_str) import Types data Env = Env (Maybe Env) (IORef (Map.Map String MalVal)) env_new :: Maybe Env -> IO Env env_new outer = Env outer <$> newIORef Map.empty env_get :: Env -> String -> IO (Maybe MalVal) env_get (Env maybeOuter ref) key = do m <- readIORef ref case Map.lookup key m of Nothing -> case maybeOuter of Nothing -> return Nothing Just outer -> env_get outer key justVal -> return justVal env_set :: Env -> String -> MalVal -> IO () env_set (Env _ ref) key value = modifyIORef ref $ Map.insert key value put1 :: (String, MalVal) -> IO () put1 (key, value) = do putChar ' ' putStr key putChar ':' putStr =<< _pr_str True value env_put :: Env -> IO () env_put (Env _ ref) = mapM_ put1 =<< Map.assocs <$> readIORef ref ================================================ FILE: impls/haskell/Makefile ================================================ BINS4 = step4_if_fn_do step5_tco step6_file step7_quote step8_macros \ step9_try stepA_mal BINS3 = step3_env $(BINS4) BINS1 = step1_read_print step2_eval $(BINS3) BINS = step0_repl $(BINS1) ghc_flags = -Wall -Wextra LDLIBS = -lreadline ##################### all: $(BINS) $(BINS): %: %.hs ghc ${ghc_flags} --make $< $(LDLIBS) -o $@ $(BINS1): Types.hs Reader.hs Printer.hs $(BINS3): Env.hs $(BINS4): Core.hs $(BINS): Readline.hs clean: rm -f $(BINS) *.hi *.o ================================================ FILE: impls/haskell/Printer.hs ================================================ module Printer ( _pr_str, _pr_list ) where import qualified Data.Map.Strict as Map import Data.IORef (readIORef) import Data.List (intercalate) import Types _pr_list :: Bool -> String -> [MalVal] -> IO String _pr_list pr sep = fmap (intercalate sep) . mapM (_pr_str pr) enclose :: String -> String -> String -> String enclose open close middle = open ++ middle ++ close escape :: Char -> String -> String escape '\n' acc = '\\' : 'n' : acc escape '\\' acc = '\\' : '\\' : acc escape '"' acc = '\\' : '"' : acc escape c acc = c : acc _pr_str :: Bool -> MalVal -> IO String _pr_str _ (MalKeyword kwd) = return $ ':' : kwd _pr_str True (MalString str) = return $ enclose "\"" "\"" $ foldr escape [] str _pr_str False (MalString str) = return str _pr_str _ (MalSymbol name) = return name _pr_str _ (MalNumber num) = return $ show num _pr_str _ (MalBoolean True) = return "true" _pr_str _ (MalBoolean False) = return "false" _pr_str _ Nil = return "nil" _pr_str pr (MalSeq _ (Vect False) xs) = enclose "(" ")" <$> _pr_list pr " " xs _pr_str pr (MalSeq _ (Vect True) xs) = enclose "[" "]" <$> _pr_list pr " " xs _pr_str pr (MalHashMap _ m) = enclose "{" "}" <$> _pr_list pr " " (Map.foldMapWithKey (\k v -> [decodeKey k, v]) m) _pr_str pr (MalAtom _ r) = enclose "(atom " ")" <$> (_pr_str pr =<< readIORef r) _pr_str _ (MalFunction _ _) = return "" _pr_str _ (MalMacro _) = return "" ================================================ FILE: impls/haskell/Reader.hs ================================================ module Reader ( read_str ) where import qualified Data.Map.Strict as Map import Text.ParserCombinators.Parsec ( Parser, parse, char, digit, anyChar, (<|>), oneOf, noneOf, many, many1) import Types ---------------------------------------------------------------------- -- A MAL grammar and a possible parsing are described here. -- If you are only interested in the grammar, please ignore the -- left-hand side of <$> and =<< operators (second column). -- *> <* <*> all mean concatenation -- <|> means alternative -- many p = (many1 p) | empty means p*, zero or more p -- many1 p = p (many p) means p+, one or more p -- For efficiency, the alternative operator <|> expects each branch -- to either: -- * succeed, -- * fall after looking at the next character without consuming it, -- * or consume some input and fail, indicating that the input is -- incorrect and no remaining branches should be ignored. allowedChar :: Parser Char allowedChar = noneOf "\n\r \"(),;[\\]{}" sep :: Parser String sep = many (oneOf ", \n" <|> char ';' <* many (noneOf "\n")) stringChar :: Parser Char stringChar = unescapeChar <$> (char '\\' *> anyChar) <|> noneOf "\"" afterMinus :: Parser MalVal afterMinus = negative <$> many1 digit <|> hyphenSymbol <$> many allowedChar afterTilde :: Parser MalVal afterTilde = spliceUnquote <$> (char '@' *> sep *> form) <|> unquote <$> (sep *> form) form :: Parser MalVal form = MalString <$> (char '"' *> many stringChar <* char '"') <|> MalKeyword <$> (char ':' *> many1 allowedChar) <|> char '-' *> afterMinus <|> toList <$> (char '(' *> sep *> many (form <* sep) <* char ')') <|> vector <$> (char '[' *> sep *> many (form <* sep) <* char ']') <|> (toMap =<< char '{' *> sep *> many (form <* sep) <* char '}') <|> quote <$> (char '\'' *> sep *> form) <|> quasiquote <$> (char '`' *> sep *> form) <|> deref <$> (char '@' *> sep *> form) <|> char '~' *> afterTilde <|> withMeta <$> (char '^' *> sep *> form <* sep) <*> form <|> positive <$> many1 digit <|> symbol <$> many1 allowedChar read_form :: Parser MalVal read_form = sep *> form ---------------------------------------------------------------------- -- Part specific to Haskell addPrefix :: String -> MalVal -> MalVal addPrefix s x = toList [MalSymbol s, x] deref :: MalVal -> MalVal deref = addPrefix "deref" hyphenSymbol :: String -> MalVal hyphenSymbol = MalSymbol . (:) '-' negative :: String -> MalVal negative = MalNumber . negate . read positive :: String -> MalVal positive = MalNumber . read quasiquote :: MalVal -> MalVal quasiquote = addPrefix "quasiquote" quote :: MalVal -> MalVal quote = addPrefix "quote" spliceUnquote :: MalVal -> MalVal spliceUnquote = addPrefix "splice-unquote" toMap :: [MalVal] -> Parser MalVal toMap kvs = case kv2map Map.empty kvs of Just m -> return m Nothing -> fail "invalid contents in map braces" unquote :: MalVal -> MalVal unquote = addPrefix "unquote" symbol :: String -> MalVal symbol "true" = MalBoolean True symbol "false" = MalBoolean False symbol "nil" = Nil symbol s = MalSymbol s unescapeChar :: Char -> Char unescapeChar 'n' = '\n' unescapeChar c = c vector :: [MalVal] -> MalVal vector = MalSeq (MetaData Nil) (Vect True) withMeta :: MalVal -> MalVal -> MalVal withMeta m d = toList [MalSymbol "with-meta", d, m] -- The only exported function read_str :: String -> IOThrows MalVal read_str str = case parse read_form "Mal" str of Left err -> throwStr $ show err Right val -> return val ================================================ FILE: impls/haskell/Readline.hs ================================================ module Readline ( addHistory, readline, load_history ) where -- Pick one of these: -- GPL license import qualified System.Console.Readline as RL -- BSD license --import qualified System.Console.Editline.Readline as RL import Control.Monad (when) import System.Directory (getHomeDirectory, doesFileExist) import System.IO (hFlush, stdout) import System.IO.Error (tryIOError) history_file :: IO String history_file = do home <- getHomeDirectory return $ home ++ "/.mal-history" load_history :: IO () load_history = do hfile <- history_file fileExists <- doesFileExist hfile when fileExists $ do content <- readFile hfile mapM_ RL.addHistory (lines content) readline :: String -> IO (Maybe String) readline prompt = do hFlush stdout RL.readline prompt addHistory :: String -> IO () addHistory line = do hfile <- history_file _ <- tryIOError (appendFile hfile (line ++ "\n")) RL.addHistory line ================================================ FILE: impls/haskell/Types.hs ================================================ module Types ( MalVal (..), IOThrows, Fn, MetaData (..), Vect (..), decodeKey, encodeKey, kv2map, throwStr, toList) where import Data.IORef (IORef) import qualified Data.Map.Strict as Map -- The documentation recommends strict except in specific cases. import Control.Monad.Except (ExceptT, throwError) -- Base Mal types -- type Fn = [MalVal] -> IOThrows MalVal -- Use type safety for unnamed components, without runtime penalty. newtype MetaData = MetaData MalVal newtype Vect = Vect Bool data MalVal = Nil | MalBoolean Bool | MalNumber Int | MalString String | MalSymbol String | MalKeyword String | MalSeq MetaData Vect [MalVal] | MalHashMap MetaData (Map.Map MapKey MalVal) | MalAtom MetaData (IORef MalVal) | MalFunction MetaData Fn | MalMacro Fn -- Stored into maps to distinguish keywords and symbols. -- MapKey is not exported, other modules use encodeKey or kv2map. data MapKey = MapKeyKeyword String | MapKeyString String instance Eq MapKey where MapKeyString a == MapKeyString b = a == b MapKeyKeyword a == MapKeyKeyword b = a == b _ == _ = False instance Ord MapKey where compare (MapKeyString a) (MapKeyString b) = compare a b compare (MapKeyKeyword a) (MapKeyKeyword b) = compare a b compare (MapKeyKeyword _) (MapKeyString _) = LT compare (MapKeyString _) (MapKeyKeyword _) = GT encodeKey :: MalVal -> IOThrows MapKey encodeKey (MalString key) = pure $ MapKeyString key encodeKey (MalKeyword key) = pure $ MapKeyKeyword key encodeKey _ = throwStr "map keys must be keywords or strings" decodeKey :: MapKey -> MalVal decodeKey (MapKeyString k) = MalString k decodeKey (MapKeyKeyword k) = MalKeyword k instance Eq MalVal where Nil == Nil = True (MalBoolean a) == (MalBoolean b) = a == b (MalNumber a) == (MalNumber b) = a == b (MalString a) == (MalString b) = a == b (MalKeyword a) == (MalKeyword b) = a == b (MalSymbol a) == (MalSymbol b) = a == b (MalSeq _ _ a) == (MalSeq _ _ b) = a == b (MalHashMap _ a) == (MalHashMap _ b) = a == b (MalAtom _ a) == (MalAtom _ b) = a == b _ == _ = False --- Errors/Exceptions --- type IOThrows = ExceptT MalVal IO throwStr :: String -> IOThrows a throwStr = throwError . MalString -- Convenient shortcuts for common situations. toList :: [MalVal] -> MalVal toList = MalSeq (MetaData Nil) (Vect False) -- Use Maybe because Core throws while Reader fails. kv2map :: Map.Map MapKey MalVal -> [MalVal] -> Maybe MalVal kv2map start forms = MalHashMap (MetaData Nil) <$> assoc1 start forms where assoc1 :: Map.Map MapKey MalVal -> [MalVal] -> Maybe (Map.Map MapKey MalVal) assoc1 acc (MalKeyword s : v : kvs) = assoc1 (Map.insert (MapKeyKeyword s) v acc) kvs assoc1 acc (MalString s : v : kvs) = assoc1 (Map.insert (MapKeyString s) v acc) kvs assoc1 acc [] = Just acc assoc1 _ _ = Nothing ================================================ FILE: impls/haskell/run ================================================ #!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/haskell/step0_repl.hs ================================================ import Readline (addHistory, readline, load_history) type MalVal = String -- read mal_read :: String -> MalVal mal_read = id -- eval eval :: MalVal -> MalVal eval = id -- print mal_print :: MalVal -> String mal_print = id -- repl repl_loop :: IO () repl_loop = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop Just str -> do addHistory str let out = mal_print $ eval $ mal_read str putStrLn out repl_loop main :: IO () main = do load_history repl_loop ================================================ FILE: impls/haskell/step1_read_print.hs ================================================ import Control.Monad.Except (runExceptT) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer (_pr_str) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval eval :: MalVal -> MalVal eval = id -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: IO () repl_loop = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop Just str -> do addHistory str res <- runExceptT $ eval <$> mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop main :: IO () main = do load_history repl_loop ================================================ FILE: impls/haskell/step2_eval.hs ================================================ import Control.Monad.Except (liftIO, runExceptT) import qualified Data.Map.Strict as Map import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) type Env = Map.Map String MalVal -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do -- putStr "EVAL: " -- putStrLn =<< mal_print ast case ast of MalSymbol sym -> do let maybeVal = Map.lookup sym env case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl add :: Fn add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b add _ = throwStr $ "illegal arguments to +" sub :: Fn sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b sub _ = throwStr $ "illegal arguments to -" mult :: Fn mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b mult _ = throwStr $ "illegal arguments to *" divd :: Fn divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b divd _ = throwStr $ "illegal arguments to /" repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env main :: IO () main = do let repl_env = Map.fromList [("+", MalFunction (MetaData Nil) add), ("-", MalFunction (MetaData Nil) sub), ("*", MalFunction (MetaData Nil) mult), ("/", MalFunction (MetaData Nil) divd)] load_history repl_loop repl_env ================================================ FILE: impls/haskell/step3_env.hs ================================================ import Control.Monad.Except (liftIO, runExceptT) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer (_pr_list, _pr_str) import Env -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl add :: Fn add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b add _ = throwStr $ "illegal arguments to +" sub :: Fn sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b sub _ = throwStr $ "illegal arguments to -" mult :: Fn mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b mult _ = throwStr $ "illegal arguments to *" divd :: Fn divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b divd _ = throwStr $ "illegal arguments to /" repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env defBuiltIn :: Env -> String -> Fn -> IO () defBuiltIn env sym f = env_set env sym $ MalFunction (MetaData Nil) f main :: IO () main = do repl_env <- env_new Nothing defBuiltIn repl_env "+" add defBuiltIn repl_env "-" sub defBuiltIn repl_env "*" mult defBuiltIn repl_env "/" divd load_history repl_loop repl_env ================================================ FILE: impls/haskell/step4_if_fn_do.hs ================================================ import Control.Monad.Except (liftIO, runExceptT) import Data.Foldable (foldlM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f main :: IO () main = do repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" load_history repl_loop repl_env ================================================ FILE: impls/haskell/step5_tco.hs ================================================ import Control.Monad.Except (liftIO, runExceptT) import Data.Foldable (foldlM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f main :: IO () main = do repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" load_history repl_loop repl_env ================================================ FILE: impls/haskell/step6_file.hs ================================================ import System.Environment (getArgs) import Control.Monad.Except (liftIO, runExceptT) import Data.Foldable (foldlM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f evalFn :: Env -> Fn evalFn env [ast] = eval env ast evalFn _ _ = throwStr "illegal call of eval" main :: IO () main = do args <- getArgs repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns defBuiltIn repl_env ("eval", evalFn repl_env) -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" case args of script : scriptArgs -> do env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs re repl_env $ "(load-file \"" ++ script ++ "\")" [] -> do env_set repl_env "*ARGV*" $ toList [] load_history repl_loop repl_env ================================================ FILE: impls/haskell/step7_quote.hs ================================================ import System.Environment (getArgs) import Control.Monad.Except (liftIO, runExceptT) import Data.Foldable (foldlM, foldrM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval 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 -> 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 let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 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 = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f evalFn :: Env -> Fn evalFn env [ast] = eval env ast evalFn _ _ = throwStr "illegal call of eval" main :: IO () main = do args <- getArgs repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns defBuiltIn repl_env ("eval", evalFn repl_env) -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" case args of script : scriptArgs -> do env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs re repl_env $ "(load-file \"" ++ script ++ "\")" [] -> do env_set repl_env "*ARGV*" $ toList [] load_history repl_loop repl_env ================================================ FILE: impls/haskell/step8_macros.hs ================================================ import System.Environment (getArgs) import Control.Monad.Except (liftIO, runExceptT) import Data.Foldable (foldlM, foldrM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval 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 -> 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 let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 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 = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do func <- eval env a2 case func of MalFunction _ f -> do let m = MalMacro f liftIO $ env_set env a1 m return m _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest MalMacro m -> eval env =<< m rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f evalFn :: Env -> Fn evalFn env [ast] = eval env ast evalFn _ _ = throwStr "illegal call of eval" main :: IO () main = do args <- getArgs repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns defBuiltIn repl_env ("eval", evalFn repl_env) -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" re repl_env "(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)))))))" case args of script : scriptArgs -> do env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs re repl_env $ "(load-file \"" ++ script ++ "\")" [] -> do env_set repl_env "*ARGV*" $ toList [] load_history repl_loop repl_env ================================================ FILE: impls/haskell/step9_try.hs ================================================ import System.Environment (getArgs) import Control.Monad.Except (catchError, liftIO, runExceptT) import Data.Foldable (foldlM, foldrM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval 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 -> 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 let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 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 = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do func <- eval env a2 case func of MalFunction _ f -> do let m = MalMacro f liftIO $ env_set env a1 m return m _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = catchError (eval env a1) $ \exc -> do try_env <- liftIO $ env_new $ Just env liftIO $ env_set try_env a21 exc eval try_env a22 apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest MalMacro m -> eval env =<< m rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f evalFn :: Env -> Fn evalFn env [ast] = eval env ast evalFn _ _ = throwStr "illegal call of eval" main :: IO () main = do args <- getArgs repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns defBuiltIn repl_env ("eval", evalFn repl_env) -- core.mal: defined using the language itself re repl_env "(def! not (fn* (a) (if a false true)))" re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" re repl_env "(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)))))))" case args of script : scriptArgs -> do env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs re repl_env $ "(load-file \"" ++ script ++ "\")" [] -> do env_set repl_env "*ARGV*" $ toList [] load_history repl_loop repl_env ================================================ FILE: impls/haskell/stepA_mal.hs ================================================ import System.Environment (getArgs) import Control.Monad.Except (catchError, liftIO, runExceptT) import Data.Foldable (foldlM, foldrM) import Readline (addHistory, readline, load_history) import Types import Reader (read_str) import Printer(_pr_list, _pr_str) import Env import Core (ns) -- read mal_read :: String -> IOThrows MalVal mal_read = read_str -- eval 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 -> 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 let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do liftIO . env_set env b =<< eval env e let_bind env xs let_bind _ _ = throwStr "invalid let*" apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do evd <- eval env a2 liftIO $ env_set env a1 evd return evd apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!" apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do let_env <- liftIO $ env_new $ Just env let_bind let_env params eval let_env a2 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 = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do func <- eval env a2 case func of MalFunction _ f -> do let m = MalMacro f liftIO $ env_set env a1 m return m _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = catchError (eval env a1) $ \exc -> do try_env <- liftIO $ env_new $ Just env liftIO $ env_set try_env a21 exc eval try_env a22 apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*" apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do cond <- eval env a1 eval env $ case cond of Nil -> a3 MalBoolean False -> a3 _ -> a2 apply_ast (MalSymbol "if") [a1, a2] env = do cond <- eval env a1 case cond of Nil -> return Nil MalBoolean False -> return Nil _ -> eval env a2 apply_ast (MalSymbol "if") _ _ = throwStr "invalid if" apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where fn :: [MalVal] -> IOThrows MalVal fn args = do fn_env <- liftIO $ env_new $ Just env let loop [] [] = eval fn_env ast loop [MalSymbol "&", k] vs = loop [k] [toList vs] loop (MalSymbol k : ks) (v : vs) = do liftIO $ env_set fn_env k v loop ks vs loop _ _ = do p <- liftIO $ _pr_list True " " params a <- liftIO $ _pr_list True " " args throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p loop params args apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*" apply_ast first rest env = do evd <- eval env first case evd of MalFunction _ f -> f =<< mapM (eval env) rest MalMacro m -> eval env =<< m rest _ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest) eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of Nothing -> pure () Just Nil -> pure () Just (MalBoolean False) -> pure () Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym case maybeVal of Nothing -> throwStr $ "'" ++ sym ++ "' not found" Just val -> return val MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs _ -> return ast -- print mal_print :: MalVal -> IO String mal_print = _pr_str True -- repl repl_loop :: Env -> IO () repl_loop env = do line <- readline "user> " case line of Nothing -> return () Just "" -> repl_loop env Just str -> do addHistory str res <- runExceptT $ eval env =<< mal_read str out <- case res of Left mv -> (++) "Error: " <$> mal_print mv Right val -> mal_print val putStrLn out repl_loop env -- Read and evaluate a line. Ignore successful results, else print -- an error message case of error. -- The error function seems appropriate, but has no effect. re :: Env -> String -> IO () re repl_env line = do res <- runExceptT $ eval repl_env =<< mal_read line case res of Left mv -> putStrLn . (++) "Startup failed: " =<< _pr_str True mv Right _ -> return () defBuiltIn :: Env -> (String, Fn) -> IO () defBuiltIn env (sym, f) = env_set env sym $ MalFunction (MetaData Nil) f evalFn :: Env -> Fn evalFn env [ast] = eval env ast evalFn _ _ = throwStr "illegal call of eval" main :: IO () main = do args <- getArgs repl_env <- env_new Nothing -- core.hs: defined using Haskell mapM_ (defBuiltIn repl_env) Core.ns defBuiltIn repl_env ("eval", evalFn repl_env) -- core.mal: defined using the language itself re repl_env "(def! *host-language* \"haskell\")" re repl_env "(def! not (fn* (a) (if a false true)))" re repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" re repl_env "(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)))))))" case args of script : scriptArgs -> do env_set repl_env "*ARGV*" $ toList $ MalString <$> scriptArgs re repl_env $ "(load-file \"" ++ script ++ "\")" [] -> do env_set repl_env "*ARGV*" $ toList [] re repl_env "(println (str \"Mal [\" *host-language* \"]\"))" load_history repl_loop repl_env ================================================ FILE: impls/haskell/tests/step5_tco.mal ================================================ ;; Haskell: skipping non-TCO recursion ;; Reason: completes up to 100,000, stackoverflow at 1,000,000 ================================================ FILE: impls/haxe/Compat.hx ================================================ #if js @:native("console") extern class Console { public static function log(s:Dynamic):Void; } @:native("process") extern class Process { public static var argv(default,null):Array; public static function exit(code:Int):Void; } @:jsRequire("fs") extern class FS { static function readFileSync(filename:String, options:{encoding:String}):String; } @:jsRequire("./node_readline") extern class RL { static function readline(prompt:String):Null; } #end class Compat { public static function println(s:String) { #if js Console.log(s); #else Sys.println(s); #end } public static function slurp(filename:String) { #if js return FS.readFileSync(filename, {encoding: "utf-8"}); #else return sys.io.File.getContent(filename); #end } public static function exit(code:Int) { #if js Process.exit(0); #else Sys.exit(0); #end } public static function cmdline_args() { #if js return Process.argv.slice(2); #else return Sys.args(); #end } public static function readline(prompt:String) { #if js var line = RL.readline(prompt); if (line == null) { throw new haxe.io.Eof(); } #else Sys.print(prompt); var line = Sys.stdin().readLine(); #end return line; } } ================================================ FILE: impls/haxe/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Haxe RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm RUN DEBIAN_FRONTEND=noninteractive apt-get -y install haxe ENV NPM_CONFIG_CACHE /mal/.npm ENV HOME / RUN mkdir /haxelib && haxelib setup /haxelib # Install support for C++ compilation RUN haxelib install hxcpp ================================================ FILE: impls/haxe/Makefile ================================================ STEP1_DEPS = Compat.hx types/Types.hx reader/Reader.hx printer/Printer.hx STEP3_DEPS = $(STEP1_DEPS) env/Env.hx STEP4_DEPS = $(STEP3_DEPS) core/Core.hx STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal haxe_MODE ?= neko dist_neko = mal.n dist_python = mal.py dist_cpp = cpp/mal all: all-$(haxe_MODE) all-neko: $(foreach x,$(STEPS),$(x).n) all-python: $(foreach x,$(STEPS),$(x).py) all-cpp: $(foreach x,$(STEPS),cpp/$(x)) all-js: $(foreach x,$(STEPS),$(x).js) dist: mal.n mal.py cpp/mal mal.js mal mal.n: stepA_mal.n cp $< $@ mal.py: stepA_mal.py cp $< $@ cpp/mal: cpp/stepA_mal cp $< $@ mal.js: stepA_mal.js cp $< $@ mal: $(dist_$(haxe_MODE)) $(if $(filter cpp,$(haxe_MODE)),\ cp $< $@;,\ $(if $(filter neko,$(haxe_MODE)),\ nekotools boot $<;,\ $(if $(filter js,$(haxe_MODE)),\ echo "#!/usr/bin/env node" > $@;\ cat $< >> $@;,\ $(if $(filter python,$(haxe_MODE)),\ echo "#!/usr/bin/env python3" > $@;\ cat $< >> $@;,\ $(error Invalid haxe_MODE: $(haxe_MODE)))))) chmod +x $@ # Neko target (neko) s%.n: S%.hx haxe -main $(patsubst %.hx,%,$<) -neko $@ step1_read_print.n step2_eval.n: $(STEP1_DEPS) step3_env.n: $(STEP3_DEPS) step4_if_fn_do.n step5_tco.n step6_file.n step7_quote.n step8_macros.n step9_try.n stepA_mal.n: $(STEP4_DEPS) # Python 3 target (python) s%.py: S%.hx haxe -main $(patsubst %.hx,%,$<) -python $@ step1_read_print.py step2_eval.py: $(STEP1_DEPS) step3_env.py: $(STEP3_DEPS) step4_if_fn_do.py step5_tco.py step6_file.py step7_quote.py step8_macros.py step9_try.py stepA_mal.py: $(STEP4_DEPS) # C++ target (cpp) cpp/s%: S%.hx haxe -main $(patsubst %.hx,%,$<) -cpp cpp cp $(patsubst cpp/s%,cpp/S%,$@) $@ cpp/step1_read_print cpp/step2_eval: $(STEP1_DEPS) cpp/step3_env: $(STEP3_DEPS) cpp/step4_if_fn_do cpp/step5_tco cpp/step6_file cpp/step7_quote cpp/step8_macros cpp/step9_try cpp/stepA_mal: $(STEP4_DEPS) # JavaScript target (js) s%.js: S%.hx haxe -main $(patsubst %.hx,%,$<) -js $@ JS_DEPS = node_readline.js node_modules step0_repl.js: $(JS_DEPS) step1_read_print.js step2_eval.js: $(STEP1_DEPS) $(JS_DEPS) step3_env.js: $(STEP3_DEPS) $(JS_DEPS) step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js step8_macros.js step9_try.js stepA_mal.js: $(STEP4_DEPS) $(JS_DEPS) node_modules: npm install ### clean: rm -f mal.n mal.py cpp/mal mal.js mal rm -f step*.py step*.js step*.n [ -e cpp/ ] && rm -r cpp/ || true ================================================ FILE: impls/haxe/Step0_repl.hx ================================================ import Compat; class Step0_repl { // READ static function READ(str:String) { return str; } // EVAL static function EVAL(ast:String, env:String) { return ast; } // PRINT static function PRINT(exp:String) { return exp; } // repl static function rep(line:String) { return PRINT(EVAL(READ(line), "")); } public static function main() { while (true) { try { var line = Compat.readline("user> "); Compat.println(rep(line)); } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { Compat.println("Error: " + exc); } } } } ================================================ FILE: impls/haxe/Step1_read_print.hx ================================================ import Compat; import types.Types.MalType; import reader.*; import printer.*; class Step1_read_print { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:String) { return ast; } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static function rep(line:String) { return PRINT(EVAL(READ(line), "")); } public static function main() { while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { Compat.println("Error: " + exc); } } } } ================================================ FILE: impls/haxe/Step2_eval.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import reader.*; import printer.*; class Step2_eval { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:Map) { // Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): if (env.exists(s)) { return env.get(s); } else { throw "'" + s + "' not found"; } case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch ( EVAL(alst[0], env)) { case MalFunc(f,_,_,_,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); return f(args); case _: throw "Call of non-function"; } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static function NumOp(op):MalType { return MalFunc(function(args:Array) { return switch (args) { case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); case _: throw "Invalid numeric op call"; } },null,null,null,false,nil); } static var repl_env:Map = ["+" => NumOp(function(a,b) {return a+b;}), "-" => NumOp(function(a,b) {return a-b;}), "*" => NumOp(function(a,b) {return a*b;}), "/" => NumOp(function(a,b) {return Std.int(a/b);})]; static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { Compat.println("Error: " + exc); } } } } ================================================ FILE: impls/haxe/Step3_env.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import reader.*; import printer.*; import env.*; class Step3_env { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:Env):MalType { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } return EVAL(alst[2], let_env); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,_,_,_,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); return f(args); case _: throw "Call of non-function"; } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static function NumOp(op):MalType { return MalFunc(function(args:Array) { return switch (args) { case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); case _: throw "Invalid numeric op call"; } },null,null,null,false,nil); } static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { repl_env.set(MalSymbol("+"), NumOp(function(a,b) {return a+b;})); repl_env.set(MalSymbol("-"), NumOp(function(a,b) {return a-b;})); repl_env.set(MalSymbol("*"), NumOp(function(a,b) {return a*b;})); repl_env.set(MalSymbol("/"), NumOp(function(a,b) {return Std.int(a/b);})); while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { Compat.println("Error: " + exc); } } } } ================================================ FILE: impls/haxe/Step4_if_fn_do.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; class Step4_if_fn_do { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:Env):MalType { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } return EVAL(alst[2], let_env); case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); return EVAL(alst[alst.length-1], env); case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { return EVAL(alst[2], env); } else if (alst.length > 3) { return EVAL(alst[3], env); } else { return MalNil; } case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },null,null,null,false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,_,_,_,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); return f(args); case _: throw "Call of non-function"; } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/Step5_tco.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; class Step5_tco { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/Step6_file.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; class Step6_file { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } var evalfn = MalFunc(function(args) { return EVAL(args[0], repl_env); },null,null,null,false,nil); repl_env.set(MalSymbol("eval"), evalfn); var cmdargs = Compat.cmdline_args(); var argarray = cmdargs.map(function(a) { return MalString(a); }); repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); Compat.exit(0); } while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/Step7_quote.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; class Step7_quote { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL 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) { 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; } } static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("quote"): return alst[1]; case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,_,_): var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } var evalfn = MalFunc(function(args) { return EVAL(args[0], repl_env); },null,null,null,false,nil); repl_env.set(MalSymbol("eval"), evalfn); var cmdargs = Compat.cmdline_args(); var argarray = cmdargs.map(function(a) { return MalString(a); }); repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); Compat.exit(0); } while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/Step8_macros.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; class Step8_macros { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL 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) { 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; } } static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("quote"): return alst[1]; case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO case MalSymbol("defmacro!"): var func = EVAL(alst[2], env); return switch (func) { case MalFunc(f,ast,e,params,_,_): env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); case _: throw "Invalid defmacro! call"; } case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,ismacro,_): if (ismacro) { ast = f(alst.slice(1)); continue; // TCO } var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } var evalfn = MalFunc(function(args) { return EVAL(args[0], repl_env); },null,null,null,false,nil); repl_env.set(MalSymbol("eval"), evalfn); var cmdargs = Compat.cmdline_args(); var argarray = cmdargs.map(function(a) { return MalString(a); }); repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); Compat.exit(0); } while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/Step9_try.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; import haxe.rtti.Meta; class Step9_try { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL 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) { 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; } } static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("quote"): return alst[1]; case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO case MalSymbol("defmacro!"): var func = EVAL(alst[2], env); return switch (func) { case MalFunc(f,ast,e,params,_,_): env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); case _: throw "Invalid defmacro! call"; } case MalSymbol("try*"): try { return EVAL(alst[1], env); } catch (err:Dynamic) { if (alst.length > 2) { switch (alst[2]) { case MalList([MalSymbol("catch*"), a21, a22]): var exc; if (Type.getClass(err) == MalException) { exc = err.obj; } else { exc = MalString(Std.string(err)); }; return EVAL(a22, new Env(env, [a21], [exc])); case _: throw err; } } else { throw err; } } case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,ismacro,_): if (ismacro) { ast = f(alst.slice(1)); continue; // TCO } var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } var evalfn = MalFunc(function(args) { return EVAL(args[0], repl_env); },null,null,null,false,nil); repl_env.set(MalSymbol("eval"), evalfn); var cmdargs = Compat.cmdline_args(); var argarray = cmdargs.map(function(a) { return MalString(a); }); repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); Compat.exit(0); } while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/StepA_mal.hx ================================================ import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import reader.*; import printer.*; import env.*; import core.*; import haxe.rtti.Meta; class StepA_mal { // READ static function READ(str:String):MalType { return Reader.read_str(str); } // EVAL 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) { 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; } } static function EVAL(ast:MalType, env:Env):MalType { while (true) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != MalFalse && dbgeval != MalNil) Compat.println("EVAL: " + PRINT(ast)); var alst; switch (ast) { case MalSymbol(s): var res = env.get(s); if (res == null) throw "'" + s + "' not found"; return res; case MalList(l): alst = l; case MalVector(l): return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } return MalHashMap(new_map); case _: return ast; } // apply if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): return env.set(alst[1], EVAL(alst[2], env)); case MalSymbol("let*"): var let_env = new Env(env); switch (alst[1]) { case MalList(l) | MalVector(l): for (i in 0...l.length) { if ((i%2) > 0) { continue; } let_env.set(l[i], EVAL(l[i+1], let_env)); } case _: throw "Invalid let*"; } ast = alst[2]; env = let_env; continue; // TCO case MalSymbol("quote"): return alst[1]; case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO case MalSymbol("defmacro!"): var func = EVAL(alst[2], env); return switch (func) { case MalFunc(f,ast,e,params,_,_): env.set(alst[1], MalFunc(f,ast,e,params,true,nil)); case _: throw "Invalid defmacro! call"; } case MalSymbol("try*"): try { return EVAL(alst[1], env); } catch (err:Dynamic) { if (alst.length > 2) { switch (alst[2]) { case MalList([MalSymbol("catch*"), a21, a22]): var exc; if (Type.getClass(err) == MalException) { exc = err.obj; } else { exc = MalString(Std.string(err)); }; return EVAL(a22, new Env(env, [a21], [exc])); case _: throw err; } } else { throw err; } } case MalSymbol("do"): for (i in 1...alst.length-1) EVAL(alst[i], env); ast = alst[alst.length-1]; continue; // TCO case MalSymbol("if"): var cond = EVAL(alst[1], env); if (cond != MalFalse && cond != MalNil) { ast = alst[2]; } else if (alst.length > 3) { ast = alst[3]; } else { return MalNil; } continue; // TCO case MalSymbol("fn*"): return MalFunc(function (args) { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: switch ( EVAL(alst[0], env)) { case MalFunc(f,a,e,params,ismacro,_): if (ismacro) { ast = f(alst.slice(1)); continue; // TCO } var args = alst.slice(1).map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); continue; // TCO } else { return f(args); } case _: throw "Call of non-function"; } } } } // PRINT static function PRINT(exp:MalType):String { return Printer.pr_str(exp, true); } // repl static var repl_env = new Env(null); static function rep(line:String):String { return PRINT(EVAL(READ(line), repl_env)); } public static function main() { // core.EXT: defined using Haxe for (k in Core.ns.keys()) { repl_env.set(MalSymbol(k), MalFunc(Core.ns[k],null,null,null,false,nil)); } var evalfn = MalFunc(function(args) { return EVAL(args[0], repl_env); },null,null,null,false,nil); repl_env.set(MalSymbol("eval"), evalfn); var cmdargs = Compat.cmdline_args(); var argarray = cmdargs.map(function(a) { return MalString(a); }); repl_env.set(MalSymbol("*ARGV*"), MalList(argarray.slice(1))); // core.mal: defined using the language itself rep("(def! *host-language* \"haxe\")"); rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (cmdargs.length > 0) { rep('(load-file "${cmdargs[0]}")'); Compat.exit(0); } rep("(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { try { var line = Compat.readline("user> "); if (line == "") { continue; } Compat.println(rep(line)); } catch (exc:BlankLine) { continue; } catch (exc:haxe.io.Eof) { Compat.exit(0); } catch (exc:Dynamic) { if (Type.getClass(exc) == MalException) { Compat.println("Error: " + Printer.pr_str(exc.obj, true)); } else { Compat.println("Error: " + exc); }; } } } } ================================================ FILE: impls/haxe/core/Core.hx ================================================ package core; import Compat; import types.Types.MalType; import types.Types.*; import types.MalException; import printer.Printer; import reader.Reader; import haxe.Timer; class Core { static function BoolFn(v) { if (v) { return MalTrue; } else { return MalFalse; } } static function BoolOp(op) { return function(args:Array) { return switch (args) { case [MalInt(a), MalInt(b)]: BoolFn(op(a,b)); case _: throw "Invalid boolean op call"; } }; } static function NumOp(op) { return function(args:Array) { return switch (args) { case [MalInt(a), MalInt(b)]: MalInt(op(a,b)); case _: throw "Invalid numeric op call"; } }; } static var start = Timer.stamp(); static function time_ms(args) { return MalInt(Std.int(1000 * (Timer.stamp()-start))); } static function equal_Q(args) { return BoolFn(_equal_Q(args[0],args[1])); } static function pr_str(args) { return MalString( args.map(function(s) { return Printer.pr_str(s,true); }).join(" ") ); } static function str(args) { return MalString( args.map(function(s) { return Printer.pr_str(s,false); }).join("") ); } static function prn(args) { Compat.println(args.map(function(s) { return Printer.pr_str(s,true); }).join(" ")); return nil; } static function println(args) { Compat.println(args.map(function(s) { return Printer.pr_str(s,false); }).join(" ")); return nil; } static function symbol(args) { return switch (args[0]) { case MalString(s): MalSymbol(s); case MalSymbol(_): args[0]; case _: throw "Invalid symbol call"; } } static function keyword(args) { return switch (args[0]) { case MalString(s): if (keyword_Q(args[0])) { args[0]; } else { MalString("\x7f" + s); } case _: throw "Invalid keyword call"; } } static function read_string(args) { return switch (args[0]) { case MalString(s): Reader.read_str(s); case _: throw "invalid read_str call"; } } static function readline(args) { return switch (args[0]) { case MalString(prompt): try { MalString(Compat.readline(prompt)); } catch (exc:haxe.io.Eof) { nil; } case _: throw "invalid readline call"; } } static function slurp(args) { return switch (args[0]) { case MalString(s): MalString(Compat.slurp(s)); case _: throw "invalid slurp call"; } } // sequential functions static function sequential_Q(args) { return BoolFn(list_Q(args[0]) || vector_Q(args[0])); } static function cons(args) { return switch [args[0], args[1]] { case [a, MalList(l)] | [a, MalVector(l)]: MalList([a].concat(l)); case [a, MalNil]: MalList([a]); case _: throw "Invalid cons call"; } } static function do_concat(args:Array) { var res:Array = []; for (a in args) { switch (a) { case MalList(l) | MalVector(l): res = res.concat(l); case MalNil: continue; case _: throw "concat called with non-sequence"; } } 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)]: _nth(seq, idx); case _: throw "Invalid nth call"; } } static function empty_Q(args) { return switch (args[0]) { case MalList(l) | MalVector(l): if (l.length == 0) { MalTrue; } else { MalFalse; } case MalNil: MalTrue; case _: MalFalse; } } static function count(args) { return switch (args[0]) { case MalList(l) | MalVector(l): MalInt(l.length); case MalNil: MalInt(0); case _: throw "count called on non-sequence"; } } static function apply(args) { return switch [args[0], args[args.length-1]] { case [MalFunc(f,_,_,_,_), MalList(l)] | [MalFunc(f,_,_,_,_), MalVector(l)]: var fargs = args.slice(1,args.length-1).concat(l); return f(fargs); case _: throw "Invalid apply call"; } } static function do_map(args) { return switch [args[0], args[1]] { case [MalFunc(f,_,_,_,_), MalList(l)] | [MalFunc(f,_,_,_,_), MalVector(l)]: return MalList(l.map(function(x) { return f([x]); })); case _: throw "Invalid map call"; } } static function conj(args) { return switch (args[0]) { case MalList(l): var elems = args.slice(1); elems.reverse(); MalList(elems.concat(l)); case MalVector(l): MalVector(l.concat(args.slice(1))); case _: throw "Invalid conj call"; } } static function seq(args) { return switch (args[0]) { case MalList(l): l.length > 0 ? args[0] : nil; case MalVector(l): l.length > 0 ? MalList(l.slice(0)) : nil; case MalString(s): if (s.length == 0) { return nil; } MalList(s.split("").map(function(c) { return MalString(c); })); case MalNil: nil; case _: throw "seq: called on non-sequence"; } } // hash-map functions public static function get(hm:MalType, key:MalType) { return switch [hm, key] { case [MalHashMap(m), MalString(k)]: if (m.exists(k)) { m[k]; } else { nil; } case [nil, MalString(k)]: nil; case _: throw "invalid get call"; } } public static function assoc(args) { return switch (args[0]) { case MalHashMap(m): var new_m = _clone(args[0]); MalHashMap(assoc_BANG(new_m, args.slice(1))); case _: throw "invalid assoc call"; } } public static function dissoc(args) { return switch (args[0]) { case MalHashMap(m): var new_m = _clone(args[0]); MalHashMap(dissoc_BANG(new_m, args.slice(1))); case _: throw "invalid dissoc call"; } } public static function contains_Q(hm:MalType, key:MalType) { return switch [hm, key] { case [MalHashMap(m), MalString(k)]: m.exists(k); case _: throw "invalid contains? call"; } } public static function keys(hm:MalType) { return switch (hm) { case MalHashMap(m): MalList([for (k in m.keys()) MalString(k)]); case _: throw "invalid keys call"; } } public static function vals(hm:MalType) { return switch (hm) { case MalHashMap(m): MalList([for (k in m.keys()) m[k]]); case _: throw "invalid vals call"; } } // metadata functions static function meta(args) { return switch (args[0]) { case MalFunc(f,_,_,_,_,meta): meta; case _: throw "meta called on non-function"; } } static function with_meta(args) { return switch (args[0]) { case MalFunc(f,a,e,p,mac,_): MalFunc(f,a,e,p,mac,args[1]); case _: throw "with_meta called on non-function"; } } // atom functions static function deref(args) { return switch (args[0]) { case MalAtom(v): v.val; case _: throw "deref called on non-atom"; } } static function reset_BANG(args) { return switch (args[0]) { case MalAtom(v): v.val = args[1]; case _: throw "reset! called on non-atom"; } } static function swap_BANG(args) { return switch [args[0], args[1]] { case [MalAtom(v), MalFunc(f,_,_,_,_)]: var fargs = [v.val].concat(args.slice(2)); v.val = f(fargs); v.val; case _: throw "swap! called on non-atom"; } } public static var ns:Map -> MalType> = [ "=" => function(a) { return BoolFn(_equal_Q(a[0],a[1])); }, "throw" => function(a) { throw new MalException(a[0]); }, "nil?" => function(a) { return BoolFn(nil_Q(a[0])); }, "true?" => function(a) { return BoolFn(true_Q(a[0])); }, "false?" => function(a) { return BoolFn(false_Q(a[0])); }, "string?" => function(a) { return BoolFn(string_Q(a[0])); }, "symbol" => symbol, "symbol?" => function(a) { return BoolFn(symbol_Q(a[0])); }, "keyword" => keyword, "keyword?" => function(a) { return BoolFn(keyword_Q(a[0])); }, "number?" => function(a) { return BoolFn(number_Q(a[0])); }, "fn?" => function(a) { return BoolFn(_fn_Q(a[0])); }, "macro?" => function(a) { return BoolFn(_macro_Q(a[0])); }, "pr-str" => pr_str, "str" => str, "prn" => prn, "println" => println, "read-string" => read_string, "readline" => readline, "slurp" => slurp, "<" => BoolOp(function(a,b) {return a" => BoolOp(function(a,b) {return a>b;}), ">=" => BoolOp(function(a,b) {return a>=b;}), "+" => NumOp(function(a,b) {return a+b;}), "-" => NumOp(function(a,b) {return a-b;}), "*" => NumOp(function(a,b) {return a*b;}), "/" => NumOp(function(a,b) {return Std.int(a/b);}), "time-ms" => time_ms, "list" => function(a) { return MalList(a); }, "list?" => function(a) { return BoolFn(list_Q(a[0])); }, "vector" => function(a) { return MalVector(a); }, "vector?" => function(a) { return BoolFn(vector_Q(a[0])); }, "hash-map" => hash_map, "map?" => function(a) { return BoolFn(hash_map_Q(a[0])); }, "assoc" => assoc, "dissoc" => dissoc, "get" => function(a) { return get(a[0],a[1]); }, "contains?" => function(a) { return BoolFn(contains_Q(a[0], a[1])); }, "keys" => function(a) { return keys(a[0]); } , "vals" => function(a) { return vals(a[0]); } , "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]); }, "empty?" => empty_Q, "count" => count, "apply" => apply, "map" => do_map, "conj" => conj, "seq" => seq, "meta" => meta, "with-meta" => with_meta, "atom" => function(a) { return MalAtom({val:a[0]}); }, "atom?" => function(a) { return BoolFn(atom_Q(a[0])); }, "deref" => deref, "reset!" => reset_BANG, "swap!" => swap_BANG ]; } ================================================ FILE: impls/haxe/env/Env.hx ================================================ package env; import types.Types.MalType; import types.Types.*; class Env { var data = new Map(); var outer:Env = null; public function new(outer:Env, binds:Array = null, exprs:Array = null) { this.outer = outer; if (binds != null) { for (i in 0...binds.length) { var b = binds[i], e = exprs[i]; switch (b) { case MalSymbol("&"): switch (binds[i+1]) { case MalSymbol(b2): data[b2] = MalList(exprs.slice(i)); case _: throw "invalid vararg binding"; } break; case MalSymbol(s): data[s] = e; case _: throw "invalid bind"; } } } } public function set(key:MalType, val:MalType) { switch (key) { case MalSymbol(s): data[s] = val; case _: throw "Invalid Env.set call"; } return val; } public function get(key:String):MalType { if (data.exists(key)) return data.get(key); else if (outer != null) return outer.get(key); else return null; } } ================================================ FILE: impls/haxe/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline"; // NOTE: libreadline is GPL //var RL_LIB = "libedit"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var ffi = require('ffi-napi'), fs = require('fs'); var rllib = ffi.Library(RL_LIB, { 'readline': [ 'string', [ 'string' ] ], 'add_history': [ 'int', [ 'string' ] ]}); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = prompt || "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i"; } case _: throw "unknown type for printing"; } } } ================================================ FILE: impls/haxe/reader/BlankLine.hx ================================================ package reader; class BlankLine { public function new() { } } ================================================ FILE: impls/haxe/reader/Reader.hx ================================================ package reader; import types.Types.MalType; import types.Types.*; class Reader { // Reader class implementation var tokens:Array; var position:Int = 0; public function new(toks:Array) { tokens = toks; } public function next() { return tokens[position++]; } public function peek() { if (tokens.length > position) { return tokens[position]; } else { return null; } } // Static functions grouped with Reader class static function tokenize(str:String) { var re = ~/[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g; var tokens = new Array(); var pos = 0; while (re.matchSub(str, pos)) { var t = re.matched(1); if (t == "") { break; } var pos_len = re.matchedPos(); pos = pos_len.pos + pos_len.len; if (t.charAt(0) == ";") { continue; } tokens.push(t); } return tokens; } static function read_atom(rdr:Reader) { var re_int = ~/^-?[0-9][0-9]*$/; var re_str = ~/^"(?:\\.|[^\\"])*"$/; var re_str_bad = ~/^".*$/; var token = rdr.next(); return switch (token) { case "nil": MalNil; case "true": MalTrue; case "false": MalFalse; case _ if (token.charAt(0) == ":"): MalString("\x7f" + token.substr(1)); case _ if (re_int.match(token)): MalInt(Std.parseInt(token)); case _ if (re_str.match(token)): var re1 = ~/\\\\/g, re2 = ~/\\n/g, re3 = ~/\\"/g, re4 = ~/\x7f/g, s = token.substr(1, token.length-2); MalString(re4.replace( re3.replace( re2.replace( re1.replace( s, "\x7f"), "\n"), "\""), "\\")); case _ if (re_str_bad.match(token)): throw 'expected \'"\', got EOF'; case _: MalSymbol(token); } } static function read_seq(rdr:Reader, start, end) { var lst = []; var token = rdr.next(); if (token != start) { throw 'expected \'${start}\''; } while ((token = rdr.peek()) != end) { if (token == null) { throw 'expected \'${end}\', got EOF'; } lst.push(read_form(rdr)); } rdr.next(); return lst; } static function read_form(rdr:Reader):MalType { var token = rdr.peek(); return switch (token) { // reader macros/transforms case "'": rdr.next(); MalList([MalSymbol("quote"), read_form(rdr)]); case "`": rdr.next(); MalList([MalSymbol("quasiquote"), read_form(rdr)]); case "~": rdr.next(); MalList([MalSymbol("unquote"), read_form(rdr)]); case "~@": rdr.next(); MalList([MalSymbol("splice-unquote"), read_form(rdr)]); case "^": rdr.next(); var meta = read_form(rdr); MalList([MalSymbol("with-meta"), read_form(rdr), meta]); case "@": rdr.next(); MalList([MalSymbol("deref"), read_form(rdr)]); // list case ")": throw("unexpected ')'"); case "(": MalList(read_seq(rdr, '(', ')')); // vector case "]": throw("unexpected ']'"); case "[": MalVector(read_seq(rdr, '[', ']')); // hashmap case "}": throw("unexpected '}'"); case "{": hash_map(read_seq(rdr, '{', '}')); case _: read_atom(rdr); } } public static function read_str(str:String):MalType { var tokens = tokenize(str); if (tokens.length == 0) { throw(new BlankLine()); } return read_form(new Reader(tokens)); } } ================================================ FILE: impls/haxe/run ================================================ #!/usr/bin/env bash case ${haxe_MODE:-neko} in neko) exec neko $(dirname $0)/${STEP:-stepA_mal}.n "${@}" ;; python) exec python3 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" ;; js) exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ;; cpp) exec $(dirname $0)/cpp/${STEP:-stepA_mal} "${@}" ;; *) echo "Invalid haxe_MODE: ${haxe_MODE}"; exit 2 ;; esac ================================================ FILE: impls/haxe/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 100000)) res1 ;=>nil ================================================ FILE: impls/haxe/types/MalException.hx ================================================ package types; import types.Types.MalType; class MalException { public var obj:MalType = null; public function new(obj:MalType) { this.obj = obj; } } ================================================ FILE: impls/haxe/types/Types.hx ================================================ package types; import env.Env; class MalAtomContainer { } enum MalType { MalNil; MalTrue; MalFalse; MalInt(val:Int); MalString(val:String); MalSymbol(val:String); MalList(val:Array); MalVector(val:Array); MalHashMap(val:Map); MalAtom(val:{val:MalType}); MalFunc(val:(Array)->MalType, ast:MalType, env:Env, params:MalType, ismacro:Bool, meta:MalType); } class Types { public static var nil:MalType = MalNil; public static function _equal_Q(a:MalType, b:MalType) { return switch [a, b] { case [MalInt(va), MalInt(vb)]: va == vb; case [MalString(va), MalString(vb)] | [MalSymbol(va), MalSymbol(vb)]: va == vb; case [MalList(la), MalList(lb)] | [MalList(la), MalVector(lb)] | [MalVector(la), MalList(lb)] | [MalVector(la), MalVector(lb)]: if (la.length != lb.length) { return false; } for (i in 0...la.length) { if (!_equal_Q(la[i], lb[i])) { false; } } true; case [MalHashMap(ma), MalHashMap(mb)]: var maks = ma.keys(), mbks = mb.keys(), malen = 0, mblen = 0; for (k in maks) { malen += 1; if ((!mb.exists(k)) || !_equal_Q(ma[k], mb[k])) { return false; } } for (k in mbks) { mblen += 1; } if (malen != mblen) { return false; } true; case _: a == b; } } public static function _clone(a:MalType) { return switch (a) { case MalHashMap(m): var new_m = new Map(); for (k in m.keys()) { new_m[k] = m[k]; } return new_m; case _: throw "unsupported clone call"; } } public static function _fn_Q(x:MalType) { return switch (x) { case MalFunc(_,_,_,_,ismacro,_): !ismacro; case _: false; } } public static function _macro_Q(x:MalType) { return switch (x) { case MalFunc(_,_,_,_,ismacro,_): ismacro; case _: false; } } public static function nil_Q(x:MalType) { return switch (x) { case MalNil: true; case _: false; } } public static function true_Q(x:MalType) { return switch (x) { case MalTrue: true; case _: false; } } public static function false_Q(x:MalType) { return switch (x) { case MalFalse: true; case _: false; } } public static function string_Q(x:MalType) { return switch (x) { case MalString(s): s.charAt(0) != "\x7f"; case _: false; } } public static function symbol_Q(x:MalType) { return switch (x) { case MalSymbol(_): true; case _: false; } } public static function keyword_Q(x:MalType) { return switch (x) { case MalString(s): s.charAt(0) == "\x7f"; case _: false; } } public static function number_Q(x:MalType) { return switch (x) { case MalInt(_): true; case _: false; } } // Sequence operations public static function list_Q(x:MalType) { return switch (x) { case MalList(_): true; case _: false; } } public static function vector_Q(x:MalType) { return switch (x) { case MalVector(_): true; case _: false; } } public static function first(seq:MalType) { return switch (seq) { case MalList(l) | MalVector(l): if (l.length == 0) { nil; } else { l[0]; } case MalNil: MalNil; case _: throw "first called on non-sequence"; } } public static function rest(seq:MalType) { return switch (seq) { case MalList(l) | MalVector(l): if (l.length <= 1) { MalList([]); } else { MalList(l.slice(1)); } case MalNil: MalList([]); case _: throw "rest called on non-sequence"; } } public static function _nth(seq:MalType, idx:Int) { return switch (seq) { case MalList(l) | MalVector(l): if (l.length > idx) { l[idx]; } else { throw "nth index out of bounds"; } case _: throw "nth called on non-sequence"; } } public static function _list(seq:MalType) { return switch (seq) { case MalList(l) | MalVector(l): l; case _: throw "_array called on non-sequence"; } } public static function _map(hm:MalType) { return switch (hm) { case MalHashMap(m): m; case _: throw "_map called on non-hash-map"; } } public static function last(seq:MalType) { return switch (seq) { case MalList(l) | MalVector(l): if (l.length == 0) { nil; } else { l[l.length-1]; } case _: throw "last called on non-sequence"; } } public static function hash_map(kvs:Array) { var m = new Map(); return MalHashMap(assoc_BANG(m, kvs)); } public static function assoc_BANG(m:Map, kvs:Array) { for (i in 0...kvs.length) { if (i % 2 > 0) { continue; } switch (kvs[i]) { case MalString(k): m[k] = kvs[i+1]; case _: throw "invalid assoc! call"; } } return m; } public static function dissoc_BANG(m:Map, ks:Array) { for (i in 0...ks.length) { switch (ks[i]) { case MalString(k): m.remove(k); case _: throw "invalid dissoc! call"; } } return m; } public static function hash_map_Q(x:MalType) { return switch (x) { case MalHashMap(_): true; case _: false; } } public static function atom_Q(x:MalType) { return switch (x) { case MalAtom(_): true; case _: false; } } } ================================================ FILE: impls/hy/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Hy RUN apt-get -y install python-pip && \ pip install hy && \ mkdir /.cache && \ chmod uog+rwx /.cache ================================================ FILE: impls/hy/Makefile ================================================ all: mal.hy mal.hy: stepA_mal.hy cp $< $@ clean: rm -f mal.hy *.pyc ================================================ FILE: impls/hy/core.hy ================================================ (import [hy.models [HyKeyword :as Keyword HyString :as Str HySymbol :as Sym]]) (import [copy [copy]]) (import [time [time]]) (import [mal_types [MalException Atom clone]]) (import [reader [read-str]]) (import [printer [pr-str]]) (defn sequential? [a] (or (instance? tuple a) (instance? list a))) (defn equal [a b] (if (and (sequential? a) (sequential? b) (= (len a) (len b))) (every? (fn [[a b]] (equal a b)) (zip a b)) (and (instance? dict a) (instance? dict b) (= (.keys a) (.keys b))) (every? (fn [k] (and (equal (get a k) (get b k)))) a) (= (type a) (type b)) (= a b) False)) (def ns {"=" equal "throw" (fn [a] (raise (MalException a))) "nil?" none? "true?" (fn [a] (and (instance? bool a) (= a True))) "false?" (fn [a] (and (instance? bool a) (= a False))) "number?" (fn [a] (and (not (instance? bool a)) (instance? int a))) "string?" (fn [a] (and (string? a) (not (keyword? a)))) "symbol" (fn [a] (Sym a)) "symbol?" (fn [a] (instance? Sym a)) "keyword" (fn [a] (Keyword (if (keyword? a) a (+ ":" a)))) "keyword?" (fn [a] (keyword? a)) "fn?" (fn [a] (and (callable a) (or (not (hasattr a "macro")) (not a.macro)))) "macro?" (fn [a] (and (callable a) (and (hasattr a "macro") a.macro))) "pr-str" (fn [&rest a] (Str (.join " " (map (fn [e] (pr-str e True)) a)))) "str" (fn [&rest a] (Str (.join "" (map (fn [e] (pr-str e False)) a)))) "prn" (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e True)) a)))) "println" (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e False)) a)))) "read-string" read-str "readline" (fn [a] (Str (raw_input a))) "slurp" (fn [a] (Str (-> a open .read))) "<" < "<=" <= ">" > ">=" >= "+" + "-" - "*" * "/" (fn [a b] (int (/ a b))) "time-ms" (fn [] (int (* 1000 (time)))) "list" (fn [&rest args] (tuple args)) "list?" (fn [a] (instance? tuple a)) "vector" (fn [&rest a] (list a)) "vector?" (fn [a] (instance? list a)) "hash-map" (fn [&rest a] (dict (partition a 2))) "map?" (fn [a] (instance? dict a)) "assoc" (fn [m &rest a] (setv m (copy m)) (for [[k v] (partition a 2)] (assoc m k v)) m) "dissoc" (fn [m &rest a] (setv m (copy m)) (for [k a] (if (.has_key m k) (.pop m k))) m) "get" (fn [m a] (if (and m (.has_key m a)) (get m a))) "contains?" (fn [m a] (if (none? m) None (.has_key m a))) "keys" (fn [m] (tuple (.keys m))) "vals" (fn [m] (tuple (.values m))) "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)))) "empty?" empty? "count" (fn [a] (if (none? a) 0 (len a))) "apply" (fn [f &rest a] (apply f (+ (list (butlast a)) (list (last a))))) "map" (fn [f a] (tuple (map f a))) "conj" (fn [a &rest xs] (if (instance? list a) (+ a (list xs)) (tuple (+ (tuple (reversed xs)) a)))) "seq" (fn [a] (if (or (none? a) (empty? a)) None (string? a) (tuple (map Str a)) (tuple a))) "meta" (fn [a] (if (hasattr a "meta") a.meta)) "with-meta" (fn [a b] (setv a (clone a)) (setv a.meta b) a) "atom" (fn [a] (Atom a)) "atom?" (fn [a] (instance? Atom a)) "deref" (fn [a] a.val) "reset!" (fn [a b] (do (setv a.val b) b)) "swap!" (fn [a f &rest xs] (do (setv a.val (apply f (+ (, a.val) xs))) a.val)) }) ================================================ FILE: impls/hy/env.hy ================================================ (import [hy.models [HySymbol :as Sym]]) (defn env-new [&optional [outer None] [binds []] [exprs []]] (setv env {:outer outer}) (while binds (if (= (Sym "&") (first binds)) (do (assoc env (nth binds 1) (tuple exprs)) (break)) True (do (assoc env (first binds) (first exprs)) (setv binds (list (rest binds)) exprs (list (rest exprs)))))) env) (defn env-find [env k] (if (.has_key env k) env (get env ':outer) (env-find (get env ':outer) k) True None)) (defn env-get [env k] (setv e (env-find env k)) (if-not e (raise (Exception (+ "'" k "' not found")))) (get e k)) (defn env-set [env k v] (assoc env k v) v) ================================================ FILE: impls/hy/mal_types.hy ================================================ (import [types :as pytypes]) (defclass MalException [Exception] (defn --init-- [self val] (setv self.val val))) (defclass Atom [] (defn --init-- [self val] (setv self.val val))) (defn clone [obj] (if (= (type obj) pytypes.FunctionType) (pytypes.FunctionType obj.__code__ obj.__globals__ :name obj.__name__ :argdefs obj.__defaults__ :closure obj.__closure__) obj)) ================================================ FILE: impls/hy/printer.hy ================================================ (import [hy.models [HyInteger :as Int HyKeyword :as Keyword HyString :as Str HySymbol :as Sym]]) (import [mal_types [Atom]]) (defn escape [s] (-> (str s) (.replace "\\" "\\\\") (.replace "\"" "\\\"") (.replace "\n" "\\n"))) (defn pr-str [obj &optional [print-readably True]] (setv _r print-readably t (type obj)) (Str (if (none? obj) "nil" (= t bool) (if obj "true" "false") (= t Keyword) (+ ":" (name obj)) (= t Str) (if _r (+ "\"" (escape obj) "\"") obj) (= t tuple) (+ "(" (.join " " (map (fn [x] (pr-str x _r)) obj)) ")") (= t list) (+ "[" (.join " " (map (fn [x] (pr-str x _r)) obj)) "]") (= t dict) (+ "{" (.join " " (map (fn [k] (+ (pr-str k _r) " " (pr-str (get obj k) _r))) obj)) "}") (instance? Atom obj) (+ "(atom " (pr-str obj.val _r) ")") True (str obj)))) ================================================ FILE: impls/hy/reader.hy ================================================ (import [hy.models [HyInteger :as Int HyKeyword :as Keyword HyString :as Str HySymbol :as Sym]] [re]) (defclass Blank [Exception]) (defclass Reader [] (defn --init-- [self tokens &optional [position 0]] (setv self.tokens tokens self.position position)) (defn next [self] (setv self.position (+ 1 self.position)) (get self.tokens (- self.position 1))) (defn peek [self] (if (> (len self.tokens) self.position) (get self.tokens self.position) None))) (def tok-re (.compile re "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)")) (def int-re (.compile re "-?[0-9]+$")) (def str-re (.compile re "^\"(?:[\\\\].|[^\\\\\"])*\"$")) (def str-bad-re (.compile re "^\".*$")) (defn tokenize [str] (list-comp t (t (.findall re tok-re str)) (!= (get t 0) ";"))) (defn unescape [s] (-> s (.replace "\\\\" "\u029e") (.replace "\\\"" "\"") (.replace "\\n" "\n") (.replace "\u029e" "\\"))) (defn read-atom [rdr] (setv token (.next rdr)) (if (.match re int-re token) (int token) (.match re str-re token) (Str (unescape (cut token 1 -1))) (.match re str-bad-re token) (raise (Exception "expected '\"', got EOF")) (= ":" (get token 0)) (Keyword token) (= "nil" token) None (= "true" token) True (= "false" token) False True (Sym token))) (defn read-seq [rdr &optional [start "("] [end ")"]] (setv ast (list) token (.next rdr)) (if (!= token start) (raise (Exception (+ "expected '" start "'"))) (do (setv token (.peek rdr)) (while (!= token end) (if (not token) (raise (Exception (+ "expected '" end ", got EOF")))) (.append ast (read-form rdr)) (setv token (.peek rdr))) (.next rdr) ast))) (defn read-form [rdr] (setv token (.peek rdr)) (if (= ";" (get token 0)) (.next rdr) (= "'" token) (do (.next rdr) (tuple [(Sym "quote") (read-form rdr)])) (= "`" token) (do (.next rdr) (tuple [(Sym "quasiquote") (read-form rdr)])) (= "~" token) (do (.next rdr) (tuple [(Sym "unquote") (read-form rdr)])) (= "~@" token) (do (.next rdr) (tuple [(Sym "splice-unquote") (read-form rdr)])) (= "^" token) (do (.next rdr) (setv meta (read-form rdr)) (tuple [(Sym "with-meta") (read-form rdr) meta])) (= "@" token) (do (.next rdr) (tuple [(Sym "deref") (read-form rdr)])) (= ")" token) (raise (Exception "unexpected ')'")) (= "(" token) (tuple (read-seq rdr "(" ")")) (= "]" token) (raise (Exception "unexpected ')'")) (= "[" token) (read-seq rdr "[" "]") (= "}" token) (raise (Exception "unexpected '}'")) (= "{" token) (dict (partition (read-seq rdr "{" "}") 2)) True (read-atom rdr))) (defn read-str [str] (setv tokens (tokenize str)) (if (= 0 (len tokens)) (raise (Blank "blank line"))) (read-form (Reader tokens))) ================================================ FILE: impls/hy/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal}.hy "${@}" ================================================ FILE: impls/hy/step0_repl.hy ================================================ #!/usr/bin/env hy (defn READ [str] str) (defn EVAL [ast env] ast) (defn PRINT [exp] exp) (defn REP [str] (PRINT (EVAL (READ str) {}))) (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break))))) ================================================ FILE: impls/hy/step1_read_print.hy ================================================ #!/usr/bin/env hy (import sys traceback) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (defn READ [str] (read-str str)) (defn EVAL [ast env] ast) (defn PRINT [exp] (pr-str exp True)) (defn REP [str] (PRINT (EVAL (READ str) {}))) (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (print (.join "" (apply traceback.format_exception (.exc_info sys)))))))) ================================================ FILE: impls/hy/step2_eval.hy ================================================ #!/usr/bin/env hy (import sys traceback) (import [reader [read-str Blank]]) (import [printer [pr-str]]) ;; read (defn READ [str] (read-str str)) ;; eval (defn EVAL [ast env] ;; indented to match later steps (if (symbol? ast) (if (.has_key env ast) (get env ast) (raise (Exception (+ ast " not found")))) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (apply f args)))) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env {'+ + '- - '* * '/ (fn [a b] (int (/ a b)))}) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (print (.join "" (apply traceback.format_exception (.exc_info sys)))))))) ================================================ FILE: impls/hy/step3_env.hy ================================================ #!/usr/bin/env hy (import [hy.models [HySymbol :as Sym]]) (import sys traceback) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) ;; read (defn READ [str] (read-str str)) ;; eval (defn EVAL [ast env] ;; indented to match later steps (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (EVAL a2 env)) ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (apply f args)))))) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) (env-set repl-env '+ +) (env-set repl-env '- -) (env-set repl-env '* *) (env-set repl-env '/ /) (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (print (.join "" (apply traceback.format_exception (.exc_info sys)))))))) ================================================ FILE: impls/hy/step4_if_fn_do.hy ================================================ #!/usr/bin/env hy (import [hy.models [HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (defn EVAL [ast env] ;; indented to match later steps (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (EVAL a2 env)) (= (Sym "do") a0) (last (list (map (fn [x] (EVAL x env)) (list (rest ast))))) (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (EVAL (nth ast 3) env) None) (EVAL a2 env))) (= (Sym "fn*") a0) (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (apply f args)))))) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))) ================================================ FILE: impls/hy/step5_tco.hy ================================================ #!/usr/bin/env hy (import [hy.models [HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (defn EVAL [ast env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (defmain [&rest args] ;; indented to match later steps (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))) ================================================ FILE: impls/hy/step6_file.hy ================================================ #!/usr/bin/env hy (import [hy.models [HyString :as Str HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (defn EVAL [ast env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) (env-set repl-env (Sym "*ARGV*") (, )) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (defmain [&rest args] (if (>= (len args) 2) (do (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) (REP (+ "(load-file \"" (get args 1) "\")"))) (do (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))))) ================================================ FILE: impls/hy/step7_quote.hy ================================================ #!/usr/bin/env hy (import [hy.models [HyString :as Str HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (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 (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 env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "quote") a0) a1 (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) (env-set repl-env (Sym "*ARGV*") (, )) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (defmain [&rest args] (if (>= (len args) 2) (do (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) (REP (+ "(load-file \"" (get args 1) "\")"))) (do (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))))) ================================================ FILE: impls/hy/step8_macros.hy ================================================ #!/usr/bin/env hy (import [hy.models [HyString :as Str HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (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 (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 env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "quote") a0) a1 (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO (= (Sym "defmacro!") a0) (do (setv func (EVAL a2 env) func.macro True) (env-set env a1 func)) (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv f (EVAL a0 env)) (if (and (hasattr f "macro") f.macro) (do (setv ast (apply f (list (rest ast)))) (continue))) ;; TCO (setv args (list (map (fn [x] (EVAL x env)) (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) (env-set repl-env (Sym "*ARGV*") (, )) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (defmain [&rest args] (if (>= (len args) 2) (do (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) (REP (+ "(load-file \"" (get args 1) "\")"))) (do (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))))) ================================================ FILE: impls/hy/step9_try.hy ================================================ #!/usr/bin/env hy (import [hy.models [HyString :as Str HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (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 (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 env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "quote") a0) a1 (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO (= (Sym "defmacro!") a0) (do (setv func (EVAL a2 env) func.macro True) (env-set env a1 func)) (= (Sym "try*") a0) (if (and a2 (= (Sym "catch*") (nth a2 0))) (try (EVAL a1 env) (except [e Exception] (if (instance? MalException e) (setv exc e.val) (setv exc (Str (get e.args 0)))) (do (setv ast (nth a2 2) env (env-new env [(nth a2 1)] [exc])) (continue)))) ;; TCO (do (setv ast a1) (continue))) ;; TCO (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv f (EVAL a0 env)) (if (and (hasattr f "macro") f.macro) (do (setv ast (apply f (list (rest ast)))) (continue))) ;; TCO (setv args (list (map (fn [x] (EVAL x env)) (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) (env-set repl-env (Sym "*ARGV*") (, )) ;; core.mal: defined using the language itself (REP "(def! not (fn* [a] (if a false true)))") (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (defmain [&rest args] (if (>= (len args) 2) (do (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) (REP (+ "(load-file \"" (get args 1) "\")"))) (do (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))))) ================================================ FILE: impls/hy/stepA_mal.hy ================================================ #!/usr/bin/env hy (import [hy.models [HyString :as Str HySymbol :as Sym]]) (import sys traceback) (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) (import [env [env-new env-get env-set env-find]]) (import core) ;; read (defn READ [str] (read-str str)) ;; eval (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 (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 env] (setv res None) (while True (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) (if dbgevalenv (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) (if (not (none? dbgevalsym)) (print "EVAL:" (pr-str ast True))))) (setv res (if (symbol? ast) (env-get env ast) (instance? dict ast) (dict (map (fn [k] [k (EVAL (get ast k) env)]) ast)) (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) (not (instance? tuple ast)) ast (empty? ast) ast ;; apply list (do (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) (if (= (Sym "def!") a0) (env-set env a1 (EVAL a2 env)) (= (Sym "let*") a0) (do (setv env (env-new env)) (for [[b e] (partition a1 2)] (env-set env b (EVAL e env))) (setv ast a2) (continue)) ;; TCO (= (Sym "quote") a0) a1 (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO (= (Sym "defmacro!") a0) (do (setv func (EVAL a2 env) func.macro True) (env-set env a1 func)) (= (Sym "try*") a0) (if (and a2 (= (Sym "catch*") (nth a2 0))) (try (EVAL a1 env) (except [e Exception] (if (instance? MalException e) (setv exc e.val) (setv exc (Str (get e.args 0)))) (do (setv ast (nth a2 2) env (env-new env [(nth a2 1)] [exc])) (continue)))) ;; TCO (do (setv ast a1) (continue))) ;; TCO (= (Sym "do") a0) (do (list (map (fn [x] (EVAL x env)) (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO (= (Sym "if") a0) (do (setv cond (EVAL a1 env)) (if (or (none? cond) (and (instance? bool cond) (= cond False))) (if (> (len ast) 2) (do (setv ast (nth ast 3)) (continue)) ;; TCO None) (do (setv ast a2) (continue)))) ;; TCO (= (Sym "fn*") a0) (do (setv func (fn [&rest args] (EVAL a2 (env-new env a1 (or args [])))) func.ast a2 func.env env func.params a1) func) ;; apply (do (setv f (EVAL a0 env)) (if (and (hasattr f "macro") f.macro) (do (setv ast (apply f (list (rest ast)))) (continue))) ;; TCO (setv args (list (map (fn [x] (EVAL x env)) (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO (apply f args))))))) (break)) res) ;; print (defn PRINT [exp] (pr-str exp True)) ;; repl (def repl-env (env-new)) (defn REP [str] (PRINT (EVAL (READ str) repl-env))) ;; core.hy: defined using Hy (for [k core.ns] (env-set repl-env (Sym k) (get core.ns k))) (env-set repl-env (Sym "eval") (fn [ast] (EVAL ast repl-env))) (env-set repl-env (Sym "*ARGV*") (, )) ;; core.mal: defined using the language itself (REP "(def! *host-language* \"Hy\")") (REP "(def! not (fn* [a] (if a false true)))") (REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (defmain [&rest args] (if (>= (len args) 2) (do (env-set repl-env (Sym "*ARGV*") (tuple (map Str (rest (rest args))))) (REP (+ "(load-file \"" (get args 1) "\")"))) (do (REP "(println (str \"Mal [\" *host-language* \"]\"))") (while True (try (do (setv line (raw_input "user> ")) (if (= "" line) (continue)) (print (REP line))) (except [EOFError] (break)) (except [Blank]) (except [e Exception] (setv msg (.rstrip (.join "" (apply traceback.format_exception (.exc_info sys))))) (if (instance? MalException e) (setv msg (+ (.rstrip msg) ": " (pr-str e.val True)))) (print msg))))))) ================================================ FILE: impls/hy/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/io/Dockerfile ================================================ FROM ubuntu:24.04 AS base MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN apt-get -y install libpcre3-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Compile the io interpreter ########################################################## FROM base AS builder RUN apt-get -y install git cmake gcc RUN cd /tmp \ && git clone --recursive -q --depth=1 https://github.com/IoLanguage/io.git \ && cd /tmp/io \ && mkdir build && cd build \ && cmake -DCMAKE_BUILD_TYPE=release .. && make && make install # Force eerie (Io package manager) to install itself and the packages in /opt/.eerie ENV HOME=/opt RUN cd /tmp/io/eerie \ && mkdir -p /opt \ && . ./install_unix.sh --notouch \ && eerie install https://github.com/IoLanguage/Range.git \ && eerie install https://github.com/IoLanguage/ReadLine.git \ && eerie install https://github.com/IoLanguage/Regex.git ########################################################## # Specific implementation requirements ########################################################## FROM base AS io COPY --from=builder /usr/local/lib/ /usr/lib/ COPY --from=builder /usr/local/bin/ /usr/bin/ COPY --from=builder /opt/.eerie/ /opt/.eerie/ ENV HOME=/mal ================================================ FILE: impls/io/Env.io ================================================ Env := Object clone do( outer ::= nil data ::= nil with := method(aOuter, aBinds, aExprs, self clone setOuter(aOuter) setData(Map clone) initBinds(aBinds, aExprs) ) initBinds := method(aBinds, aExprs, if(aBinds isNil not, aBinds foreach(i, b, if(b val == "&", set(aBinds at(i + 1), aExprs slice(i)) break, set(b, aExprs at(i)) ) ) ) self ) set := method(key, val, data atPut(key val, val) val ) find := method(key, keyStr := key val if(data hasKey(keyStr), self, if(outer isNil, nil, outer find(key) ) ) ) get := method(key, keyStr := key val foundEnv := find(key) if(foundEnv isNil, Exception raise("'" .. keyStr .. "' not found"), (foundEnv data) at(keyStr) ) ) ) ================================================ FILE: impls/io/Makefile ================================================ STEPS = step0_repl.io step1_read_print.io step2_eval.io step3_env.io step4_if_fn_do.io step5_tco.io \ step6_file.io step7_quote.io step8_macros.io step9_try.io stepA_mal.io all: eerie eerie: ln -s /opt/.eerie eerie $(STEPS): eerie clean: ================================================ FILE: impls/io/MalCore.io ================================================ MalCore := Object clone do( slurp := block(a, f := File with(a at(0)) res := f contents f close res ) dissoc := block(a, res := MalMap withMap(a at(0)) a rest foreach(k, res removeKey(k)) 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)), Exception raise("nth: index out of range") ) ) conj := block(a, coll := a at(0) coll type switch( "MalList", MalList with(a rest reverse appendSeq(coll)), "MalVector", MalVector with(coll appendSeq(a rest)) ) ) seq := block(a, obj := a at(0) (obj isNil) ifTrue(return(nil)) (obj type == "MalList") ifTrue(return(if(obj isEmpty, nil, obj))) (obj type == "MalVector") ifTrue(return(if(obj isEmpty, nil, MalList with(obj)))) (obj type == "Sequence") ifTrue( if(obj isEmpty, return(nil)) lst := list() obj foreach(i, c, lst append(obj inclusiveSlice(i, i))) return(MalList with(lst)) ) nil ) swapBang := block(a, atom := a at(0) newVal := a at(1) call(MalList with(list(atom val)) appendSeq(a slice(2))) atom setVal(newVal) val ) ioToMal := method(v, (v isNil) ifTrue(return(v)) (v == true) ifTrue(return(v)) (v == false) ifTrue(return(v)) (v type == "Number") ifTrue(return(v)) (v type == "Sequence") ifTrue(return(v)) (v type == "List") ifTrue(return(MalList with(v map(e, ioToMal(e))))) (v type == "Map") ifTrue( lst := list() v foreach(key, val, lst push(key asString) lst push(ioToMal(val)) ) return(MalMap withList(lst)) ) v asString ) ioEval := block(a, MalCore ioToMal(doString(a at(0))) ) NS := Map with( "=", block(a, a at(0) == a at(1)), "throw", block(a, MalException with(a at(0)) raise), "nil?", block(a, a at(0) isNil), "true?", block(a, a at(0) == true), "false?", block(a, a at(0) == false), "string?", block(a, a at(0) type == "Sequence"), "symbol", block(a, MalSymbol with(a at(0))), "symbol?", block(a, a at(0) type == "MalSymbol"), "keyword", block(a, MalKeyword with(a at(0))), "keyword?", block(a, a at(0) type == "MalKeyword"), "number?", block(a, a at(0) type == "Number"), "fn?", block(a, (a at(0) type == "Block") or ((a at(0) type == "MalFunc") and (a at(0) isMacro not))), "macro?", block(a, (a at(0) type == "MalFunc") and (a at(0) isMacro)), "pr-str", block(a, a map(s, s malPrint(true)) join(" ")), "str", block(a, a map(s, s malPrint(false)) join("")), "prn", block(a, a map(s, s malPrint(true)) join(" ") println ; nil), "println", block(a, a map(s, s malPrint(false)) join(" ") println ; nil), "read-string", block(a, MalReader read_str(a at(0))), "readline", block(a, MalReadline readLine(a at(0))), "slurp", slurp, "<", block(a, a at(0) < a at(1)), "<=", block(a, a at(0) <= a at(1)), ">", block(a, a at(0) > a at(1)), ">=", block(a, a at(0) >= a at(1)), "+", block(a, a at(0) + a at(1)), "-", block(a, a at(0) - a at(1)), "*", block(a, a at(0) * a at(1)), "/", block(a, a at(0) / a at(1)), "time-ms", block(a, (Date now asNumber * 1000.0) round), "list", block(a, a), "list?", block(a, a at(0) type == "MalList"), "vector", block(a, MalVector with(a)), "vector?", block(a, a at(0) type == "MalVector"), "hash-map", block(a, MalMap withList(a)), "map?", block(a, a at(0) type == "MalMap"), "assoc", block(a, MalMap withMap(a at(0) merge(MalMap withList(a rest)))), "dissoc", dissoc, "get", block(a, a at(0) ifNil(return nil) get(a at(1))), "contains?", block(a, a at(0) ifNil(return nil) contains(a at(1))), "keys", block(a, a at(0) malKeys), "vals", block(a, a at(0) malVals), "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), "empty?", block(a, a at(0) ifNil(true) isEmpty), "count", block(a, a at(0) ifNil(return(0)) size), "apply", block(a, a at(0) call(MalList with(a slice(1, -1) appendSeq(a last)))), "map", block(a, MalList with(a at(1) map(e, a at(0) call(MalList with(list(e)))))), "conj", conj, "seq", seq, "meta", block(a, a at(0) ?meta), "with-meta", block(a, a at(0) clone setMeta(a at(1))), "atom", block(a, MalAtom with(a at(0))), "atom?", block(a, a at(0) type == "MalAtom"), "deref", block(a, a at(0) val), "reset!", block(a, a at(0) setVal(a at(1)) ; a at(1)), "swap!", swapBang, "io-eval", ioEval ) ) ================================================ FILE: impls/io/MalReader.io ================================================ MalReader := Object clone do ( Reader := Object clone do ( pos ::= 0 tokens ::= list() with := method(theTokens, self clone setTokens(theTokens) ) peek := method(tokens at(pos)) next := method( pos = pos + 1 tokens at(pos - 1) ) ) tokenizerRegex := Regex with("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)") tokenize := method(str, tokenizerRegex matchesIn(str) \ map(m, m at(1) asMutable strip) \ select(t, t size > 0) \ select(t, t exSlice(0, 1) != ";") ) numberRegex := Regex with("^-?[0-9]+$") stringRegex := Regex with("^\"(?:[\\\\].|[^\\\\\"])*\"$") read_string := method(token, placeholder := 127 asCharacter token exSlice(1, -1) replaceSeq("\\\\", placeholder) replaceSeq("\\\"", "\"") replaceSeq("\\n", "\n") replaceSeq(placeholder, "\\") ) read_atom := method(rdr, token := rdr next (token hasMatchOfRegex(numberRegex)) ifTrue(return(token asNumber)) (token == "true") ifTrue(return(true)) (token == "false") ifTrue(return(false)) (token == "nil") ifTrue(return(nil)) (token beginsWithSeq(":")) ifTrue(return(MalKeyword with(token exSlice(1)))) (token hasMatchOfRegex(stringRegex)) ifTrue(return(read_string(token))) (token beginsWithSeq("\"")) ifTrue(Exception raise("expected '\"', got EOF")) MalSymbol with(token) ) read_list := method(rdr, start, end, token := rdr next if(token != start, Exception raise("expected '" .. start .. "'")) ast := list() token = rdr peek while(token != end, if(token isNil, Exception raise("expected '" .. end .. "', got EOF")) ast push(read_form(rdr)) token = rdr peek ) rdr next ast ) reader_macro := method(symbol, rdr, rdr next MalList with(list(MalSymbol with(symbol), read_form(rdr))) ) read_form := method(rdr, token := rdr peek (token == "'") ifTrue(return(reader_macro("quote", rdr))) (token == "`") ifTrue(return(reader_macro("quasiquote", rdr))) (token == "~") ifTrue(return(reader_macro("unquote", rdr))) (token == "~@") ifTrue(return(reader_macro("splice-unquote", rdr))) (token == "^") ifTrue( rdr next meta := read_form(rdr) return(MalList with(list(MalSymbol with("with-meta"), read_form(rdr), meta))) ) (token == "@") ifTrue(return(reader_macro("deref", rdr))) (token == "(") ifTrue(return(MalList with(read_list(rdr, "(", ")")))) (token == ")") ifTrue(Exception raise("unexepcted ')'")) (token == "[") ifTrue(return(MalVector with(read_list(rdr, "[", "]")))) (token == "]") ifTrue(Exception raise("unexepcted ']'")) (token == "{") ifTrue(return(MalMap withList(read_list(rdr, "{", "}")))) (token == "}") ifTrue(Exception raise("unexepcted '}'")) read_atom(rdr) ) read_str := method(str, tokens := tokenize(str) if(tokens isEmpty, nil, read_form(Reader with(tokens))) ) ) ================================================ FILE: impls/io/MalReadline.io ================================================ MalReadline := Object clone do ( historyLoaded := false historyFile := (System getEnvironmentVariable("HOME")) .. "/.mal-history" loadHistory := method( if(File exists(historyFile), ReadLine loadHistory(historyFile)) historyLoaded = true ) readLine := method(prompt, if(historyLoaded not, loadHistory) line := ReadLine readLine(prompt) if(line isNil, return(nil)) if(line isEmpty, return(line)) ReadLine addHistory(line) ReadLine saveHistory(historyFile) line ) ) ================================================ FILE: impls/io/MalTypes.io ================================================ MalTypes := Object clone nil malPrint := method(readable, self asString) true malPrint := method(readable, self asString) false malPrint := method(readable, self asString) Number malPrint := method(readable, self asString) // Io strings are of type Sequence Sequence malPrint := method(readable, if(readable, "\"" .. (self asString asMutable replaceSeq("\\", "\\\\") replaceSeq("\"", "\\\"") replaceSeq("\n", "\\n")) .. "\"", self asString) ) MalMeta := Object clone do( meta ::= nil ) MalSymbol := Object clone appendProto(MalMeta) do ( val ::= nil with := method(str, self clone setVal(if(str ?val, str val, str))) malPrint := method(readable, val) == := method(other, (self type == other type) and (val == other val)) ) MalKeyword := Object clone do ( val ::= nil with := method(str, self clone setVal(if(str ?val, str val, str))) malPrint := method(readable, ":" .. val) == := method(other, (self type == other type) and (val == other val)) ) MalSequential := Object clone do( isSequential := method(true) equalSequence := method(other, if((other ?isSequential) not, return false) if(self size != other size, return false) unequalElement := self detect(i, valA, (valA == (other at(i))) not ) if(unequalElement, false, true) ) ) MalList := List clone appendProto(MalSequential) appendProto(MalMeta) do ( with := method(lst, self clone copy(lst)) malPrint := method(readable, "(" .. (self map(e, e malPrint(readable)) join(" ")) .. ")" ) rest := method(MalList with(resend)) slice := method(MalList with(resend)) == := method(other, equalSequence(other)) ) MalVector := List clone appendProto(MalSequential) appendProto(MalMeta) do ( with := method(lst, self clone copy(lst)) malPrint := method(readable, "[" .. (self map(e, e malPrint(readable)) join(" ")) .. "]" ) rest := method(MalList with(resend)) slice := method(MalList with(resend)) == := method(other, equalSequence(other)) ) MalMap := Map clone appendProto(MalMeta) do ( withList := method(lst, obj := self clone k := nil lst foreach(i, e, if(i % 2 == 0, k := e, obj atPut(objToKey(k), e) ) ) obj ) withMap := method(aMap, self clone merge(aMap)) objToKey := method(obj, if(obj type == "MalKeyword", "K_" .. (obj val), "S_" .. obj) ) keyToObj := method(s, if(s beginsWithSeq("K_"), MalKeyword with(s exSlice(2)), s exSlice(2) ) ) malPrint := method(readable, "{" .. (self map(k, v, (keyToObj(k) malPrint(readable)) .. " " .. (v malPrint(readable)) ) join(" ")) .. "}" ) contains := method(obj, hasKey(objToKey(obj))) get := method(obj, at(objToKey(obj))) malKeys := method(MalList with(keys map(k, keyToObj(k)))) malVals := method(MalList with(values)) removeKey := method(obj, removeAt(objToKey(obj))) == := method(other, if(self type != other type, return false) if(keys size != other keys size, return false) unequalElement := self detect(k, valA, (valA == (other at(k))) not ) if(unequalElement, false, true) ) ) Block malPrint := method(readable, "#") Block appendProto(MalMeta) MalFunc := Object clone appendProto(MalMeta) do ( ast ::= nil params ::= nil env ::= nil blk ::= nil isMacro ::= false with := method(aAst, aParams, aEnv, aBlk, self clone setAst(aAst) setParams(aParams) setEnv(aEnv) setBlk(aBlk) ) malPrint := method(readable, "#") call := method(args, blk call(args)) ) MalAtom := Object clone appendProto(MalMeta) do ( val ::= nil with := method(str, self clone setVal(str)) malPrint := method(readable, "(atom " .. (val malPrint(true)) .. ")") == := method(other, (self type == other type) and (val == other val)) ) MalException := Exception clone do ( val ::= nil with := method(str, self clone setVal(str)) ) ================================================ FILE: impls/io/run ================================================ #!/usr/bin/env bash io $(dirname $0)/${STEP:-stepA_mal}.io "$@" ================================================ FILE: impls/io/step0_repl.io ================================================ Regex READ := method(str, str) EVAL := method(ast, env, ast) PRINT := method(exp, exp) RE := method(str, EVAL(READ(str), nil)) REP := method(str, PRINT(RE(str))) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) REP(line) println ) ================================================ FILE: impls/io/step1_read_print.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) EVAL := method(ast, env, ast) PRINT := method(exp, exp malPrint(true)) RE := method(str, EVAL(READ(str), nil)) REP := method(str, PRINT(RE(str))) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, ("Error: " .. (e error)) println ) ) ================================================ FILE: impls/io/step2_eval.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) eval_ast := method(ast, env, (ast type) switch( "MalSymbol", env at(ast val) ifNil(Exception raise("'" .. (ast val) "' not found")), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) EVAL := method(ast, env, // ("EVAL: " .. PRINT(ast)) println if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) el := eval_ast(ast, env) f := el at(0) args := el rest f callWithArgList(args) ) PRINT := method(exp, exp malPrint(true)) repl_env := Map with( "+", block(a, b, a + b), "-", block(a, b, a - b), "*", block(a, b, a * b), "/", block(a, b, a / b) ) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, ("Error: " .. (e error)) println ) ) ================================================ FILE: impls/io/step3_env.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) eval_ast := method(ast, env, (ast type) switch( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) return(EVAL(ast at(2), letEnv)) ) ) // Apply el := eval_ast(ast, env) f := el at(0) args := el rest f callWithArgList(args) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) repl_env set(MalSymbol with("+"), block(a, b, a + b)) repl_env set(MalSymbol with("-"), block(a, b, a - b)) repl_env set(MalSymbol with("*"), block(a, b, a * b)) repl_env set(MalSymbol with("/"), block(a, b, a / b)) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, ("Error: " .. (e error)) println ) ) ================================================ FILE: impls/io/step4_if_fn_do.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) eval_ast := method(ast, env, (ast type) switch( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", return(eval_ast(ast rest, env) last), "if", return(EVAL(if(EVAL(ast at(1), env), ast at(2), ast at(3)), env)), "fn*", return(block(a, EVAL(ast at(2), Env with(env, ast at(1), a)))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) return(EVAL(ast at(2), letEnv)) ) ) // Apply el := eval_ast(ast, env) f := el at(0) args := el rest f call(args) ) PRINT := method(exp, exp malPrint(true)) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) repl_env := Env with(nil) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/step5_tco.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) eval_ast := method(ast, env, (ast type) switch( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue // TCO ) ) // Apply el := eval_ast(ast, env) f := el at(0) args := el rest f type switch( "Block", return(f call(args)), "MalFunc", ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) repl_env := Env with(nil) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/step6_file.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) eval_ast := method(ast, env, (ast type) switch( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue // TCO ) ) // Apply el := eval_ast(ast, env) f := el at(0) args := el rest f type switch( "Block", return(f call(args)), "MalFunc", ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if(System args size > 1, REP("(load-file \"" .. (System args at(1)) .. "\")") System exit(0) ) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/step7_quote.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) 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, 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( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue, // TCO "quote", return(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue // TCO ) ) // Apply el := eval_ast(ast, env) f := el at(0) args := el rest f type switch( "Block", return(f call(args)), "MalFunc", ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if(System args size > 1, REP("(load-file \"" .. (System args at(1)) .. "\")") System exit(0) ) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/step8_macros.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) 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, 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( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue, // TCO "quote", return(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO "defmacro!", return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))) ) ) // Apply f := EVAL(ast at(0), env) raw_args := ast rest f type switch( "Block", args := eval_ast(raw_args, env) return(f call(args)), "MalFunc", if(f isMacro, ast = f blk call(raw_args) continue) // TCO args := eval_ast(raw_args, env) ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if(System args size > 1, REP("(load-file \"" .. (System args at(1)) .. "\")") System exit(0) ) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/step9_try.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) 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, 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( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue, // TCO "quote", return(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO "defmacro!", return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))), "try*", if(ast at(2) == nil, return(EVAL(ast at(1), env))) e := try(result := EVAL(ast at(1), env)) e catch(Exception, exc := if(e type == "MalException", e val, e error) catchAst := ast at(2) catchEnv := Env with(env) catchEnv set(catchAst at(1), exc) result := EVAL(catchAst at(2), catchEnv) ) return(result) ) ) // Apply f := EVAL(ast at(0), env) raw_args := ast rest f type switch( "Block", args := eval_ast(raw_args, env) return(f call(args)), "MalFunc", if(f isMacro, ast = f blk call(raw_args) continue) // TCO args := eval_ast(raw_args, env) ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) // core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if(System args size > 1, REP("(load-file \"" .. (System args at(1)) .. "\")") System exit(0) ) loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/stepA_mal.io ================================================ MalTypes MalReader READ := method(str, MalReader read_str(str)) 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, 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( "MalSymbol", env get(ast), "MalList", MalList with(ast map(a, EVAL(a, env))), "MalVector", MalVector with(ast map(a, EVAL(a, env))), "MalMap", m := MalMap clone ast foreach(k, v, m atPut(k, EVAL(v, env)) ) m, ast ) ) debugEvalSymbol := MalSymbol with("DEBUG-EVAL") EVAL := method(ast, env, loop( debugEvalEnv := env find(debugEvalSymbol) if((debugEvalEnv isNil not) and (debugEvalEnv get(debugEvalSymbol)), ("EVAL: " .. PRINT(ast)) println) if(ast type != "MalList", return(eval_ast(ast, env))) if(ast isEmpty, return ast) if(ast at(0) type == "MalSymbol", ast at(0) val switch( "def!", return(env set(ast at(1), EVAL(ast at(2), env))), "do", eval_ast(ast slice(1,-1), env) ast = ast last continue, // TCO "if", ast = if(EVAL(ast at(1), env), ast at(2), ast at(3)) continue, // TCO "fn*", return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))), "let*", letEnv := Env with(env) varName := nil ast at(1) foreach(i, e, if(i % 2 == 0, varName := e, letEnv set(varName, EVAL(e, letEnv)) ) ) ast = ast at(2) env = letEnv continue, // TCO "quote", return(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO "defmacro!", return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))), "try*", if(ast at(2) == nil, return(EVAL(ast at(1), env))) e := try(result := EVAL(ast at(1), env)) e catch(Exception, exc := if(e type == "MalException", e val, e error) catchAst := ast at(2) catchEnv := Env with(env) catchEnv set(catchAst at(1), exc) result := EVAL(catchAst at(2), catchEnv) ) return(result) ) ) // Apply f := EVAL(ast at(0), env) raw_args := ast rest f type switch( "Block", args := eval_ast(raw_args, env) return(f call(args)), "MalFunc", if(f isMacro, ast = f blk call(raw_args) continue) // TCO args := eval_ast(raw_args, env) ast = f ast env = Env with(f env, f params, args) continue, // TCO Exception raise("Unknown function type") ) ) ) PRINT := method(exp, exp malPrint(true)) repl_env := Env with(nil) RE := method(str, EVAL(READ(str), repl_env)) REP := method(str, PRINT(RE(str))) MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v)) repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env))) repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2))) // core.mal: defined using the language itself RE("(def! *host-language* \"io\")") RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if(System args size > 1, REP("(load-file \"" .. (System args at(1)) .. "\")") System exit(0) ) RE("(println (str \"Mal [\" *host-language* \"]\"))") loop( line := MalReadline readLine("user> ") if(line isNil, break) if(line isEmpty, continue) e := try(REP(line) println) e catch(Exception, if(e type == "MalException", ("Error: " .. ((e val) malPrint(true))) println, ("Error: " .. (e error)) println ) ) ) ================================================ FILE: impls/io/tests/step5_tco.mal ================================================ ;; Io: skipping non-TCO recursion ;; Reason: never completes, never segfaults ================================================ FILE: impls/io/tests/stepA_mal.mal ================================================ ;; Testing basic Io interop (io-eval "7") ;=>7 (io-eval "\"7\"") ;=>"7" (io-eval "123 == 123") ;=>true (io-eval "123 == 456") ;=>false (io-eval "list(7, 8, 9)") ;=>(7 8 9) (io-eval "Map with(\"abc\", 789)") ;=>{"abc" 789} (io-eval "\"hello\" println") ;/hello ;=>"hello" (io-eval "Lobby foo := 8") (io-eval "Lobby foo") ;=>8 (io-eval "list(\"a\", \"b\", \"c\") map(x, \"X\" .. x .. \"Y\") join(\" \")") ;=>"XaY XbY XcY" (io-eval "list(1, 2, 3) map(x, 1 + x)") ;=>(2 3 4) ================================================ FILE: impls/janet/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ ca-certificates wget RUN wget -O- \ https://github.com/janet-lang/janet/releases/download/v1.36.0/janet-v1.36.0-linux-x64.tar.gz \ | tar -xzC/opt RUN ln -sf /opt/janet-v1.36.0-linux/bin/janet /usr/local/bin/janet ================================================ FILE: impls/janet/Makefile ================================================ all: true ================================================ FILE: impls/janet/core.janet ================================================ (import ./types :as t) (import ./utils :as u) (import ./printer) (import ./reader) (defn deref* [ast] (if (not (t/atom?* ast)) (u/throw* (t/make-string (string "Expected atom, got: " (t/get-type ast)))) (t/get-value ast))) (defn reset!* [atom-ast val-ast] (t/set-atom-value! atom-ast val-ast) val-ast) (defn cons* [head-ast tail-ast] [head-ast ;(t/get-value tail-ast)]) (defn concat* [& list-asts] (reduce (fn [acc list-ast] [;acc ;(t/get-value list-ast)]) [] list-asts)) (defn nth* [coll-ast num-ast] (let [elts (t/get-value coll-ast) n-elts (length elts) i (t/get-value num-ast)] (if (< i n-elts) (in elts i) (u/throw* (t/make-string (string "Index out of range: " i)))))) (defn first* [coll-or-nil-ast] (if (or (t/nil?* coll-or-nil-ast) (t/empty?* coll-or-nil-ast)) t/mal-nil (in (t/get-value coll-or-nil-ast) 0))) (defn rest* [coll-or-nil-ast] (if (or (t/nil?* coll-or-nil-ast) (t/empty?* coll-or-nil-ast)) (t/make-list []) (t/make-list (slice (t/get-value coll-or-nil-ast) 1)))) (defn janet-eval* [janet-val] (case (type janet-val) :nil t/mal-nil ## :boolean (t/make-boolean janet-val) ## :number # XXX: there may be some incompatibilities (t/make-number janet-val) ## :string (t/make-string janet-val) ## :keyword # XXX: there may be some incompatibilities (t/make-keyword (string ":" janet-val)) ## :symbol # XXX: there may be some incompatibilities (t/make-symbol (string janet-val)) ## :tuple (t/make-list (map janet-eval* janet-val)) ## :array (t/make-list (map janet-eval* janet-val)) ## :struct (t/make-hash-map (struct ;(map janet-eval* (kvs janet-val)))) ## :table (t/make-hash-map (struct ;(map janet-eval* (kvs janet-val)))) ## (u/throw* (t/make-string (string "Unsupported type: " (type janet-val)))))) (defn arith-fn [op] (t/make-function (fn [asts] (t/make-number (op ;(map |(t/get-value $) asts)))))) (defn cmp-fn [op] (t/make-function (fn [asts] (if (op ;(map |(t/get-value $) asts)) t/mal-true t/mal-false)))) (def mal-symbol (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "symbol requires 1 argument"))) (t/make-symbol (t/get-value (in asts 0)))))) (def mal-keyword (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "keyword requires 1 argument"))) (let [arg-ast (in asts 0)] (cond (t/keyword?* arg-ast) arg-ast ## (t/string?* arg-ast) (t/make-keyword (string ":" (t/get-value arg-ast))) ## (u/throw* (t/make-string "Expected string"))))))) (def mal-list (t/make-function (fn [asts] (t/make-list asts)))) (def mal-vector (t/make-function (fn [asts] (t/make-vector asts)))) (def mal-vec (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "vec requires 1 argument"))) (let [ast (in asts 0)] (cond (t/vector?* ast) ast ## (t/list?* ast) (t/make-vector (t/get-value ast)) ## (t/nil?* ast) (t/make-vector ()) ## (u/throw* (t/make-string "vec requires a vector, list, or nil"))))))) (def mal-hash-map (t/make-function (fn [asts] (when (= 1 (% (length asts) 2)) (u/throw* (t/make-string "hash-map requires an even number of arguments"))) (t/make-hash-map asts)))) (def mal-atom (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "atom requires 1 argument"))) (t/make-atom (in asts 0))))) (def mal-nil? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "nil? requires 1 argument"))) (if (t/nil?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-true? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "true? requires 1 argument"))) (if (t/true?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-false? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "false? requires 1 argument"))) (if (t/false?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-number? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "number? requires 1 argument"))) (if (t/number?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-symbol? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "symbol? requires 1 argument"))) (if (t/symbol?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-keyword? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "keyword? requires 1 argument"))) (if (t/keyword?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-string? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "string? requires 1 argument"))) (if (t/string?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-list? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "list? requires 1 argument"))) (if (t/list?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-vector? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "vector? requires 1 argument"))) (if (t/vector?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-map? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "map? requires 1 argument"))) (if (t/hash-map?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-fn? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "fn? requires 1 argument"))) (let [target-ast (in asts 0)] (if (and (t/fn?* target-ast) (not (t/get-is-macro target-ast))) t/mal-true t/mal-false))))) (def mal-macro? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "macro? requires 1 argument"))) (let [the-ast (in asts 0)] (if (t/macro?* the-ast) t/mal-true t/mal-false))))) (def mal-atom? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "atom? requires 1 argument"))) (if (t/atom?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-sequential? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "sequential? requires 1 argument"))) (if (or (t/list?* (in asts 0)) (t/vector?* (in asts 0))) t/mal-true t/mal-false)))) (def mal-= (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "= requires 2 arguments"))) (let [ast-1 (in asts 0) ast-2 (in asts 1)] (if (t/equals?* ast-1 ast-2) t/mal-true t/mal-false))))) (def mal-empty? (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "empty? requires 1 argument"))) (if (t/empty?* (in asts 0)) t/mal-true t/mal-false)))) (def mal-contains? (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "contains? requires 2 arguments"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "contains? first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-struct (t/get-value head-ast) key-ast (in asts 1)] (if-let [val-ast (get item-struct key-ast)] t/mal-true t/mal-false))))))) (def mal-deref (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "deref requires 1 argument"))) (let [ast (in asts 0)] (deref* ast))))) (def mal-reset! (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "reset! requires 2 arguments"))) (let [atom-ast (in asts 0) val-ast (in asts 1)] (reset!* atom-ast val-ast))))) (def mal-swap! (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "swap! requires at least 2 arguments"))) (let [atom-ast (in asts 0) fn-ast (in asts 1) args-asts (slice asts 2) inner-ast (deref* atom-ast)] (reset!* atom-ast ((t/get-value fn-ast) [inner-ast ;args-asts])))))) (def mal-pr-str (t/make-function (fn [asts] (def buf @"") (when (> (length asts) 0) (each ast asts (buffer/push-string buf (printer/pr_str ast true)) (buffer/push-string buf " ")) # remove extra space at end (buffer/popn buf 1)) (t/make-string (string buf))))) (def mal-str (t/make-function (fn [asts] (def buf @"") (when (> (length asts) 0) (each ast asts (buffer/push-string buf (printer/pr_str ast false)))) (t/make-string (string buf))))) (def mal-prn (t/make-function (fn [asts] (def buf @"") (when (> (length asts) 0) (each ast asts (buffer/push-string buf (printer/pr_str ast true)) (buffer/push-string buf " ")) # remove extra space at end (buffer/popn buf 1)) (print (string buf)) t/mal-nil))) (def mal-println (t/make-function (fn [asts] (def buf @"") (when (> (length asts) 0) (each ast asts (buffer/push-string buf (printer/pr_str ast false)) (buffer/push-string buf " ")) # remove extra space at end (buffer/popn buf 1)) (print (string buf)) t/mal-nil))) (def mal-read-string (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "read-string requires 1 argument"))) (if-let [res (reader/read_str (t/get-value (in asts 0)))] res (u/throw* (t/make-string "No code content")))))) (def mal-slurp (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "slurp requires 1 argument"))) (let [a-str (t/get-value (in asts 0))] (if (not (os/stat a-str)) (u/throw* (string "File not found: " a-str)) # XXX: escaping? (t/make-string (slurp a-str))))))) (def mal-count (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "count requires 1 argument"))) (let [ast (in asts 0)] (if (t/nil?* ast) (t/make-number 0) (t/make-number (length (t/get-value ast)))))))) (def mal-cons (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "cons requires 2 arguments"))) (let [head-ast (in asts 0) tail-ast (in asts 1)] (t/make-list (cons* head-ast tail-ast)))))) (def mal-concat (t/make-function (fn [asts] (t/make-list (concat* ;asts))))) (def mal-nth (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "nth requires 2 arguments"))) (let [coll-ast (in asts 0) num-ast (in asts 1)] (nth* coll-ast num-ast))))) (def mal-first (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "first requires 1 argument"))) (let [coll-or-nil-ast (in asts 0)] (first* coll-or-nil-ast))))) (def mal-rest (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "rest requires 1 argument"))) (let [coll-or-nil-ast (in asts 0)] (rest* coll-or-nil-ast))))) (def mal-assoc (t/make-function (fn [asts] (when (< (length asts) 3) (u/throw* (t/make-string "assoc requires at least 3 arguments"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "assoc first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-table (table ;(kvs (t/get-value head-ast))) kv-asts (slice asts 1 -1)] (each [key-ast val-ast] (partition 2 kv-asts) (put item-table key-ast val-ast)) (t/make-hash-map (table/to-struct item-table)))))))) (def mal-dissoc (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "dissoc requires at least 2 arguments"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "dissoc first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-table (table ;(kvs (t/get-value head-ast))) key-asts (slice asts 1 -1)] (each key-ast key-asts (put item-table key-ast nil)) (t/make-hash-map (table/to-struct item-table)))))))) (def mal-get (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "get requires 2 arguments"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "get first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-struct (t/get-value head-ast) key-ast (in asts 1)] (if-let [val-ast (get item-struct key-ast)] val-ast t/mal-nil))))))) (def mal-keys (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "keys requires 1 argument"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "keys first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-struct (t/get-value head-ast)] (t/make-list (keys item-struct)))))))) (def mal-vals (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "vals requires 1 argument"))) (let [head-ast (in asts 0)] (when (not (or (t/hash-map?* head-ast) (t/nil?* head-ast))) (u/throw* (t/make-string "vals first argument should be a hash-map or nil"))) (if (t/nil?* head-ast) t/mal-nil (let [item-struct (t/get-value head-ast)] (t/make-list (values item-struct)))))))) (def mal-conj (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "conj requires at least 2 arguments"))) (let [coll-ast (in asts 0) item-asts (slice asts 1)] (cond (t/nil?* coll-ast) (t/make-list [;(reverse item-asts)]) ## (t/list?* coll-ast) (t/make-list [;(reverse item-asts) ;(t/get-value coll-ast)]) ## (t/vector?* coll-ast) (t/make-vector [;(t/get-value coll-ast) ;item-asts]) ## (u/throw* (t/make-string "Expected list or vector"))))))) (def mal-seq (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "seq requires 1 argument"))) (let [arg-ast (in asts 0)] (cond (t/list?* arg-ast) (if (t/empty?* arg-ast) t/mal-nil arg-ast) ## (t/vector?* arg-ast) (if (t/empty?* arg-ast) t/mal-nil (t/make-list (t/get-value arg-ast))) ## (t/string?* arg-ast) (if (t/empty?* arg-ast) t/mal-nil (let [str-asts (map |(t/make-string (string/from-bytes $)) (t/get-value arg-ast))] (t/make-list str-asts))) ## (t/nil?* arg-ast) arg-ast ## (u/throw* (t/make-string "Expected list, vector, string, or nil"))))))) (def mal-map (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "map requires at least 2 arguments"))) (let [the-fn (t/get-value (in asts 0)) coll (t/get-value (in asts 1))] (t/make-list (map |(the-fn [$]) coll)))))) # (apply F A B [C D]) is equivalent to (F A B C D) (def mal-apply (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "apply requires at least 1 argument"))) (let [the-fn (t/get-value (in asts 0))] # e.g. F (if (= (length asts) 1) (the-fn []) (let [last-asts (t/get-value (get (slice asts -2) 0)) # e.g. [C D] args-asts (slice asts 1 -2)] # e.g. [A B] (the-fn [;args-asts ;last-asts]))))))) (def mal-meta (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "meta requires 1 argument"))) (let [head-ast (in asts 0)] (if (or (t/list?* head-ast) (t/vector?* head-ast) (t/hash-map?* head-ast) (t/fn?* head-ast)) (t/get-meta (in asts 0)) t/mal-nil))))) (def mal-with-meta (t/make-function (fn [asts] (when (< (length asts) 2) (u/throw* (t/make-string "with-meta requires 2 arguments"))) (let [target-ast (in asts 0) meta-ast (in asts 1)] (cond (t/list?* target-ast) (t/make-list (t/get-value target-ast) meta-ast) ## (t/vector?* target-ast) (t/make-vector (t/get-value target-ast) meta-ast) ## (t/hash-map?* target-ast) (t/make-hash-map (t/get-value target-ast) meta-ast) ## (t/fn?* target-ast) (t/clone-with-meta target-ast meta-ast) ## (u/throw* (t/make-string "Expected list, vector, hash-map, or fn"))))))) (def mal-throw (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "throw requires 1 argument"))) (u/throw* (in asts 0))))) (def mal-readline (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "readline requires 1 argument"))) (let [prompt (t/get-value (in asts 0)) buf @""] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf) (if (< 0 (length buf)) (t/make-string (string/trimr buf)) t/mal-nil))))) (def mal-time-ms (t/make-function (fn [asts] (t/make-number (math/floor (* 1000 (os/clock))))))) (def mal-janet-eval (t/make-function (fn [asts] (when (< (length asts) 1) (u/throw* (t/make-string "janet-eval requires 1 argument"))) (let [head-ast (in asts 0)] (when (not (t/string?* head-ast)) (u/throw* (t/make-string "janet-eval first argument should be a string"))) (let [res (try (eval-string (t/get-value head-ast)) # XXX: escaping? ([err] (u/throw* (t/make-string (string "Eval failed: " err)))))] (janet-eval* res)))))) (def unimplemented mal-throw) (def ns {(t/make-symbol "+") (arith-fn +) (t/make-symbol "-") (arith-fn -) (t/make-symbol "*") (arith-fn *) (t/make-symbol "/") (arith-fn /) (t/make-symbol "list") mal-list (t/make-symbol "list?") mal-list? (t/make-symbol "vec") mal-vec (t/make-symbol "vector?") mal-vector? (t/make-symbol "empty?") mal-empty? (t/make-symbol "count") mal-count (t/make-symbol "=") mal-= (t/make-symbol "<") (cmp-fn <) (t/make-symbol "<=") (cmp-fn <=) (t/make-symbol ">") (cmp-fn >) (t/make-symbol ">=") (cmp-fn >=) (t/make-symbol "pr-str") mal-pr-str (t/make-symbol "str") mal-str (t/make-symbol "prn") mal-prn (t/make-symbol "println") mal-println (t/make-symbol "read-string") mal-read-string (t/make-symbol "slurp") mal-slurp (t/make-symbol "atom") mal-atom (t/make-symbol "atom?") mal-atom? (t/make-symbol "deref") mal-deref (t/make-symbol "reset!") mal-reset! (t/make-symbol "swap!") mal-swap! (t/make-symbol "cons") mal-cons (t/make-symbol "concat") mal-concat (t/make-symbol "nth") mal-nth (t/make-symbol "first") mal-first (t/make-symbol "rest") mal-rest (t/make-symbol "throw") mal-throw (t/make-symbol "apply") mal-apply (t/make-symbol "map") mal-map (t/make-symbol "nil?") mal-nil? (t/make-symbol "true?") mal-true? (t/make-symbol "false?") mal-false? (t/make-symbol "symbol?") mal-symbol? (t/make-symbol "symbol") mal-symbol (t/make-symbol "keyword") mal-keyword (t/make-symbol "keyword?") mal-keyword? (t/make-symbol "vector") mal-vector (t/make-symbol "sequential?") mal-sequential? (t/make-symbol "hash-map") mal-hash-map (t/make-symbol "map?") mal-map? (t/make-symbol "assoc") mal-assoc (t/make-symbol "dissoc") mal-dissoc (t/make-symbol "get") mal-get (t/make-symbol "contains?") mal-contains? (t/make-symbol "keys") mal-keys (t/make-symbol "vals") mal-vals (t/make-symbol "readline") mal-readline (t/make-symbol "time-ms") mal-time-ms (t/make-symbol "meta") mal-meta (t/make-symbol "with-meta") mal-with-meta (t/make-symbol "fn?") mal-fn? (t/make-symbol "string?") mal-string? (t/make-symbol "number?") mal-number? (t/make-symbol "conj") mal-conj (t/make-symbol "seq") mal-seq (t/make-symbol "macro?") mal-macro? (t/make-symbol "janet-eval") mal-janet-eval }) ================================================ FILE: impls/janet/env.janet ================================================ (import ./types :as t) (import ./utils :as u) (defn make-env [&opt outer binds exprs] (default binds []) (default exprs []) (def n-binds (length binds)) (var found-amp false) (var idx 0) (while (and (not found-amp) (< idx n-binds)) (def c-bind (in binds idx)) (when (= (t/get-value c-bind) "&") (set found-amp true) (break)) (++ idx)) (def new-binds (if found-amp (array/concat (array ;(slice binds 0 idx)) (in binds (inc idx))) binds)) (def new-exprs (if found-amp (array/concat (array ;(slice exprs 0 idx)) (array (t/make-list (slice exprs idx)))) exprs)) # XXX: would length mismatches of new-binds / new-exprs ever be an issue? @{:data (zipcoll new-binds new-exprs) :outer outer}) (defn env-set [env sym value] (put-in env [:data sym] value)) (defn env-get [env sym] (or (get-in env [:data sym]) (if-let [outer (get env :outer)] (env-get outer sym)))) ================================================ FILE: impls/janet/printer.janet ================================================ (import ./types :as t) (defn escape [a-str] (->> (buffer a-str) (peg/replace-all "\\" "\\\\") (peg/replace-all "\"" "\\\"") (peg/replace-all "\n" "\\n") string)) (defn code* [ast buf print_readably] (cond (or (t/boolean?* ast) (t/nil?* ast) (t/keyword?* ast) (t/symbol?* ast)) (buffer/push-string buf (t/get-value ast)) ## (t/number?* ast) (buffer/push-string buf (string (t/get-value ast))) ## (t/string?* ast) (if print_readably (buffer/push-string buf (string "\"" (escape (t/get-value ast)) "\"")) (buffer/push-string buf (t/get-value ast))) ## (t/list?* ast) (do (buffer/push-string buf "(") (var remove false) (each elt (t/get-value ast) (code* elt buf print_readably) (buffer/push-string buf " ") (set remove true)) (when remove (buffer/popn buf 1)) (buffer/push-string buf ")")) ## (t/hash-map?* ast) (do (buffer/push-string buf "{") (var remove false) (eachp [k v] (t/get-value ast) (code* k buf print_readably) (buffer/push-string buf " ") (code* v buf print_readably) (buffer/push-string buf " ") (set remove true)) (when remove (buffer/popn buf 1)) (buffer/push-string buf "}")) ## (t/vector?* ast) (do (buffer/push-string buf "[") (var remove false) (each elt (t/get-value ast) (code* elt buf print_readably) (buffer/push-string buf " ") (set remove true)) (when remove (buffer/popn buf 1)) (buffer/push-string buf "]")) ## XXX: what about macro? (t/fn?* ast) (buffer/push-string buf "#") ## (t/atom?* ast) (do (buffer/push-string buf "(atom ") (code* (t/get-value ast) buf print_readably) (buffer/push-string buf ")")) ## (t/exception?* ast) (do (buffer/push-string buf "Error: ") (code* (t/get-value ast) buf print_readably)))) (comment (let [buf @""] (code* (make-number 1) buf false)) # => @"1" ) (defn pr_str [ast print_readably] (let [buf @""] (code* ast buf print_readably) buf)) (comment (pr_str (make-number 1) false) # => @"1" ) ================================================ FILE: impls/janet/reader.janet ================================================ (import ./types :as t) (import ./utils :as u) (def grammar ~{:main (capture (some :input)) :input (choice :gap :form) :gap (choice :ws :comment) :ws (set " \f\n\r\t,") :comment (sequence ";" (any (if-not (set "\r\n") 1))) :form (choice :boolean :nil :number :keyword :symbol :string :list :vector :hash-map :deref :quasiquote :quote :splice-unquote :unquote :with-meta) :name-char (if-not (set " \f\n\r\t,[]{}()'`~^@\";") 1) :boolean (sequence (choice "false" "true") (not :name-char)) :nil (sequence "nil" (not :name-char)) :number (drop (cmt (capture (some :name-char)) ,scan-number)) :keyword (sequence ":" (any :name-char)) :symbol (some :name-char) :string (sequence "\"" (any (if-not (set "\"\\") 1)) (any (sequence "\\" 1 (any (if-not (set "\"\\") 1)))) (choice "\"" (error (constant "unbalanced \"")))) :hash-map (sequence "{" (any :input) (choice "}" (error (constant "unbalanced }")))) :list (sequence "(" (any :input) (choice ")" (error (constant "unbalanced )")))) :vector (sequence "[" (any :input) (choice "]" (error (constant "unbalanced ]")))) :deref (sequence "@" :form) :quasiquote (sequence "`" :form) :quote (sequence "'" :form) :splice-unquote (sequence "~@" :form) :unquote (sequence "~" :form) :with-meta (sequence "^" :form (some :gap) :form) } ) (comment (peg/match grammar " ") # => @[" "] (peg/match grammar "; hello") # => @["; hello"] (peg/match grammar "true") # => @["true"] (peg/match grammar "false") # => @["false"] (peg/match grammar "nil") # => @["nil"] (peg/match grammar "18") # => @["18"] (peg/match grammar "sym") # => @["sym"] (peg/match grammar ":alpha") # => @[":alpha"] (peg/match grammar "\"a string\"") # => @["\"a string\""] (peg/match grammar "(+ 1 2)") # => @["(+ 1 2)"] (peg/match grammar "[:a :b :c]") # => @["[:a :b :c]"] (peg/match grammar "{:a 1 :b 2}") # => @{"{:a 1 :b 2}"] ) (defn unescape [a-str] (->> a-str (peg/replace-all "\\\\" "\u029e") # XXX: a hack? (peg/replace-all "\\\"" "\"") (peg/replace-all "\\n" "\n") (peg/replace-all "\u029e" "\\") string)) (def enlive-grammar (let [cg (table ;(kvs grammar))] (each kwd [# :comment # XX: don't capture comments :boolean :keyword :nil :symbol # :ws # XXX: dont' capture whitespace ] (put cg kwd ~(cmt (capture ,(in cg kwd)) ,|{:tag (keyword kwd) :content $}))) (put cg :number ~(cmt (capture ,(in cg :number)) ,|{:tag :number :content (scan-number $)})) (put cg :string ~(cmt (capture ,(in cg :string)) ,|{:tag :string # discard surrounding double quotes :content (unescape (slice $ 1 -2))})) (each kwd [:deref :quasiquote :quote :splice-unquote :unquote] (put cg kwd ~(cmt (capture ,(in cg kwd)) ,|{:tag :list :content [{:tag :symbol :content (string kwd)} ;(slice $& 0 -2)]}))) (each kwd [:list :vector] (put cg kwd (tuple # array needs to be converted ;(put (array ;(in cg kwd)) 2 ~(cmt (capture ,(get-in cg [kwd 2])) ,|{:tag (keyword kwd) :content (slice $& 0 -2)}))))) (put cg :hash-map (tuple # array needs to be converted ;(put (array ;(in cg :hash-map)) 2 ~(cmt (capture ,(get-in cg [:hash-map 2])) ,|{:tag :hash-map :content (struct ;(slice $& 0 -2))})))) (put cg :with-meta ~(cmt (capture ,(in cg :with-meta)) ,|{:tag :list :content [{:tag :symbol :content "with-meta"} (get $& 1) (get $& 0)]})) # tried using a table with a peg but had a problem, so use a struct (table/to-struct cg))) (comment (peg/match enlive-grammar "nil") # => @[{:content "nil" :tag :nil} "nil"] (peg/match enlive-grammar "true") # => @[{:content "true" :tag :boolean} "true"] (peg/match enlive-grammar ":hi") # => @[{:content ":hi" :tag :keyword} ":hi"] (peg/match enlive-grammar "sym") # => @[{:content "sym" :tag :symbol} "sym"] (peg/match enlive-grammar "'a") `` '@[{:content ({:content "quote" :tag :symbol} {:content "a" :tag :symbol}) :tag :list} "'a"] `` (peg/match enlive-grammar "@a") `` '@[{:content ({:content "deref" :tag :symbol} {:content "a" :tag :symbol}) :tag :list} "@a"] `` (peg/match enlive-grammar "`a") `` '@[{:content ({:content "quasiquote" :tag :symbol} {:content "a" :tag :symbol}) :tag :list} "`a"] `` (peg/match enlive-grammar "~a") `` '@[{:content ({:content "unquote" :tag :symbol} {:content "a" :tag :symbol}) :tag :list} "~a"] `` (peg/match enlive-grammar "~@a") `` '@[{:content ({:content "splice-unquote" :tag :symbol} {:content "a" :tag :symbol}) :tag :list} "~@a"] `` (peg/match enlive-grammar "(a b c)") `` '@[{:content ({:content "a" :tag :symbol} {:content "b" :tag :symbol} {:content "c" :tag :symbol}) :tag :list} "(a b c)"] `` (peg/match enlive-grammar "(a [:x :y] c)") `` '@[{:content ({:content "a" :tag :symbol} {:content ({:content ":x" :tag :keyword} {:content ":y" :tag :keyword}) :tag :vector} {:content "c" :tag :symbol}) :tag :list} "(a [:x :y] c)"] `` (peg/match enlive-grammar "^{:a 1} [:x :y]") `` '@[{:content ({:content "with-meta" :tag :symbol} {:content ({:content ":x" :tag :keyword} {:content ":y" :tag :keyword}) :tag :vector} {:content {{:content ":a" :tag :keyword} {:content "1" :tag :number}} :tag :hash-map}) :tag :list} "^{:a 1} [:x :y]"] `` (peg/match enlive-grammar ";; hi") # => @[";; hi"] (peg/match enlive-grammar "[:x ;; hi\n :y]") `` '@[{:content ({:content ":x" :tag :keyword} {:content ":y" :tag :keyword}) :tag :vector} "[:x ;; hi\n :y]"] `` (peg/match enlive-grammar " 7 ") # => @[{:content 7 :tag :number} " 7 "] (peg/match enlive-grammar " abc ") # => @[{:content "abc" :tag :symbol} " abc "] (peg/match enlive-grammar " \nabc ") # => @[{:content "abc" :tag :symbol} " \nabc "] ) (defn read_str [code-str] (let [[parsed _] (try (peg/match enlive-grammar code-str) ([err] (u/throw* (t/make-string err))))] (if (= (type parsed) :struct) parsed (u/throw* t/mal-nil)))) (comment (read_str "(+ 1 2)") `` '{:content ({:content "+" :tag :symbol} {:content 1 :tag :number} {:content 2 :tag :number}) :tag :list} `` (read_str ";; hello") # => nil (read_str "\"1\"") # => {:content "1" :tag :string} ) ================================================ FILE: impls/janet/run ================================================ #!/bin/sh exec janet $(dirname $0)/${STEP:-stepA_mal}.janet "${@}" ================================================ FILE: impls/janet/step0_repl.janet ================================================ (defn READ [code-str] code-str) (defn EVAL [ast] ast) (defn PRINT [ast] ast) (defn rep [code-str] (PRINT (EVAL (READ code-str)))) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (< 0 (length buf)) (prin (rep buf)) (break)))) ================================================ FILE: impls/janet/step1_read_print.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (defn READ [code-str] (reader/read_str code-str)) (defn EVAL [ast] ast) (defn PRINT [value] (printer/pr_str value true)) (defn rep [code-str] (PRINT (EVAL (READ code-str)))) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err)))))) ================================================ FILE: impls/janet/step2_eval.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (defn READ [code-str] (reader/read_str code-str)) (defn arith-fn [op] (fn [ast-1 ast-2] (t/make-number (op (t/get-value ast-1) (t/get-value ast-2))))) (def repl_env {(t/make-symbol "+") (arith-fn +) (t/make-symbol "-") (arith-fn -) (t/make-symbol "*") (arith-fn *) (t/make-symbol "/") (arith-fn /)}) (var EVAL nil) (defn EVAL [ast env] # (print (string "EVAL: " (printer/pr_str ast true))) (case (t/get-type ast) :symbol (or (env ast) (error (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast))))) :vector (t/make-vector (map |(EVAL $0 env) (t/get-value ast))) :list (if (t/empty?* ast) ast (let [ast-head (in (t/get-value ast) 0) f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] (apply f args))) # Neither a list, map, symbol or vector. ast)) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err)))))) ================================================ FILE: impls/janet/step3_env.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (defn READ [code-str] (reader/read_str code-str)) (defn arith-fn [op] (fn [ast-1 ast-2] (t/make-number (op (t/get-value ast-1) (t/get-value ast-2))))) (def repl_env (let [env (e/make-env)] (e/env-set env (t/make-symbol "+") (arith-fn +)) (e/env-set env (t/make-symbol "-") (arith-fn -)) (e/env-set env (t/make-symbol "*") (arith-fn *)) (e/env-set env (t/make-symbol "/") (arith-fn /)) env)) (var EVAL nil) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast env] (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (or (e/env-get env ast) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast))))) :vector (t/make-vector (map |(EVAL $0 env) (t/get-value ast))) :list (if (t/empty?* ast) ast (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) def-val) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) (EVAL (in (t/get-value ast) 2) new-env)) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] (apply f args))))) # Neither a list, map, symbol or vector. ast)) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err)))))) ================================================ FILE: impls/janet/step4_if_fn_do.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast env] (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (or (e/env-get env ast) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast))))) :vector (t/make-vector (map |(EVAL $0 env) (t/get-value ast))) :list (if (t/empty?* ast) ast (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) def-val) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) (EVAL (in (t/get-value ast) 2) new-env)) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) (EVAL last-body-form env)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] (EVAL else-ast env) t/mal-nil) (EVAL (in (t/get-value ast) 2) env))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] (t/make-function (fn [args] (EVAL body (e/make-env env params args))))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] ((t/get-value f) args))))) # Neither a list, map, symbol or vector. ast)) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err)))))) ================================================ FILE: impls/janet/step5_tco.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err)))))) ================================================ FILE: impls/janet/step6_file.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e/env-set repl_env (t/make-symbol "eval") (t/make-function (fn [asts] (EVAL (in asts 0) repl_env)))) (rep `` (def! load-file (fn* (fpath) (eval (read-string (str "(do " (slurp fpath) "\n" "nil)"))))) ``) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (let [args-len (length args) argv (if (<= 2 args-len) (drop 2 args) ())] (e/env-set repl_env (t/make-symbol "*ARGV*") (t/make-list (map t/make-string argv))) (if (< 1 args-len) (try (rep (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? ([err] (handle-error err))) (do (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err))))))))) ================================================ FILE: impls/janet/step7_quote.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (defn starts-with [ast name] (when (and (t/list?* ast) (not (t/empty?* ast))) (let [head-ast (in (t/get-value ast) 0)] (and (t/symbol?* head-ast) (= name (t/get-value head-ast)))))) (var quasiquote* nil) (defn qq-iter [ast] (if (t/empty?* ast) (t/make-list ()) (let [elt (in (t/get-value ast) 0) acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] (if (starts-with elt "splice-unquote") (t/make-list [(t/make-symbol "concat") (in (t/get-value elt) 1) acc]) (t/make-list [(t/make-symbol "cons") (quasiquote* elt) acc]))))) (varfn quasiquote* [ast] (cond (starts-with ast "unquote") (in (t/get-value ast) 1) ## (t/list?* ast) (qq-iter ast) ## (t/vector?* ast) (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) ## (or (t/symbol?* ast) (t/hash-map?* ast)) (t/make-list [(t/make-symbol "quote") ast]) ## ast)) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "quote" (return result (in (t/get-value ast) 1)) ## "quasiquote" ## tco (set ast (quasiquote* (in (t/get-value ast) 1))) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast)) args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e/env-set repl_env (t/make-symbol "eval") (t/make-function (fn [asts] (EVAL (in asts 0) repl_env)))) (rep `` (def! load-file (fn* (fpath) (eval (read-string (str "(do " (slurp fpath) "\n" "nil)"))))) ``) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (let [args-len (length args) argv (if (<= 2 args-len) (drop 2 args) ())] (e/env-set repl_env (t/make-symbol "*ARGV*") (t/make-list (map t/make-string argv))) (if (< 1 args-len) (try (rep (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? ([err] (handle-error err))) (do (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err))))))))) ================================================ FILE: impls/janet/step8_macros.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (defn starts-with [ast name] (when (and (t/list?* ast) (not (t/empty?* ast))) (let [head-ast (in (t/get-value ast) 0)] (and (t/symbol?* head-ast) (= name (t/get-value head-ast)))))) (var quasiquote* nil) (defn qq-iter [ast] (if (t/empty?* ast) (t/make-list ()) (let [elt (in (t/get-value ast) 0) acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] (if (starts-with elt "splice-unquote") (t/make-list [(t/make-symbol "concat") (in (t/get-value elt) 1) acc]) (t/make-list [(t/make-symbol "cons") (quasiquote* elt) acc]))))) (varfn quasiquote* [ast] (cond (starts-with ast "unquote") (in (t/get-value ast) 1) ## (t/list?* ast) (qq-iter ast) ## (t/vector?* ast) (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) ## (or (t/symbol?* ast) (t/hash-map?* ast)) (t/make-list [(t/make-symbol "quote") ast]) ## ast)) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "defmacro!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env) macro-ast (t/macrofy def-val)] (e/env-set env def-name macro-ast) (return result macro-ast)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "quote" (return result (in (t/get-value ast) 1)) ## "quasiquote" ## tco (set ast (quasiquote* (in (t/get-value ast) 1))) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast))] (if (t/macro?* f) (set ast ((t/get-value f) raw-args)) (let [args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e/env-set repl_env (t/make-symbol "eval") (t/make-function (fn [asts] (EVAL (in asts 0) repl_env)))) (rep `` (def! load-file (fn* (fpath) (eval (read-string (str "(do " (slurp fpath) "\n" "nil)"))))) ``) (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))))))) ``) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (let [args-len (length args) argv (if (<= 2 args-len) (drop 2 args) ())] (e/env-set repl_env (t/make-symbol "*ARGV*") (t/make-list (map t/make-string argv))) (if (< 1 args-len) (try (rep (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? ([err] (handle-error err))) (do (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err))))))))) ================================================ FILE: impls/janet/step9_try.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (defn starts-with [ast name] (when (and (t/list?* ast) (not (t/empty?* ast))) (let [head-ast (in (t/get-value ast) 0)] (and (t/symbol?* head-ast) (= name (t/get-value head-ast)))))) (var quasiquote* nil) (defn qq-iter [ast] (if (t/empty?* ast) (t/make-list ()) (let [elt (in (t/get-value ast) 0) acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] (if (starts-with elt "splice-unquote") (t/make-list [(t/make-symbol "concat") (in (t/get-value elt) 1) acc]) (t/make-list [(t/make-symbol "cons") (quasiquote* elt) acc]))))) (varfn quasiquote* [ast] (cond (starts-with ast "unquote") (in (t/get-value ast) 1) ## (t/list?* ast) (qq-iter ast) ## (t/vector?* ast) (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) ## (or (t/symbol?* ast) (t/hash-map?* ast)) (t/make-list [(t/make-symbol "quote") ast]) ## ast)) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "defmacro!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env) macro-ast (t/macrofy def-val)] (e/env-set env def-name macro-ast) (return result macro-ast)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "quote" (return result (in (t/get-value ast) 1)) ## "quasiquote" ## tco (set ast (quasiquote* (in (t/get-value ast) 1))) ## "try*" (let [res (try (EVAL (in (t/get-value ast) 1) env) ([err] (if-let [maybe-catch-ast (get (t/get-value ast) 2)] (if (starts-with maybe-catch-ast "catch*") (let [catch-asts (t/get-value maybe-catch-ast)] (if (>= (length catch-asts) 2) (let [catch-sym-ast (in catch-asts 1) catch-body-ast (in catch-asts 2)] (EVAL catch-body-ast (e/make-env env [catch-sym-ast] [err]))) (u/throw* (t/make-string "catch* requires at least 2 arguments")))) (u/throw* (t/make-string "Expected catch* form"))) # XXX: is this appropriate? show error message? (u/throw* err))))] (return result res)) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast))] (if (t/macro?* f) (set ast ((t/get-value f) raw-args)) (let [args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e/env-set repl_env (t/make-symbol "eval") (t/make-function (fn [asts] (EVAL (in asts 0) repl_env)))) (rep `` (def! load-file (fn* (fpath) (eval (read-string (str "(do " (slurp fpath) "\n" "nil)"))))) ``) (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))))))) ``) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (let [args-len (length args) argv (if (<= 2 args-len) (drop 2 args) ())] (e/env-set repl_env (t/make-symbol "*ARGV*") (t/make-list (map t/make-string argv))) (if (< 1 args-len) (try (rep (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? ([err] (handle-error err))) (do (var buf nil) (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err))))))))) ================================================ FILE: impls/janet/stepA_mal.janet ================================================ (import ./reader) (import ./printer) (import ./types :as t) (import ./utils :as u) (import ./env :as e) (import ./core) (def repl_env (let [env (e/make-env)] (eachp [k v] core/ns (e/env-set env k v)) env)) (defn READ [code-str] (reader/read_str code-str)) (var EVAL nil) (defn starts-with [ast name] (when (and (t/list?* ast) (not (t/empty?* ast))) (let [head-ast (in (t/get-value ast) 0)] (and (t/symbol?* head-ast) (= name (t/get-value head-ast)))))) (var quasiquote* nil) (defn qq-iter [ast] (if (t/empty?* ast) (t/make-list ()) (let [elt (in (t/get-value ast) 0) acc (qq-iter (t/make-list (slice (t/get-value ast) 1)))] (if (starts-with elt "splice-unquote") (t/make-list [(t/make-symbol "concat") (in (t/get-value elt) 1) acc]) (t/make-list [(t/make-symbol "cons") (quasiquote* elt) acc]))))) (varfn quasiquote* [ast] (cond (starts-with ast "unquote") (in (t/get-value ast) 1) ## (t/list?* ast) (qq-iter ast) ## (t/vector?* ast) (t/make-list [(t/make-symbol "vec") (qq-iter ast)]) ## (or (t/symbol?* ast) (t/hash-map?* ast)) (t/make-list [(t/make-symbol "quote") ast]) ## ast)) (var DEBUG-EVAL (t/make-symbol "DEBUG-EVAL")) (varfn EVAL [ast-param env-param] (var ast ast-param) (var env env-param) (label result (while true (if-let [dbgeval (e/env-get env DEBUG-EVAL)] (if (not (or (t/nil?* dbgeval) (t/false?* dbgeval))) (print (string "EVAL: " (printer/pr_str ast true))))) (case (t/get-type ast) :symbol (if-let [value (e/env-get env ast)] (return result value) (u/throw* (t/make-string (string "'" (t/get-value ast) "'" " not found" )))) :hash-map (return result (t/make-hash-map (struct ;(map |(EVAL $0 env) (kvs (t/get-value ast)))))) :vector (return result (t/make-vector (map |(EVAL $0 env) (t/get-value ast)))) :list (if (t/empty?* ast) (return result ast) (let [ast-head (in (t/get-value ast) 0) head-name (t/get-value ast-head)] (case head-name "def!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env)] (e/env-set env def-name def-val) (return result def-val)) ## "defmacro!" (let [def-name (in (t/get-value ast) 1) def-val (EVAL (in (t/get-value ast) 2) env) macro-ast (t/macrofy def-val)] (e/env-set env def-name macro-ast) (return result macro-ast)) ## "let*" (let [new-env (e/make-env env) bindings (t/get-value (in (t/get-value ast) 1))] (each [let-name let-val] (partition 2 bindings) (e/env-set new-env let-name (EVAL let-val new-env))) ## tco (set ast (in (t/get-value ast) 2)) (set env new-env)) ## "quote" (return result (in (t/get-value ast) 1)) ## "quasiquote" ## tco (set ast (quasiquote* (in (t/get-value ast) 1))) ## "try*" (let [res (try (EVAL (in (t/get-value ast) 1) env) ([err] (if-let [maybe-catch-ast (get (t/get-value ast) 2)] (if (starts-with maybe-catch-ast "catch*") (let [catch-asts (t/get-value maybe-catch-ast)] (if (>= (length catch-asts) 2) (let [catch-sym-ast (in catch-asts 1) catch-body-ast (in catch-asts 2)] (EVAL catch-body-ast (e/make-env env [catch-sym-ast] [err]))) (u/throw* (t/make-string "catch* requires at least 2 arguments")))) (u/throw* (t/make-string "Expected catch* form"))) # XXX: is this appropriate? show error message? (u/throw* err))))] (return result res)) ## "do" (let [most-do-body-forms (slice (t/get-value ast) 1 -2) last-body-form (last (t/get-value ast))] (each x most-do-body-forms (EVAL x env)) ## tco (set ast last-body-form)) ## "if" (let [cond-res (EVAL (in (t/get-value ast) 1) env)] (if (or (t/nil?* cond-res) (t/false?* cond-res)) (if-let [else-ast (get (t/get-value ast) 3)] ## tco (set ast else-ast) (return result t/mal-nil)) ## tco (set ast (in (t/get-value ast) 2)))) ## "fn*" (let [params (t/get-value (in (t/get-value ast) 1)) body (in (t/get-value ast) 2)] ## tco (return result (t/make-function (fn [args] (EVAL body (e/make-env env params args))) nil false body params env))) ## (let [f (EVAL ast-head env) raw-args (drop 1 (t/get-value ast))] (if (t/macro?* f) (set ast ((t/get-value f) raw-args)) (let [args (map |(EVAL $0 env) raw-args)] (if-let [body (t/get-ast f)] ## tco (do (set ast body) (set env (e/make-env (t/get-env f) (t/get-params f) args))) (return result ((t/get-value f) args))))))))) # Neither a list, map, symbol or vector. (return result ast))))) (defn PRINT [ast] (printer/pr_str ast true)) (defn rep [code-str] (PRINT (EVAL (READ code-str) repl_env))) (rep "(def! not (fn* (a) (if a false true)))") (e/env-set repl_env (t/make-symbol "eval") (t/make-function (fn [asts] (EVAL (in asts 0) repl_env)))) (rep `` (def! load-file (fn* (fpath) (eval (read-string (str "(do " (slurp fpath) "\n" "nil)"))))) ``) (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))))))) ``) (e/env-set repl_env (t/make-symbol "*host-language*") (t/make-string "janet")) # getline gives problems (defn getstdin [prompt buf] (file/write stdout prompt) (file/flush stdout) (file/read stdin :line buf)) (defn handle-error [err] (cond (t/nil?* err) (print) ## (string? err) (print err) ## (print (string "Error: " (PRINT err))))) (defn main [& args] (let [args-len (length args) argv (if (<= 2 args-len) (drop 2 args) ())] (e/env-set repl_env (t/make-symbol "*ARGV*") (t/make-list (map t/make-string argv))) (if (< 1 args-len) (try (rep (string "(load-file \"" (in args 1) "\")")) # XXX: escaping? ([err] (handle-error err))) (do (var buf nil) (rep "(println (str \"Mal [\" *host-language* \"]\"))") (while true (set buf @"") (getstdin "user> " buf) (if (= 0 (length buf)) (break) (try (print (rep buf)) ([err] (handle-error err))))))))) ================================================ FILE: impls/janet/tests/stepA_mal.mal ================================================ ;; Testing basic Janet interop (janet-eval "7") ;=>7 (janet-eval "\"7\"") ;=>"7" (janet-eval "nil") ;=>nil (janet-eval "(= 123 123)") ;=>true (janet-eval "(= 123 456)") ;=>false (janet-eval ":my-keyword") ;=>:my-keyword (janet-eval "'(7 8 9)") ;=>(7 8 9) (janet-eval "{:abc 789}") ;=>{:abc 789} (janet-eval "(print \"hello\")") ;/hello ;=>nil (janet-eval "(defn foo [] 8)") (janet-eval "(foo)") ;=>8 (janet-eval "(let [tup [:a 1 :b 2]] (struct ;tup))") ;=>{:a 1 :b 2} (janet-eval "(do (def tbl @{}) (put tbl :x 8) tbl)") ;=>{:x 8} (janet-eval "(do (var mut 1) (set mut 2) mut)") ;=>2 ================================================ FILE: impls/janet/types.janet ================================================ (defn make-nil [] {:tag :nil :content "nil"}) (defn make-boolean [bool] {:tag :boolean :content (string bool)}) (defn make-keyword [a-str] {:tag :keyword :content a-str}) (defn make-number [a-num] {:tag :number :content a-num}) (defn make-string [a-str] {:tag :string :content a-str}) (defn make-symbol [a-str] {:tag :symbol :content a-str}) (defn make-hash-map [items &opt meta] (default meta (make-nil)) (let [a-struct (if (dictionary? items) items (struct ;items))] {:tag :hash-map :content a-struct :meta meta})) (defn make-list [items &opt meta] (default meta (make-nil)) {:tag :list :content items :meta meta}) (defn make-vector [items &opt meta] (default meta (make-nil)) {:tag :vector :content items :meta meta}) (defn make-function [a-fn &opt meta is-macro ast params env] (default meta (make-nil)) (default is-macro false) {:tag :function :content a-fn :meta meta :is-macro is-macro :ast ast :params params :env env}) (defn make-atom [ast] @{:tag :atom :content ast}) (defn set-atom-value! [atom-ast value-ast] (put atom-ast :content value-ast)) (defn make-exception [ast] {:tag :exception :content ast}) ## common accessors (defn get-value [ast] (ast :content)) (defn get-type [ast] (ast :tag)) (defn get-meta [ast] (ast :meta)) ## function-specific accessors (defn get-is-macro [ast] (ast :is-macro)) (defn get-ast [ast] (ast :ast)) (defn get-params [ast] (ast :params)) (defn get-env [ast] (ast :env)) ## function-specific functions (defn macrofy [fn-ast] (merge fn-ast {:is-macro true})) (defn clone-with-meta [fn-ast meta-ast] (merge fn-ast {:meta meta-ast})) ## predicates (defn nil?* [ast] (= :nil (get-type ast))) (defn boolean?* [ast] (= :boolean (get-type ast))) (defn true?* [ast] (and (boolean?* ast) (= "true" (get-value ast)))) (defn false?* [ast] (and (boolean?* ast) (= "false" (get-value ast)))) (defn number?* [ast] (= :number (get-type ast))) (defn symbol?* [ast] (= :symbol (get-type ast))) (defn keyword?* [ast] (= :keyword (get-type ast))) (defn string?* [ast] (= :string (get-type ast))) (defn list?* [ast] (= :list (get-type ast))) (defn vector?* [ast] (= :vector (get-type ast))) (defn hash-map?* [ast] (= :hash-map (get-type ast))) (defn fn?* [ast] (= :function (get-type ast))) (defn macro?* [ast] (and (fn?* ast) (get-is-macro ast))) (defn atom?* [ast] (= :atom (get-type ast))) (defn exception?* [ast] (= :exception (get-type ast))) (defn empty?* [ast] (empty? (get-value ast))) # XXX: likely this could be simpler (defn equals?* [ast-1 ast-2] (let [type-1 (get-type ast-1) type-2 (get-type ast-2)] (if (and (not= type-1 type-2) # XXX: not elegant (not (and (list?* ast-1) (vector?* ast-2))) (not (and (list?* ast-2) (vector?* ast-1)))) false (let [val-1 (get-value ast-1) val-2 (get-value ast-2)] # XXX: when not a collection... (if (and (not (list?* ast-1)) (not (vector?* ast-1)) (not (hash-map?* ast-1))) (= val-1 val-2) (if (not= (length val-1) (length val-2)) false (if (and (not (hash-map?* ast-1)) (not (hash-map?* ast-2))) (do (var found-unequal false) (each [v1 v2] (partition 2 (interleave val-1 val-2)) (when (not (equals?* v1 v2)) (set found-unequal true) (break))) (not found-unequal)) (if (or (not (hash-map?* ast-1)) (not (hash-map?* ast-2))) false (do (var found-unequal false) (each [k1 k2] (partition 2 (interleave (keys val-1) (keys val-2))) (when (not (equals?* k1 k2)) (set found-unequal true) (break)) (when (not (equals?* (val-1 k1) (val-2 k2))) (set found-unequal true) (break))) (not found-unequal)))))))))) ## highlander types (def mal-nil (make-nil)) (def mal-true (make-boolean true)) (def mal-false (make-boolean false)) ================================================ FILE: impls/janet/utils.janet ================================================ (defn throw* [ast] (error ast)) ================================================ FILE: impls/java/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Java and maven RUN apt-get -y install default-jdk-headless maven ENV MAVEN_OPTS -Duser.home=/mal ================================================ FILE: impls/java/Makefile ================================================ SOURCES_BASE = src/main/java/mal/readline.java src/main/java/mal/types.java \ src/main/java/mal/reader.java src/main/java/mal/printer.java SOURCES_LISP = src/main/java/mal/env.java src/main/java/mal/core.java \ src/main/java/mal/stepA_mal.java SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: mvn install dist: mal.jar mal mal.jar: target/classes/mal/stepA_mal.class mvn assembly:assembly cp target/mal-0.0.1.jar $@ SHELL := bash mal: mal.jar cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ chmod +x mal src/main/mal/%.java: mvn install target/classes/mal/step%.class: src/main/java/mal/step%.java ${SOURCES} mvn install clean: mvn clean rm -f mal.jar mal ================================================ FILE: impls/java/pom.xml ================================================ 4.0.0 org.martintribe mal jar 0.0.1 com.google.guava guava 16.0.1 org.apache.commons commons-lang3 3.3 net.java.dev.jna jna 4.0.0 maven-compiler-plugin 3.0 1.7 1.7 org.codehaus.mojo exec-maven-plugin 1.2.1 java org.apache.maven.plugins maven-shade-plugin 1.7.1 package shade mal.stepA_mal maven-assembly-plugin jar-with-dependencies mal.stepA_mal ================================================ FILE: impls/java/run ================================================ #!/usr/bin/env bash args="" if [ "$#" -gt 0 ]; then args="-Dexec.args='$1'" for a in "${@:2}"; do args="$args '$a'" done fi exec mvn -quiet -e exec:java -Dexec.mainClass="mal.${STEP:-stepA_mal}" ${args:+"$args"} ================================================ FILE: impls/java/src/main/java/mal/core.java ================================================ package mal; import java.util.List; import java.util.ArrayList; import java.util.Set; import java.util.Map; import java.util.HashMap; import com.google.common.collect.ImmutableMap; import java.io.IOException; import java.io.FileNotFoundException; import java.util.Scanner; import java.io.File; import mal.types.*; import mal.printer; import mal.readline; public class core { // Local references for convenience static MalConstant Nil = mal.types.Nil; static MalConstant True = mal.types.True; static MalConstant False = mal.types.False; // Errors/Exceptions static MalFunction mal_throw = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { throw new MalException(a.nth(0)); } }; // Scalar functions static MalFunction nil_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) == Nil ? True : False; } }; static MalFunction true_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) == True ? True : False; } }; static MalFunction false_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) == False ? True : False; } }; static MalFunction number_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) instanceof MalInteger ? True : False; } }; static MalFunction string_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (!(args.nth(0) instanceof MalString)) { return False; } String s = ((MalString)args.nth(0)).getValue(); if (s.length() != 0 && s.charAt(0) == '\u029e') { return False; } return True; } }; static MalFunction symbol = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return new MalSymbol((MalString)args.nth(0)); } }; static MalFunction symbol_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0) instanceof MalSymbol ? True : False; } }; static MalFunction keyword = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (args.nth(0) instanceof MalString && (((MalString)args.nth(0)).getValue().charAt(0) == '\u029e')) { return (MalString)args.nth(0); } else { return new MalString( "\u029e" + ((MalString)args.nth(0)).getValue()); } } }; static MalFunction keyword_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (!(args.nth(0) instanceof MalString)) { return False; } String s = ((MalString)args.nth(0)).getValue(); if (s.length() == 0 || s.charAt(0) != '\u029e') { return False; } return True; } }; static MalFunction fn_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (!(args.nth(0) instanceof MalFunction)) { return False; } return ((MalFunction)args.nth(0)).isMacro() ? False : True; } }; static MalFunction macro_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { if (!(args.nth(0) instanceof MalFunction)) { return False; } return ((MalFunction)args.nth(0)).isMacro() ? True : False; } }; // String functions static MalFunction pr_str = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return new MalString(printer._pr_str_args(args, " ", true)); } }; static MalFunction str = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return new MalString(printer._pr_str_args(args, "", false)); } }; static MalFunction prn = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { System.out.println(printer._pr_str_args(args, " ", true)); return Nil; } }; static MalFunction println = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { System.out.println(printer._pr_str_args(args, " ", false)); return Nil; } }; static MalFunction equal_Q = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return types._equal_Q(args.nth(0), args.nth(1)) ? True : False; } }; static MalFunction mal_readline = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { String prompt = ((MalString)args.nth(0)).getValue(); try { return new MalString(readline.readline(prompt)); } catch (IOException e) { throw new MalException(new MalString(e.getMessage())); } catch (readline.EOFException e) { return Nil; } } }; static MalFunction read_string = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { try { return reader.read_str(((MalString)args.nth(0)).getValue()); } catch (MalContinue c) { return types.Nil; } } }; static MalFunction slurp = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { String fname = ((MalString)args.nth(0)).getValue(); try { // Scanner drops final newline, so add it back return new MalString( new Scanner(new File(fname)).useDelimiter("\\Z").next() + "\n"); } catch (FileNotFoundException e) { throw new MalError(e.getMessage()); } } }; // Number functions static MalFunction add = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); } }; static MalFunction subtract = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); } }; static MalFunction multiply = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); } }; static MalFunction divide = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); } }; static MalFunction lt = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).lt((MalInteger)a.nth(1)); } }; static MalFunction lte = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).lte((MalInteger)a.nth(1)); } }; static MalFunction gt = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).gt((MalInteger)a.nth(1)); } }; static MalFunction gte = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).gte((MalInteger)a.nth(1)); } }; static MalFunction time_ms = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return new MalInteger((int)System.currentTimeMillis()); } }; // List functions static MalFunction new_list = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return new MalList(a.value); } }; static public Boolean _list_Q(MalVal mv) { return mv.getClass().equals(MalList.class); } static MalFunction list_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return _list_Q(a.nth(0)) ? True : False; } }; // Vector functions static MalFunction new_vector = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return new MalVector(a.value); } }; static public Boolean _vector_Q(MalVal mv) { return mv.getClass().equals(MalVector.class); } static MalFunction vector_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return _vector_Q(a.nth(0)) ? True : False; } }; // HashMap functions static MalFunction new_hash_map = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return new MalHashMap(a); } }; static MalFunction hash_map_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return a.nth(0) instanceof MalHashMap ? True : False; } }; static MalFunction contains_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { String key = ((MalString)a.nth(1)).getValue(); MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; return hm.containsKey(key) ? True : False; } }; static MalFunction assoc = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); new_mhm.assoc_BANG((MalList)a.slice(1)); return new_mhm; } }; static MalFunction dissoc = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); new_mhm.dissoc_BANG((MalList)a.slice(1)); return new_mhm; } }; static MalFunction get = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { if (a.nth(0) == Nil) { return Nil; } else { String key = ((MalString)a.nth(1)).getValue(); MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; if (hm.containsKey(key)) { return hm.get(key); } else { return Nil; } } } }; static MalFunction keys = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; MalList key_lst = new MalList(); for (String key : hm.keySet()) { key_lst.conj_BANG(new MalString(key)); } return key_lst; } }; static MalFunction vals = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalHashMap mhm = (MalHashMap)a.nth(0); HashMap hm = (HashMap)mhm.value; //return new ArrayList(((HashMap)hm).values()); MalList val_lst = new MalList(); for (MalVal val : hm.values()) { val_lst.conj_BANG(val); } return val_lst; } }; // Sequence functions static MalFunction sequential_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return a.nth(0) instanceof MalList ? True : False; } }; static MalFunction count = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { if (a.nth(0) == Nil) { return new MalInteger(0); } else { return new MalInteger(((MalList)a.nth(0)).size()); } } }; static MalFunction empty_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalVal exp = a.nth(0); if (exp == Nil || (exp instanceof MalList && ((MalList)exp).size() == 0)) { return True; } else { return False; } } }; static MalFunction cons = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { List lst = new ArrayList(); lst.add(a.nth(0)); lst.addAll(((MalList)a.nth(1)).getList()); return (MalVal)new MalList(lst); } }; static MalFunction concat = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { if (a.size() == 0) { return new MalList(); } List lst = new ArrayList(); lst.addAll(((MalList)a.nth(0)).value); for(Integer i=1; i 0 ? ml.nth(0) : Nil; } }; static MalFunction rest = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalVal exp = a.nth(0); if (exp == Nil) { return new MalList(); } MalList ml = ((MalList)exp); return ml.rest(); } }; static MalFunction nth = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { Integer idx = ((MalInteger)a.nth(1)).getValue(); if (idx < ((MalList)a.nth(0)).size()) { return ((MalList)a.nth(0)).nth(idx); } else { throw new MalError("nth: index out of range"); } } }; // General sequence functions static MalFunction apply = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalFunction f = (MalFunction)a.nth(0); MalList args = a.slice(1,a.size()-1); args.value.addAll( ((MalList)a.nth(a.size()-1)).value); return f.apply(args); } }; static MalFunction map = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalFunction f = (MalFunction) a.nth(0); MalList src_lst = (MalList) a.nth(1); MalList new_lst = new MalList(); for(Integer i=0; i lst = new ArrayList(); for (String c : s.split("(?!^)")) { lst.add(new MalString(c)); } return new MalList(lst); } else if (mv == Nil) { return Nil; } else { throw new MalError("seq: called on non-sequence"); } } }; // Metadata functions static MalFunction meta = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { return args.nth(0).getMeta(); } }; static MalFunction with_meta = new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { MalVal new_mv = ((MalVal)args.nth(0)).copy(); new_mv.setMeta(args.nth(1)); return new_mv; } }; // Atom functions static MalFunction new_atom = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return new MalAtom(a.nth(0)); } }; static MalFunction atom_Q = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return a.nth(0) instanceof MalAtom ? True : False; } }; static MalFunction deref = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalAtom)a.nth(0)).value; } }; static MalFunction reset_BANG = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalAtom)a.nth(0)).value = a.nth(1); } }; static MalFunction swap_BANG = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalAtom atm = (MalAtom)a.nth(0); MalFunction f = (MalFunction)a.nth(1); MalList new_args = new MalList(); new_args.value.addAll(((MalList)a.slice(2)).value); new_args.value.add(0, atm.value); atm.value = f.apply(new_args); return atm.value; } }; // types_ns is namespace of type functions static Map ns = ImmutableMap.builder() .put("=", equal_Q) .put("throw", mal_throw) .put("nil?", nil_Q) .put("true?", true_Q) .put("false?", false_Q) .put("number?", number_Q) .put("string?", string_Q) .put("symbol", symbol) .put("symbol?", symbol_Q) .put("keyword", keyword) .put("keyword?", keyword_Q) .put("fn?", fn_Q) .put("macro?", macro_Q) .put("pr-str", pr_str) .put("str", str) .put("prn", prn) .put("println", println) .put("readline", mal_readline) .put("read-string", read_string) .put("slurp", slurp) .put("<", lt) .put("<=", lte) .put(">", gt) .put(">=", gte) .put("+", add) .put("-", subtract) .put("*", multiply) .put("/", divide) .put("time-ms", time_ms) .put("list", new_list) .put("list?", list_Q) .put("vector", new_vector) .put("vector?", vector_Q) .put("hash-map", new_hash_map) .put("map?", hash_map_Q) .put("assoc", assoc) .put("dissoc", dissoc) .put("contains?", contains_Q) .put("get", get) .put("keys", keys) .put("vals", vals) .put("sequential?", sequential_Q) .put("cons", cons) .put("concat", concat) .put("vec", vec) .put("nth", nth) .put("first", first) .put("rest", rest) .put("empty?", empty_Q) .put("count", count) .put("apply", apply) .put("map", map) .put("conj", conj) .put("seq", seq) .put("with-meta", with_meta) .put("meta", meta) .put("atom", new_atom) .put("atom?", atom_Q) .put("deref", deref) .put("reset!", reset_BANG) .put("swap!", swap_BANG) .build(); } ================================================ FILE: impls/java/src/main/java/mal/env.java ================================================ package mal; import java.util.HashMap; import mal.types.MalThrowable; import mal.types.MalException; import mal.types.MalVal; import mal.types.MalSymbol; import mal.types.MalList; public class env { public static class Env { Env outer = null; HashMap data = new HashMap(); public Env(Env outer) { this.outer = outer; } public Env(Env outer, MalList binds, MalList exprs) { this.outer = outer; for (Integer i=0; i value, String delim, Boolean print_readably) { ArrayList strs = new ArrayList(); for (MalVal mv : value) { strs.add(mv.toString(print_readably)); } return Joiner.on(delim).join(strs); } public static String join(Map value, String delim, Boolean print_readably) { ArrayList strs = new ArrayList(); for (Map.Entry entry : value.entrySet()) { if (entry.getKey().length() > 0 && entry.getKey().charAt(0) == '\u029e') { strs.add(":" + entry.getKey().substring(1)); } else if (print_readably) { strs.add("\"" + entry.getKey().toString() + "\""); } else { strs.add(entry.getKey().toString()); } strs.add(entry.getValue().toString(print_readably)); } return Joiner.on(" ").join(strs); } public static String _pr_str(MalVal mv, Boolean print_readably) { return mv.toString(print_readably); } public static String _pr_str_args(MalList args, String sep, Boolean print_readably) { return join(args.getList(), sep, print_readably); } public static String escapeString(String value) { return StringEscapeUtils.escapeJava(value); } } ================================================ FILE: impls/java/src/main/java/mal/reader.java ================================================ package mal; import java.util.ArrayList; import java.util.regex.Matcher; import java.util.regex.Pattern; import org.apache.commons.lang3.StringEscapeUtils; import mal.types.*; public class reader { public static class ParseError extends MalThrowable { public ParseError(String msg) { super(msg); } } public static class Reader { ArrayList tokens; Integer position; public Reader(ArrayList t) { tokens = t; position = 0; } public String peek() { if (position >= tokens.size()) { return null; } else { return tokens.get(position); } } public String next() { return tokens.get(position++); } } public static ArrayList tokenize(String str) { ArrayList tokens = new ArrayList(); Pattern pattern = Pattern.compile("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)"); Matcher matcher = pattern.matcher(str); while (matcher.find()) { String token = matcher.group(1); if (token != null && !token.equals("") && !(token.charAt(0) == ';')) { tokens.add(token); } } return tokens; } public static MalVal read_atom(Reader rdr) throws ParseError { String token = rdr.next(); Pattern pattern = Pattern.compile("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)"); Matcher matcher = pattern.matcher(token); if (!matcher.find()) { throw new ParseError("unrecognized token '" + token + "'"); } if (matcher.group(1) != null) { return new MalInteger(Integer.parseInt(matcher.group(1))); } else if (matcher.group(3) != null) { return types.Nil; } else if (matcher.group(4) != null) { return types.True; } else if (matcher.group(5) != null) { return types.False; } else if (matcher.group(6) != null) { return new MalString(StringEscapeUtils.unescapeJava(matcher.group(6))); } else if (matcher.group(7) != null) { throw new ParseError("expected '\"', got EOF"); } else if (matcher.group(8) != null) { return new MalString("\u029e" + matcher.group(8)); } else if (matcher.group(9) != null) { return new MalSymbol(matcher.group(9)); } else { throw new ParseError("unrecognized '" + matcher.group(0) + "'"); } } public static MalVal read_list(Reader rdr, MalList lst, char start, char end) throws MalContinue, ParseError { String token = rdr.next(); if (token.charAt(0) != start) { throw new ParseError("expected '" + start + "'"); } while ((token = rdr.peek()) != null && token.charAt(0) != end) { lst.conj_BANG(read_form(rdr)); } if (token == null) { throw new ParseError("expected '" + end + "', got EOF"); } rdr.next(); return lst; } public static MalVal read_hash_map(Reader rdr) throws MalContinue, ParseError { MalList lst = (MalList)read_list(rdr, new MalList(), '{', '}'); return new MalHashMap(lst); } public static MalVal read_form(Reader rdr) throws MalContinue, ParseError { String token = rdr.peek(); if (token == null) { throw new MalContinue(); } MalVal form; switch (token.charAt(0)) { case '\'': rdr.next(); return new MalList(new MalSymbol("quote"), read_form(rdr)); case '`': rdr.next(); return new MalList(new MalSymbol("quasiquote"), read_form(rdr)); case '~': if (token.equals("~")) { rdr.next(); return new MalList(new MalSymbol("unquote"), read_form(rdr)); } else { rdr.next(); return new MalList(new MalSymbol("splice-unquote"), read_form(rdr)); } case '^': rdr.next(); MalVal meta = read_form(rdr); return new MalList(new MalSymbol("with-meta"), read_form(rdr), meta); case '@': rdr.next(); return new MalList(new MalSymbol("deref"), read_form(rdr)); case '(': form = read_list(rdr, new MalList(), '(' , ')'); break; case ')': throw new ParseError("unexpected ')'"); case '[': form = read_list(rdr, new MalVector(), '[' , ']'); break; case ']': throw new ParseError("unexpected ']'"); case '{': form = read_hash_map(rdr); break; case '}': throw new ParseError("unexpected '}'"); default: form = read_atom(rdr); } return form; } public static MalVal read_str(String str) throws MalContinue, ParseError { return read_form(new Reader(tokenize(str))); } } ================================================ FILE: impls/java/src/main/java/mal/readline.java ================================================ package mal; import java.io.IOException; import java.io.BufferedReader; import java.io.InputStreamReader; import java.io.BufferedWriter; import java.io.FileWriter; import java.io.File; import com.google.common.io.Files; import java.nio.charset.StandardCharsets; import java.util.List; import com.sun.jna.Library; import com.sun.jna.Native; import com.sun.jna.Platform; class readline { public enum Mode { JNA, JAVA } static Mode mode = Mode.JNA; static String HISTORY_FILE = null; static Boolean historyLoaded = false; static { HISTORY_FILE = System.getProperty("user.home") + "/.mal-history"; } public static class EOFException extends Exception { } public interface RLLibrary extends Library { // Select a library to use. // WARNING: GNU readline is GPL. // GNU readline (GPL) RLLibrary INSTANCE = (RLLibrary) Native.loadLibrary("readline", RLLibrary.class); // Libedit (BSD) // RLLibrary INSTANCE = (RLLibrary) // Native.loadLibrary("edit", RLLibrary.class); String readline(String prompt); void add_history(String line); } public static void loadHistory(String filename) { File file = new File(filename); try { List lines = Files.readLines(file, StandardCharsets.UTF_8); for (String line : lines) { RLLibrary.INSTANCE.add_history(line); } } catch (IOException e) { // ignore } } public static void appendHistory(String filename, String line) { try { BufferedWriter w; w = new BufferedWriter(new FileWriter(filename, true)); w.append(line + "\n"); w.close(); } catch (IOException e) { // ignore } } public static String jna_readline(String prompt) throws EOFException, IOException { if (!historyLoaded) { loadHistory(HISTORY_FILE); } String line = RLLibrary.INSTANCE.readline(prompt); if (line == null) { throw new EOFException(); } RLLibrary.INSTANCE.add_history(line); appendHistory(HISTORY_FILE, line); return line; } // Just java readline (no history, or line editing) public static String java_readline(String prompt) throws EOFException, IOException { System.out.print(prompt); BufferedReader buffer=new BufferedReader(new InputStreamReader(System.in)); String line=buffer.readLine(); if (line == null) { throw new EOFException(); } return line; } public static String readline(String prompt) throws EOFException, IOException { if (mode == Mode.JNA) { return jna_readline(prompt); } else { return java_readline(prompt); } } } ================================================ FILE: impls/java/src/main/java/mal/step0_repl.java ================================================ package mal; import java.io.IOException; import mal.readline; public class step0_repl { // read public static String READ(String str) { return str; } // eval public static String EVAL(String ast, String env) { return ast; } // print public static String PRINT(String exp) { return exp; } // repl public static String RE(String env, String str) { return EVAL(READ(str), env); } public static void main(String[] args) { String prompt = "user> "; if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } System.out.println(PRINT(RE(null, line))); } } } ================================================ FILE: impls/java/src/main/java/mal/step1_read_print.java ================================================ package mal; import java.io.IOException; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; public class step1_read_print { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal ast, String env) { return ast; } // print public static String PRINT(MalVal exp) { return printer._pr_str(exp, true); } // repl public static MalVal RE(String env, String str) throws MalThrowable { return EVAL(READ(str), env); } public static void main(String[] args) throws MalThrowable { String prompt = "user> "; if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(null, line))); } catch (MalContinue e) { continue; } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); continue; } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); continue; } } } } ================================================ FILE: impls/java/src/main/java/mal/step2_eval.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import java.util.HashMap; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; public class step2_eval { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal orig_ast, Map env) throws MalThrowable { // System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; // apply list if (ast.size() == 0) { return ast; } final MalVal f = EVAL(ast.nth(0), env); if (!(f instanceof ILambda)) throw new MalError("cannot apply " + printer._pr_str(ast, true)); final MalList args = new MalList(); for (int i=1; i env, String str) throws MalThrowable { return EVAL(READ(str), env); } static MalFunction add = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); } }; static MalFunction subtract = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); } }; static MalFunction multiply = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); } }; static MalFunction divide = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); } }; public static void main(String[] args) throws MalThrowable { String prompt = "user> "; Map repl_env = new HashMap(); repl_env.put("+", add); repl_env.put("-", subtract); repl_env.put("*", multiply); repl_env.put("/", divide); if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step3_env.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; public class step3_env { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); if (!(a0 instanceof MalSymbol)) { throw new MalError("attempt to apply on non-symbol '" + printer._pr_str(a0,true) + "'"); } switch (((MalSymbol)a0).getName()) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } return EVAL(a2, let_env); default: final ILambda f = (ILambda)EVAL(a0, env); final MalList args = new MalList(); for (int i=1; i 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step4_if_fn_do.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step4_if_fn_do { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } return EVAL(a2, let_env); case "do": for (int i=1; i 3) { a3 = ast.nth(3); return EVAL(a3, env); } else { return types.Nil; } } else { // eval true slot form a2 = ast.nth(2); return EVAL(a2, env); } case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction () { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); final MalList args = new MalList(); for (int i=1; i 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step5_tco.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step5_tco { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); final MalList args = new MalList(); for (int i=1; i 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step6_file.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step6_file { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); final MalList args = new MalList(); for (int i=1; i 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; fileIdx = 1; } if (args.length > fileIdx) { RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); return; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step7_quote.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step7_quote { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval 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 ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); 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(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast.nth(1); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); final MalList args = new MalList(); for (int i=1; i 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; fileIdx = 1; } if (args.length > fileIdx) { RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); return; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step8_macros.java ================================================ package mal; import java.io.IOException; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step8_macros { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval 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 ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); 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(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast.nth(1); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; case "defmacro!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); res = res.copy(); ((MalFunction)res).setMacro(); env.set((MalSymbol)a1, res); return res; case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); continue; } final MalList args = new MalList(); for (int i=1; i (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)))))))"); Integer fileIdx = 0; if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; fileIdx = 1; } if (args.length > fileIdx) { RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); return; } while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/step9_try.java ================================================ package mal; import java.io.IOException; import java.io.StringWriter; import java.io.PrintWriter; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class step9_try { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval 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 ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); 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(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast.nth(1); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; case "defmacro!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); res = res.copy(); ((MalFunction)res).setMacro(); env.set((MalSymbol)a1, res); return res; case "try*": try { return EVAL(ast.nth(1), env); } catch (Throwable t) { if (ast.size() > 2) { MalVal exc; a2 = ast.nth(2); MalVal a20 = ((MalList)a2).nth(0); if (((MalSymbol)a20).getName().equals("catch*")) { if (t instanceof MalException) { exc = ((MalException)t).getValue(); } else { StringWriter sw = new StringWriter(); t.printStackTrace(new PrintWriter(sw)); String tstr = sw.toString(); exc = new MalString(t.getMessage() + ": " + tstr); } return EVAL(((MalList)a2).nth(2), new Env(env, ((MalList)a2).slice(1,2), new MalList(exc))); } } throw t; } case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); continue; } final MalList args = new MalList(); for (int i=1; i (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)))))))"); Integer fileIdx = 0; if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; fileIdx = 1; } if (args.length > fileIdx) { RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/stepA_mal.java ================================================ package mal; import java.io.IOException; import java.io.StringWriter; import java.io.PrintWriter; import java.util.List; import java.util.Map; import mal.types.*; import mal.readline; import mal.reader; import mal.printer; import mal.env.Env; import mal.core; public class stepA_mal { // read public static MalVal READ(String str) throws MalThrowable { return reader.read_str(str); } // eval 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 ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); 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(MalVal orig_ast, Env env) throws MalThrowable { while (true) { final MalVal dbgeval = env.get("DEBUG-EVAL"); if (dbgeval != null && dbgeval != types.Nil && dbgeval != types.False) System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); if (orig_ast instanceof MalSymbol) { final String key = ((MalSymbol)orig_ast).getName(); final MalVal val = env.get(key); if (val == null) throw new MalException("'" + key + "' not found"); return val; } else if (orig_ast instanceof MalVector) { final MalList old_lst = (MalList)orig_ast; final MalVector new_lst = new MalVector(); for (MalVal mv : (List)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; } else if (orig_ast instanceof MalHashMap) { final Map old_hm = ((MalHashMap)orig_ast).value; MalHashMap new_hm = new MalHashMap(); for (Map.Entry entry : old_hm.entrySet()) { new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); } return new_hm; } else if (!orig_ast.list_Q()) { return orig_ast; } final MalList ast = (MalList)orig_ast; MalVal a0, a1,a2, a3, res; // apply list if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { case "def!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); env.set(((MalSymbol)a1), res); return res; case "let*": a1 = ast.nth(1); a2 = ast.nth(2); MalSymbol key; MalVal val; Env let_env = new Env(env); for(int i=0; i<((MalList)a1).size(); i+=2) { key = (MalSymbol)((MalList)a1).nth(i); val = ((MalList)a1).nth(i+1); let_env.set(key, EVAL(val, let_env)); } orig_ast = a2; env = let_env; break; case "quote": return ast.nth(1); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; case "defmacro!": a1 = ast.nth(1); a2 = ast.nth(2); res = EVAL(a2, env); res = res.copy(); ((MalFunction)res).setMacro(); env.set((MalSymbol)a1, res); return res; case "try*": try { return EVAL(ast.nth(1), env); } catch (Throwable t) { if (ast.size() > 2) { MalVal exc; a2 = ast.nth(2); MalVal a20 = ((MalList)a2).nth(0); if (((MalSymbol)a20).getName().equals("catch*")) { if (t instanceof MalException) { exc = ((MalException)t).getValue(); } else { StringWriter sw = new StringWriter(); t.printStackTrace(new PrintWriter(sw)); String tstr = sw.toString(); exc = new MalString(t.getMessage() + ": " + tstr); } return EVAL(((MalList)a2).nth(2), new Env(env, ((MalList)a2).slice(1,2), new MalList(exc))); } } throw t; } case "do": for (int i=1; i 3) { orig_ast = ast.nth(3); } else { return types.Nil; } } else { // eval true slot form orig_ast = ast.nth(2); } break; case "fn*": final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } }; default: final MalFunction f = (MalFunction)EVAL(a0, env); if (f.isMacro()) { orig_ast = f.apply(ast.rest()); continue; } final MalList args = new MalList(); for (int i=1; i (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)))))))"); Integer fileIdx = 0; if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; fileIdx = 1; } if (args.length > fileIdx) { RE(repl_env, "(load-file \"" + args[fileIdx] + "\")"); return; } // repl loop RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { String line; try { line = readline.readline(prompt); if (line == null) { continue; } } catch (readline.EOFException e) { break; } catch (IOException e) { System.out.println("IOException: " + e.getMessage()); break; } try { System.out.println(PRINT(RE(repl_env, line))); } catch (MalContinue e) { } catch (MalException e) { System.out.println("Error: " + printer._pr_str(e.getValue(), false)); } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); } catch (Throwable t) { System.out.println("Uncaught " + t + ": " + t.getMessage()); } } } } ================================================ FILE: impls/java/src/main/java/mal/types.java ================================================ package mal; import java.util.List; import java.util.ArrayList; import java.util.Set; import java.util.Map; import java.util.HashMap; import mal.printer; import mal.env.Env; public class types { // // Exceptions/Errors // public static class MalThrowable extends Exception { public MalThrowable() { } public MalThrowable(String msg) { super(msg); } } public static class MalError extends MalThrowable { public MalError(String msg) { super(msg); } } public static class MalContinue extends MalThrowable { } // Thrown by throw function public static class MalException extends MalThrowable { MalVal value; public MalException(MalVal value) { this.value = value; } public MalException(String value) { this.value = new MalString(value); } public MalVal getValue() { return value; } } // // General functions // public static Boolean _equal_Q(MalVal a, MalVal b) { Class ota = a.getClass(), otb = b.getClass(); if (!((ota == otb) || (a instanceof MalList && b instanceof MalList))) { return false; } else { if (a instanceof MalInteger) { return ((MalInteger)a).getValue() == ((MalInteger)b).getValue(); } else if (a instanceof MalSymbol) { return ((MalSymbol)a).getName().equals( ((MalSymbol)b).getName()); } else if (a instanceof MalString) { return ((MalString)a).getValue().equals( ((MalString)b).getValue()); } else if (a instanceof MalList) { if (((MalList)a).size() != ((MalList)b).size()) { return false; } for (Integer i=0; i<((MalList)a).size(); i++) { if (! _equal_Q(((MalList)a).nth(i), ((MalList)b).nth(i))) { return false; } } return true; } else if (a instanceof MalHashMap) { if (((MalHashMap)a).value.size() != ((MalHashMap)b).value.size()) { return false; } //HashMap hm = (HashMap)a.value; MalHashMap mhm = ((MalHashMap)a); HashMap hm = (HashMap)mhm.value; for (String k : hm.keySet()) { if (! _equal_Q(((MalVal)((MalHashMap)a).value.get(k)), ((MalVal)((MalHashMap)b).value.get(k)))) { return false; } } return true; } else { return a == b; } } } // // Mal boxed types // abstract public static class MalVal { MalVal meta = Nil; abstract public MalVal copy() throws MalThrowable; // Default is just to call regular toString() public String toString(Boolean print_readably) { return this.toString(); } public MalVal getMeta() { return meta; } public void setMeta(MalVal m) { meta = m; } public Boolean list_Q() { return false; } } public static class MalConstant extends MalVal { String value; public MalConstant(String name) { value = name; } public MalConstant copy() throws MalThrowable { return this; } public String toString() { return value; } } public static MalConstant Nil = new MalConstant("nil"); public static MalConstant True = new MalConstant("true"); public static MalConstant False = new MalConstant("false"); public static class MalInteger extends MalVal { Integer value; public MalInteger(Integer v) { value = v; } public MalInteger copy() throws MalThrowable { return this; } public Integer getValue() { return value; } @Override public String toString() { return value.toString(); } public MalInteger add(MalInteger other) { return new MalInteger(value + other.getValue()); } public MalInteger subtract(MalInteger other) { return new MalInteger(value - other.getValue()); } public MalInteger multiply(MalInteger other) { return new MalInteger(value * other.getValue()); } public MalInteger divide(MalInteger other) { return new MalInteger(value / other.getValue()); } public MalConstant lt(MalInteger other) { return (value < other.getValue()) ? True : False; } public MalConstant lte(MalInteger other) { return (value <= other.getValue()) ? True : False; } public MalConstant gt(MalInteger other) { return (value > other.getValue()) ? True : False; } public MalConstant gte(MalInteger other) { return (value >= other.getValue()) ? True : False; } } public static class MalSymbol extends MalVal { String value; public MalSymbol(String v) { value = v; } public MalSymbol(MalString v) { value = v.getValue(); } public MalSymbol copy() throws MalThrowable { return this; } public String getName() { return value; } @Override public String toString() { return value; } } public static class MalString extends MalVal { String value; public MalString(String v) { value = v; } public MalString copy() throws MalThrowable { return this; } public String getValue() { return value; } @Override public String toString() { return "\"" + value + "\""; } public String toString(Boolean print_readably) { if (value.length() > 0 && value.charAt(0) == '\u029e') { return ":" + value.substring(1); } else if (print_readably) { return "\"" + printer.escapeString(value) + "\""; } else { return value; } } } public static class MalList extends MalVal { String start = "(", end = ")"; List value; public MalList(List val) { value = val; } public MalList(MalVal... mvs) { value = new ArrayList(); conj_BANG(mvs); } public MalList copy() throws MalThrowable { MalList new_ml = new MalList(); new_ml.value.addAll(value); new_ml.meta = meta; return new_ml; } @Override public String toString() { return start + printer.join(value, " ", true) + end; } public String toString(Boolean print_readably) { return start + printer.join(value, " ", print_readably) + end; } public List getList() { return value; } public Boolean list_Q() { return true; } public MalList conj_BANG(MalVal... mvs) { for (MalVal mv : mvs) { value.add(mv); } return this; } public Integer size() { return value.size(); } public MalVal nth(Integer idx) { return (MalVal)value.get(idx); } public MalList rest () { if (size() > 0) { return new MalList(value.subList(1, value.size())); } else { return new MalList(); } } public MalList slice(Integer start, Integer end) { return new MalList(value.subList(start, end)); } public MalList slice(Integer start) { return slice(start, value.size()); } } public static class MalVector extends MalList { // Same implementation except for instantiation methods public MalVector(List val) { value = val; start = "["; end = "]"; } public MalVector(MalVal... mvs) { super(mvs); start = "["; end = "]"; } public MalVector copy() throws MalThrowable { MalVector new_mv = new MalVector(); new_mv.value.addAll(value); new_mv.meta = meta; return new_mv; } public Boolean list_Q() { return false; } public MalVector slice(Integer start, Integer end) { return new MalVector(value.subList(start, end)); } } public static class MalHashMap extends MalVal { Map value; public MalHashMap(Map val) { value = val; } public MalHashMap(MalList lst) { value = new HashMap(); assoc_BANG(lst); } public MalHashMap(MalVal... mvs) { value = new HashMap(); assoc_BANG(mvs); } public MalHashMap copy() throws MalThrowable { Map shallowCopy = new HashMap(); shallowCopy.putAll(value); MalHashMap new_hm = new MalHashMap(shallowCopy); new_hm.meta = meta; return new_hm; } @Override public String toString() { return "{" + printer.join(value, " ", true) + "}"; } public String toString(Boolean print_readably) { return "{" + printer.join(value, " ", print_readably) + "}"; } public Set _entries() { return value.entrySet(); } public MalHashMap assoc_BANG(MalVal... mvs) { for (Integer i=0; i55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/java-truffle/.gitignore ================================================ .classpath .project .settings target /.gradle/ /build/ .factorypath .apt_generated bin graal_dumps ================================================ FILE: impls/java-truffle/Dockerfile ================================================ FROM ghcr.io/graalvm/graalvm-ce:21.1.0 RUN microdnf install python3 unzip && \ ln -sf /usr/bin/python3 /usr/bin/python && \ curl -o gradle.zip "https://downloads.gradle-dn.com/distributions/gradle-7.0.2-bin.zip" && \ mkdir /opt/gradle && \ unzip -d /opt/gradle gradle.zip RUN mkdir -p /mal WORKDIR /mal ENV GRADLE_USER_HOME=/tmp/.gradle ENV PATH="$PATH:/opt/gradle/gradle-7.0.2/bin" ================================================ FILE: impls/java-truffle/Makefile ================================================ all: gradle build build/classes/java/main/truffle/mal/step%.class: src/main/java/truffle/mal/*.java gradle build clean: gradle clean ================================================ FILE: impls/java-truffle/README.md ================================================ # Truffle Mal This Mal is implemented in Java using the [Truffle Framework](https://github.com/oracle/graal/blob/master/truffle/README.md). Truffle is a library for implementing interpreters. When these interpreters are run on GraalVM, the GraalVM compiler is able to JIT compile interpreted programs using a technique called [partial evaluation](https://en.wikipedia.org/wiki/Partial_evaluation). Partially evaluating an interpreter plus a program to produce compiled code requires a careful balance. If every last bit of interpreter code (including supporting libraries, etc.) is subject to partial evaluation, the result will explode to unreasonable size. Boundaries must be drawn. Exclude too much, though, and the speed up resulting from compilation may not be worth the effort of the compilation. Truffle's "thesis" is that a small set of primitives are sufficient to make JIT compilation via partial evaluation practical. These primitives feed runtime data collected by the executing interpreter to the compiler, allowing it to _specialize_, or optimistically simplify, the interpreter code at compilation time. The compiler inserts lightweight runtime checks of the assumptions that justify its simplifications. If the checks fail, the compiled code is _de-optimized_, and control is returned to the interpreter. See [Practical Partial Evaluation for High-Performance Dynamic Language Runtimes](http://chrisseaton.com/rubytruffle/pldi17-truffle/pldi17-truffle.pdf), from PLDI 2017, for a deeper treatment of the ideas behind Truffle. The Truffle Mal implementation is my attempt at putting the Truffle thesis to the test. Can I, an engineer without a background in compiler design, use Truffle to implement an interpreter for a dynamic language (Mal) that substantially outperforms the existing Java interpreter for Mal? *The Short Answer: Yup.* ```bash # Recursive Fibonacci on OpenJDK 11 with java mal $ ./run ../tests/fib.mal 30 10 Times (in ms) for (fib 30) on java: [2062 1809 1814 1777 1772 1791 1725 1723 1786 1745] # Recursive Fibonacci on GraalVM with java-truffle mal $ ./run ../tests/fib.mal 30 10 Times (in ms) for (fib 30) on java-truffle: [280 142 21 26 22 75 21 26 21 24] # That's an 82x speed-up! Just out of curiosity... # How does Clojure on OpenJDK 11? We'll even throw in a type hint. $ lein repl Clojure 1.10.0 OpenJDK 64-Bit Server VM 11.0.7+10-post-Ubuntu-2ubuntu218.04 user=> (defn fib [^long n] (if (= n 0) 1 (if (= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))) #'user/fib user=> (dotimes [i 5] (time (fib 30))) "Elapsed time: 32.0791 msecs" "Elapsed time: 31.7552 msecs" "Elapsed time: 31.5361 msecs" "Elapsed time: 31.4796 msecs" "Elapsed time: 31.4541 msecs" ``` A recursive Fibonacci computation is _obviously_ not sufficient to characterize the performance of our implementation (and as we'll see, it turns out to be something of a best-case scenario), but it sure looks impressive! Do more complicated Mal programs show similar speed-ups? How much simplicity did we have to sacrifice in the name of performance? Was it worth it? How much of the speed-up is really attributable to the Truffle/GraalVM combo, and how much came from putting more time into the code itself? We'll explore the answers to these questions together in the remainder! ## Disclaimers *First and foremost*: To the extend that this experiment _succeeds_ in its goal of producing an efficient Mal implementation, the credit is due to the teams behind Truffle and GraalVM. To the extend that this experiment _fails_, the blame falls on *me*! The reader should assume, by default, that any deficiencies in this Mal implementation are due to my own failure to understand or properly apply the tools at my disposal, and _not_ due to any fundamental limitations of Truffle or GraalVM. *Second:* This Mal implementation is _not_ idiomatic Java, and it's _not_ an idiomatic application of Truffle. The project's unusual organization (large numbers of package-private classes bundled into single files like Types.java, substantial duplication between step files) represent my attempt to adhere both to the spirit of Mal's pedagogical approach and the organization of the existing Java implementation. Consequently I have abused Truffle in several ways (that I am aware of, and perhaps others that I am not?). Each Mal step registers a distinct Truffle implementation whose language id has the form "mal_step${n}". The languages for each step have distinct AST node sub-classes, but they share the built-in AST nodes in Core.java and the runtime types in Types.java. This sharing creates some awkwardness in Core.java. ## Prerequisites [GraalVM Community Edition](https://www.graalvm.org/downloads/) (version 20.1.0 or higher) should be on your PATH and pointed to by JAVA_HOME. You'll also need to [install Gradle](https://gradle.org/install/) if you're going to build without using the provided Docker image. ## Outline of Approach For step 0 through step A, I've purposefully avoided Truffle-specific optimizations. Step A is intended to be a fully naive application of Truffle, where a 'pure' interpreter is developed using Truffle AST nodes, but without any attempt to leverage Truffle primitives to specialize compiled code. By comparing Truffle step A on OpenJDK to the existing Java step A, we can get a sense of the overhead imposed by the Truffle framework on interpreter performance. By comparing Truffle step A on OpenJDK to Truffle step A on GraalVM, we can get a sense of how much performance the GraalVM compiler can give the language implementor "for free". Each step _after_ A employs Truffle primitives to enable specialization of code during compilation. * Step B specializes function calls by assuming that the same function will always be called (i.e. that call sites are _monomorphic_), until proven otherwise. At call sites where the same function _actually is_ always called, the compiler can eliminate some code and perform inlining. * Step C optimizes and specializes environment lookups, allowing us to avoid HashMap-related overhead for lookups of symbols that are statically in scope (i.e. function arguments and let bindings) under the assumption that some def! doesn't dynamically bind the looked-up symbols at runtime in scopes where they aren't declared. * Step D enables _further_ specialization of environment lookups for closed-over environments, allowing us to skip the lookups entirely under the assumption that the symbols have not been rebound. * Step E specializes macro expansion, allowing the results of a macro expansion to _replace_ the apply form entirely. We have to 'cheat' in this step, and extend Mal's macro semantics (in a backward-compatible way!). The results are worth it! ## Performance Evaluation Method Truffle Mal performance is evaluated relative to Java Mal on several benchmarks. For each benchmark, we run Java Mal and Truffle Mal on both OpenJDK and GraalVM. ```bash # OpenJDK $ java -version openjdk version "11.0.7" 2020-04-14 OpenJDK Runtime Environment (build 11.0.7+10-post-Ubuntu-2ubuntu218.04) OpenJDK 64-Bit Server VM (build 11.0.7+10-post-Ubuntu-2ubuntu218.04, mixed mode, sharing) # GraalVM $ java -version openjdk version "11.0.7" 2020-04-14 OpenJDK Runtime Environment GraalVM CE 20.1.0 (build 11.0.7+10-jvmci-20.1-b02) OpenJDK 64-Bit Server VM GraalVM CE 20.1.0 (build 11.0.7+10-jvmci-20.1-b02, mixed mode, sharing) ``` It must be said that Truffle Mal leverage Clojure's implementations of persistent vectors and maps. This likely has little to no impact on the perf4 and fib benchmarks, which don't operate on vectors or maps. Self-hosted Mal, however, depends on the host Mal's map implementation for its environments. Since Java Mal's maps are built on java.util.HashMap and don't take advantage of structural sharing, we expect the complexity of Java Mal's assoc and dissoc functions to be strictly worse than Truffle Mal's ( O(n) versus O(lg(n)) ). Whether or not this actually tips things in favor of Truffle Mal isn't clear; the sizes of the environments in question are quite small. I have not made any attempt to account for this in the results. ### Fib This simple benchmark focuses on symbol lookups, arithmetic, and function application. We use the naive recursive approach to computing the 30th Fibonacci number. We run the computation 10 times, and select the fastest result. ### Busywork The busywork.mal benchmark is a refactoring of the perf3.mal benchmark, which primarily tests macro and atom performance. We measure how long it takes to execute 10,000 iterations of a 'busywork' function. As with fib.mal, this is done 10 times and we use the fastest result. ### Fib on Mal For a more interesting test, we run the `fib.mal` benchmark using self-hosted Mal. This gives each implementation a more comprehensive workout. We compute the 15th Fibonacci number 10 times, and take the fastest execution time. Note that self-hosted Mal does not support tail call optimization, and so consumes more stack the longer it runs. For Truffle Mal, we need to increase the stack size from the default of 1MB to 8MB to avoid stack overflow. ## Results Truffle performance is given in absolute terms, and relative to the faster of the Java implementation's OpenJDK and GraalVM runs for the same benchmark. ### Step A: No Optimizations Step A represents a naive Mal interpreter written using Truffle AST nodes, but with no special effort made to leverage Truffle primitives to assist the GraalVM compiler. | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ---------- | -------------- | ----------------- | ----------------- | | Fib | 1700 ms | 1293 ms (1.3x) | 675 ms (2.5x) | | Busywork | 781 ms | 914 ms | 888 ms | | Fib on Mal | 686 ms | 2101 ms | 1664 ms | On the Fib benchmark, the Java and Truffle implementations of Mal are in the same ball park on OpenJDK, with Truffle being 1.3x faster. However, when we run the Truffle implementation on GraalVM, we see nearly a 2x speed-up over OpenJDK effectively for free, putting it at 2.5x faster than plain old Java. The Busywork benchmark is a different story, with the Truffle implementation _slightly_ slower on both OpenJDK and GraalVM, and with GraalVM providing very little extra performance. Fib on Mal is stranger yet: the Truffle implementation is 3x _slower_ on OpenJDK, and GraalVM doesn't offer much help. What's going on?! A bit of profiling quickly yields the answer: Macros. From `truffle.mal.stepA_mal$ApplyNode`: ```java if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var result = applyMacro(env, fn); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); var target = Truffle.getRuntime().createCallTarget(newRoot); return invokeNode.invoke(target, new Object[] {}, false); } else { ``` A Truffle `CallTarget` represents an AST that can be called from other code. Call Target construction is a heavy-weight operation that traverses the entire AST to do various initialization things. The cost of this is _supposed_ to be amortized over the many calls to the code, and offset by the gains we see for code that is called often enough to be JIT compiled. Truffle ASTs support self-modification. Ideally, we'd expand a macro once, and then replace the macro application node with the result. Mal's macro semantics, alas, prevent us from doing so. A Mal macro can choose to expand code one way or another based on the current value of any in-scope environment, or even user input. Even worse, Mal's incremental macro expansion behavior is such that it is allowable to write 'tail-recursive' macros that would, if eagerly expanded, take up space exponential in their inputs. Consider a sumdown macro: ``` (defmacro! sumdown-via-macro* (fn* [acc n] `(if (<= ~n 0) ~acc (sumdown-via-macro* ~(+ acc n) ~(- n 1))))) (defmacro! sumdown-via-macro2 (fn* [n] `(sumdown-via-macro* 0 ~(eval n)))) ``` This executes without issue in any conforming Mal implementation! We'll return to macros in Step E, but before we do, we'll see what we can specialize within the confines of Mal's semantics. ### Step B: Specializing Function Calls In Step A, all function call sites are represented in the AST using Truffle's `IndirectCallNode`. Truffle also provides a `DirectCallNode` for use at call sites where the same function is always called. Direct function calls may be inlined by the GraalVM compiler. Mal's semantics make it difficult (and sometimes impossible?) to prove statically that the same function will always be called at a given call site. However, it's trivial for our interpreter to _assume_ that a call site is direct up until we learn that it isn't. If we use Truffle properly, we can express this assumption in a way that the GraalVM compiler understands. Here's what the Steb B version of `InvokeNode` looks like: ```java static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedTarget; @CompilationFinal private CallTarget cachedTarget; @CompilationFinal @Child private DirectCallNode directCallNode; @CompilationFinal @Child private IndirectCallNode indirectCallNode; /* SNIP */ Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; usingCachedTarget = true; cachedTarget = target; directCallNode = Truffle.getRuntime().createDirectCallNode(target); } while (true) { try { if (usingCachedTarget) { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedTarget = false; indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); } return indirectCallNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } ``` It _looks_ like it should be slower now, with all the branching. What have we done? Notice that all the new member variables have been annotated with `@CompilationFinal`. This tells the compiler to treat these variables as if they were `final`, because their values will not change in compiled code. We _ensure_ that they do not change in compiled code by inserting the `CompilerDirectives.transferToInterpreterAndInvalidate()` intrinsic. In interpreted code, this is a no-op. In _compiled_ code, it is replaced with an instruction that causes the compiler to _de-optimize_ the compiled code and return to the interpreter to continue execution. Suppose a function containing a call site that is not in tail position has been executed enough times to trigger compilation, and each time the invoked function has been the same. When compilation kicks in, the variables `initialized` and `usingCachedTarget` would be true, and `tailPosition` would be false. Accordingly, the invoke code simplifies to: ```java Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { while (true) { try { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } ``` Much better! Because we're using a `DirectCallNode`, the compiler might decide to inline the called function as well. Function inlining allows the partial evaluation algorithm to extend across function boundaries. Let's see if there's an improvement in practice... | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ---------- | -------------- | ----------------- | ----------------- | | Fib | 1700 ms | 991 ms (1.7x) | 430 ms (3.9x) | | Busywork | 781 ms | 671 ms (1.2x) | 409 ms (1.9x) | | Fib on Mal | 686 ms | 1912 ms (0.35x) | 1407 ms (0.48x) | We see modest improvements over Step A in all cases, with the Busywork benchmark having a 2x improvement over Step A on GraalVM. ### Step C: Static Symbol Lookup A little profiling shows that quite a lot of the 'work' that goes into executing a Mal program is just environment maintenance: constructing HashMaps, putting symbol/value pairs into them, and looking them back up again. For code that does a lot of function calling (like our Fib benchmark), this adds up to a lot of overhead. Why do we need the HashMaps at all? Why can't we build environments around Object arrays? During construction of an AST from a Mal form, we can keep track of the variables in each lexical scope, and assign each one a _slot_ (an index in the Object array for the environment associated with that scope). During execution, we can construct environments out of Object arrays, and get/set values using these slots. No more HashMaps! Right? The trouble, of course, is that `def!` can mutate environments at runtime, adding bindings for symbols that were never 'declared' via `let*` or `fn*`. Consider this function: ``` (def! f (fn* [x b] (do (who-knows? b) y))) ``` The symbol `y` isn't lexically in scope, so we wouldn't assign it a slot; we'd have to try to look it up in the global environment at execution time. But what if, at execution time, `who-knows?` turns out to resolve to a _macro_ like: ``` (fn* [b] (if b `(def! y 42))) ``` If `b` is truthy, the `y` symbol ends up bound in the function body's environment after all, but there's no slot for it in the environment's object array. Drat! But the power of Truffle is that we don't _need_ to statically prove that our slot assignments and usage are valid. We're not writing a compiler! Instead, we can just _assume_ that the slot assignments we make are valid, right up until we find that they aren't. Then we can fall back on a less efficient but more general approach. I won't elaborate much on the details of the code too much in step, it involves the most significant changes. At a high level, here's what we do: * Introduce a `LexicalScope` class that assigns symbols to array indices, and thread `LexicalScope` objects through our AST construction methods. * Extend `MalEnv` with a `staticBindings` Object array _in addition to_ the normal `bindings` HashMap. The Object array is constructed based on the number of symbols in the associated `LexicalScope`. The `bindings` HashMap is only constructed _lazily_, if a symbol that isn't in a `LexicalScope` is bound via a `def!`. * Further extend `MalEnv` with slot-based `get` and `set` methods, in addition to the existing symbol-based `get` and `set` methods. * Extend the AST nodes for `let*` and `fn*` to introduce new `LexicalScope` objects with the right symbols, assign slots to those symbols, and use the slot-based `get` and `set` methods on `MalEnv` to bind symbols. * Modify the AST node for symbol lookups to speculatively use slot-based lookups when the symbol in question is in a lexical scope _under the assumption that it has not been re-defined via `def!`. That last bit is the key to the whole thing: We use Truffle's `Assumption` abstraction to tell the compiler about the assumption that our slot-based symbol look-ups depend on. When a `LexicalScope` assigns a slot, it creates an `Assumption` that the symbol has not been bound by `def!` in that or any outer `LexicalScope`. The slot-based symbol lookup code is guarded by that assumption. The 'dynamic' `set` method of `MalEnv` (the one used by `def!`) is modified to _invalidate_ that assumption, triggering de-optimization of any symbol lookups that might have been rendered incorrect. After slot assignment, where do we stand? | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ---------- | -------------- | ----------------- | ----------------- | | Fib | 1700 ms | 829 ms (2.1x) | 219 ms (7.8x) | | Busywork | 781 ms | 686 ms (1.1x) | 394 ms (2.0x) | | Fib on Mal | 686 ms | 1932 ms (0.35x) | 1507 ms (0.46x) | This optimization starts to show off the real power of the Truffle framework on GraalVM, at least for the Fib benchmark. On the JDK, we see a modest improvement (1.2x) over Step B that comes from eliminating some of the HashMap overhead. Given the complexity that we had to introduce, this isn't very satisfying, On GraalVM, though, we see a better than 2x speed-up, taking us to almost 8x faster than the Java interpreter. However, the other two benchmarks show no meaningful improvement at all. Fib on Mal even seems to have become slower! Once again, we're bit by macros here. Recall that since we currently create a new AST each and every time we encounter a macro, the compiler never has a chance to compile it. We pay all the overhead of our extra book-keeping, and get absolutely no benefit. ### Step D: Caching Symbol Lookups We can take the symbol lookup improvements much further, now that we've laid the groundwork! Symbol lookups for symbols that are declared in some lexical scope will now use the fast-path Object array lookups instead of the HashMap lookups, and Truffle _should_ even be able to unroll the loops that walk up the chain of environments for us. For local symbol lookups, we probably won't do much better. But what about symbols in a function body that _aren't_ lexically in scope? In a well-behaved Mal program that isn't doing anything fancy with `def!`, these symbols will either produce runtime environments, or resolve to the global environment. In practice, they're almost always looking up core functions, whose values are unlikely (but not impossible!) to change over the lifetime of the program. We can _further_ specialize symbol lookups by simply caching looked-up values for symbols that are not lexically in scope, and _skipping subsequent lookups entirely_ unless the looked-up symbol gets rebound. Once again, we create an `Assumption` for each cached lookup to represent that we assume it has not been redefined, update `def!` to invalidate that assumption. | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ---------- | -------------- | ----------------- | ----------------- | | Fib | 1700 ms | 733 ms (2.3x) | 18 ms (94x !!) | | Busywork | 781 ms | 657 ms (1.2x) | 311 ms (2.5x) | | Fib on Mal | 686 ms | 1971 ms (0.35x) | 1474 ms (0.47x) | On our Fib benchmark, caching symbol lookups makes a _huge_ difference. Look at the code for `fib`: ``` (def! fib (fn* [n] (if (= n 0) 1 (if (= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))))) ``` There are 7 look-ups of symbols not in lexical scope (`=`, `=`, `+`, `fib`, `-`, `fib`, and `-`), and we've effectively eliminated all of them. All that's left are fast slot-based lookups for `n`, two comparisons, and three arithmetic operations. All of those end up getting inlined by the compiler. Moreover, the compiler actually 'unrolls' the recorsion several levels for us by inlining `fib` into itself. The result is quite fast, even out-performing type-hinted Clojure (Mal's inspiration)... on OpenJDK, anyway. Alas, the macros still defeat us on the other benchmarks, for the same reasons. The time has come to do something about that. ### Step E: Macro Inlining If we stay within the confines of Mal's semantics, macros are a show-stopper performance killer for us. Mal's macro semantics are just too dynamic for their own good. Sure, you _can_ write tail recursive macros... but why _would_ you? In practice, macros are often just introducing 'syntactic sugar' to improve expressiveness. Consider the macros `cond`, `or`, `and`, `->`, and `->>`. Their expansion behavior does not depend on runtime values (so they expand the same way on each application), and they produce code that is linear in the size of their inputs. Why do all the work to re-expand them on every application? Why not expand them _once_, and then just substitute the result? Clojure macros, for example, work this way. To make further progress, we're going to have to "cheat" our way into fast macros. We extend Mal's semantics such that a macro with a map for metadata containing the entry `:inline? true` is expanded once, and the result is _inlined_ in place of the macro application forever after. We then mark all of the above macros as inlined macros. This isn't a Truffle-specific optimization by any means. Any Mal interpreter that supports these semantics will see _substantial_ performance gains. However, the immutable nature of Mal data structures might make the refactoring of these interpreters a bit trickier than we'd like. Using Truffle, though, it's a trivial change. Truffle ASTs are explicitly self-modifying. It boils down to this: ```java if (fn.isMacro) { var expanded = applyMacro(env, fn); if (isInlinableMacro(fn)) { CompilerDirectives.transferToInterpreterAndInvalidate(); var newNode = expanded.body; this.replace(newNode); return newNode.executeGeneric(frame, env); } else { return invokeMacro(expanded); } else { ``` A few extra lines is all it takes. Look what happens now... | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ---------- | -------------- | ----------------- | ----------------- | | Fib | 1700 ms | 718 ms (2.3x) | 21 ms (81x) | | Busywork | 781 ms | 19 ms (41x) | 12 ms (65x) | | Fib on Mal | 686 ms | 104 ms (6.6x) | 25 ms (27x) | No substantial difference on Fib, which makes sense: that benchmark doesn't use macros. _Huge_ gains on Busywork and Fib on Mal, because both are so dependent on macros. It's a bit suspicious, though, that there isn't more of a performance difference between the OpenJDK and GraalVM runs. Maybe the test runs so fast we're not sufficiently warmed up? Let's crank up the number of iterations from 10k to 100k and see what happens. | Benchmark | Java (OpenJDK) | Truffle (OpenJDK) | Truffle (GraalVM) | | ------------ | -------------- | ----------------- | ----------------- | | Busywork 10x | 7264 ms | 223 ms (32x) | 37 ms (196x) | That's more like it. Recall that before this macro optimization, Java and Java Truffle were close in performance. If we implemented macro inlining in Java Mal, to make for a fair comparison, it's still likely that Truffle Mal wins by around 6-7x, which is pretty decent! What about the Fib on Mal benchmark? Why don't we see a bigger difference between the OpenJDK and GraalVM runs? It's not insufficient warm-up this time. Doing some profiling shows that we're spending quite a bit of time in code that isn't partially evaluated. For example, self-hosted Mal's environment implementation turns symbols into strings, and uses the strings as keys in environment maps, instead of just using the symbols themselves. The code for turning objects into strings in Printer depends heavily on JDK-provided classes that were not designed with partial evaluation in mind, so we must exclude them from partial evaluation to avoid an explosion in code size. ## Conclusions Does Truffle deliver on the promise of high-performance JIT-ed code via partial evaluation of interpreter code? Based on my experience, it certainly does. It's not exactly magic pixie dust that gives you 100x for free, but it doesn't claim to be. It _does_ enable order-of-magnitude speed improvements over plain old interpreters with _much_ less than an order-of-magnitude increase in effort. Let's revisit the questions we started with: *Do more complicated Mal programs show similar speed-ups?* No, GraalVM JIT compilation does not provide arbitrary Mal programs with the massive performance gains we see on the Fib benchmark. This should be totally unsurprising. *How much of the speed-up is really attributable to the Truffle/GraalVM combo, and how much came from optimizations that could be applied to any Mal interpreter?* Our benchmarks show that the answer depends heavily on the nature of the program. Let's look at the performance of Truffle Mal on GraalVM relative to its performance on OpenJDK (where we don't have the benefit of Truffle- enabled partial evaluation): | Benchmark | TruffleMal (GraalVM relative to OpenJDK) | | ------------ | ---------------------------------------- | | Fib | 34x | | Busywork 10x | 6x | | Fib On Mal | 4x | In extreme cases, for programs that are heavy on arithmetic and function calls, our use of Truffle/GraalVM buys us 30x _after accounting for our optimizations_. That's pretty amazing. Realistically, though, we're likely to see more 3-6x speed-ups directly attributable to Truffle/GraalVM. Still impressive! *How much simplicity did we have to sacrifice in the name of performance?* Let's look at the size, in lines of code, of each implementation. | File | LOC (Java) | LOC (Truffle Step A) | LOC (Truffle Step E) | | -------------- | ---------- | -------------------- | -------------------- | | stepA_mal.java | 310 | 757 | 886 | | env.java | 58 | 145 | 370 | | printer.java | 53 | 100 | 100 | | reader.java | 151 | 166 | 166 | | types.java | 381 | 532 | 545 | | core.java | 633 | 1506 | 1511 | | *Total* | 1586 | 3206 (2x) | 3578 (2.25x) | The Truffle-based implementation, before optimizations, weighs in at about 2x the size of the Java implementation. Much of this can be attributed to 'boilerplate' associated with use of the Truffle framework. In my opinion, this boilerplate adds effectively nothing to the conceptual complexity of the implementation. In fact, much of the extra weight comes from the core functions. The LOC count is longer because we make use of the Truffle DSL, a feature not covered in this write-up, to trivially allow specialization of core functions based on argument type. I would argue that while this increases code _size_, it may actually _reduce_ code complexity via a form of pattern matching. Our specializations to the interpreter nodes themselves added about 15%, or 120 lines. More significantly, we increased the size of the environment implementation by 2.5x, adding substantial complexity in the process. *Was it worth it?* This is both totally subjective and a gross over-simplification, but let's just guess that we've increased the complexity of the baseline Java interpreter overall by roughly 1.5 x, and environments in particular by 3x. In exchange for this increase in complexity, we've managed to obtain between from 25x to 80x better performance over the baseline Java interpreter, depending on the Mal program. We could perform most of our optimizations on that Java interpreter _without_ using Truffle. However, we'd end up at a similar level of complexity, and would see substantially smaller performance gains. Based on these results, if I were to attempt a 'production quality' Mal implementation, I'd probably do it with Truffle and GraalVM. The performance gains alone seem to justify it. It's also worth observing that the Truffle/GraalVM provide _other_ interesting benefits that are not performance-related. I won't cover them here. I think the most interesting non-performance benefit is the promise of interoperability with other Truffle languages. ## Bonus: AOT-compiled Mal GraalVM can ahead-of-time compile Java into a stand-alone executable (with some caveats) called a _native image_. This works even for Truffle interpreters! With AOT-compiled Mal, we get all the JIT compilation goodness of Truffle, _and_ we ditch the need for a Java runtime, **and** we skip the long JVM start-up time! A GraalVM native image of our Mal interpreter is well suited for scripts and command line applications. The `make-native.sh` script can be used to compile a native image of any Mal step. To run it, though, you'll need some additional [prerequisites](https://www.graalvm.org/reference-manual/native-image/#prerequisites). The `make-native.sh` script * assumes you've already run `gradle build` to compile all Java classes * takes as its only argument a step name, e.g. `step3_env` ** when no argument is supplied, `stepE_macros` is selected by default * produces a `build/${STEP}` native image ================================================ FILE: impls/java-truffle/build.gradle ================================================ /* * This file was generated by the Gradle 'init' task. */ plugins { id 'java' } repositories { mavenLocal() maven { url = uri('https://repo.maven.apache.org/maven2') } } dependencies { implementation 'org.graalvm.truffle:truffle-api:21.1.0' implementation 'org.organicdesign:Paguro:3.2.0' annotationProcessor 'org.graalvm.truffle:truffle-dsl-processor:21.1.0' } group = 'com.github.mmcgill' version = '0.0.1' sourceCompatibility = '11' task printClasspath { println sourceSets.main.runtimeClasspath.getAsPath() } ================================================ FILE: impls/java-truffle/make-native.sh ================================================ #!/usr/bin/env bash STEP=${1:-stepE_macros} CP=$(gradle -q --console plain printClasspath) native-image --macro:truffle --no-fallback --initialize-at-build-time \ -H:+TruffleCheckBlackListedMethods \ -cp "$CP" truffle.mal.$STEP build/$STEP ================================================ FILE: impls/java-truffle/run ================================================ #!/usr/bin/env bash CP=$(gradle -q --console plain printClasspath) # -Dgraal.LogVerbose=true \ # -Dgraal.TraceTruffleStackTraceLimit=100 \ # -Dgraal.TruffleCompilationThreshold=100 \ # -Dgraal.TraceTruffleCompilationDetails=true \ # -Dgraal.Dump=Truffle:2 \ # -Dgraal.TraceTruffleCompilation=true \ # -Dgraal.TruffleFunctionInlining=true \ # -Dgraal.TruffleCompilationExceptionsArePrinted=true \ java \ -Dgraalvm.locatorDisabled=true \ -Xss8m \ --add-opens org.graalvm.truffle/com.oracle.truffle.api=ALL-UNNAMED \ --add-opens org.graalvm.truffle/com.oracle.truffle.api.interop=ALL-UNNAMED \ --add-opens org.graalvm.truffle/com.oracle.truffle.api.nodes=ALL-UNNAMED \ -classpath $CP \ truffle.mal.${STEP:-stepE_macros} "$@" ================================================ FILE: impls/java-truffle/settings.gradle ================================================ /* * This file was generated by the Gradle 'init' task. */ rootProject.name = 'truffle-mal' ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/Core.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.FileInputStream; import java.io.FileNotFoundException; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.io.StringWriter; import java.util.ArrayList; import java.util.HashMap; import java.util.Map; import java.util.Stack; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.dsl.Fallback; import com.oracle.truffle.api.dsl.GenerateNodeFactory; import com.oracle.truffle.api.dsl.NodeChild; import com.oracle.truffle.api.dsl.NodeFactory; import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; class Core { static final Map> NS = new HashMap<>(); static { NS.put("+", AddBuiltinFactory.getInstance()); NS.put("-", SubtractBuiltinFactory.getInstance()); NS.put("*", MultiplyBuiltinFactory.getInstance()); NS.put("/", DivideBuiltinFactory.getInstance()); NS.put("prn", PrnBuiltinFactory.getInstance()); NS.put("list", ListBuiltinFactory.getInstance()); NS.put("list?", IsListBuiltinFactory.getInstance()); NS.put("empty?", IsEmptyBuiltinFactory.getInstance()); NS.put("count", CountBuiltinFactory.getInstance()); NS.put("=", EqualsBuiltinFactory.getInstance()); NS.put("<", LessThanBuiltinFactory.getInstance()); NS.put("<=", LessThanEqualBuiltinFactory.getInstance()); NS.put(">", GreaterThanBuiltinFactory.getInstance()); NS.put(">=", GreaterThanEqualBuiltinFactory.getInstance()); NS.put("pr-str", PrStrBuiltinFactory.getInstance()); NS.put("str", StrBuiltinFactory.getInstance()); NS.put("println", PrintlnBuiltinFactory.getInstance()); NS.put("read-string", ReadStringBuiltinFactory.getInstance()); NS.put("slurp", SlurpBuiltinFactory.getInstance()); NS.put("eval", EvalBuiltinFactory.getInstance()); NS.put("atom", AtomBuiltinFactory.getInstance()); NS.put("atom?", IsAtomBuiltinFactory.getInstance()); NS.put("deref", DerefBuiltinFactory.getInstance()); NS.put("reset!", ResetBuiltinFactory.getInstance()); NS.put("swap!", SwapBuiltinFactory.getInstance()); NS.put("cons", ConsBuiltinFactory.getInstance()); NS.put("concat", ConcatBuiltinFactory.getInstance()); NS.put("vec", VecBuiltinFactory.getInstance()); NS.put("nth", NthBuiltinFactory.getInstance()); NS.put("first", FirstBuiltinFactory.getInstance()); NS.put("rest", RestBuiltinFactory.getInstance()); NS.put("throw", ThrowBuiltinFactory.getInstance()); NS.put("apply", ApplyBuiltinFactory.getInstance()); NS.put("map", MapBuiltinFactory.getInstance()); NS.put("nil?", IsNilBuiltinFactory.getInstance()); NS.put("true?", IsTrueBuiltinFactory.getInstance()); NS.put("false?", IsFalseBuiltinFactory.getInstance()); NS.put("symbol?", IsSymbolBuiltinFactory.getInstance()); NS.put("symbol", SymbolBuiltinFactory.getInstance()); NS.put("keyword", KeywordBuiltinFactory.getInstance()); NS.put("keyword?", IsKeywordBuiltinFactory.getInstance()); NS.put("vector", VectorBuiltinFactory.getInstance()); NS.put("vector?", IsVectorBuiltinFactory.getInstance()); NS.put("sequential?", IsSequentialBuiltinFactory.getInstance()); NS.put("hash-map", HashMapBuiltinFactory.getInstance()); NS.put("map?", IsMapBuiltinFactory.getInstance()); NS.put("assoc", AssocBuiltinFactory.getInstance()); NS.put("dissoc", DissocBuiltinFactory.getInstance()); NS.put("get", GetBuiltinFactory.getInstance()); NS.put("contains?", ContainsBuiltinFactory.getInstance()); NS.put("keys", KeysBuiltinFactory.getInstance()); NS.put("vals", ValsBuiltinFactory.getInstance()); NS.put("readline", ReadlineBuiltinFactory.getInstance()); NS.put("meta", MetaBuiltinFactory.getInstance()); NS.put("with-meta", WithMetaBuiltinFactory.getInstance()); NS.put("time-ms", TimeMsBuiltinFactory.getInstance()); NS.put("conj", ConjBuiltinFactory.getInstance()); NS.put("string?", IsStringBuiltinFactory.getInstance()); NS.put("number?", IsNumberBuiltinFactory.getInstance()); NS.put("fn?", IsFnBuiltinFactory.getInstance()); NS.put("macro?", IsMacroBuiltinFactory.getInstance()); NS.put("seq", SeqBuiltinFactory.getInstance()); } static MalEnv newGlobalEnv(Class> languageClass, TruffleLanguage language) { var env = new MalEnv(languageClass); for (var entry : NS.entrySet()) { var root = new BuiltinRootNode(language, entry.getValue()); var fnVal = new MalFunction( Truffle.getRuntime().createCallTarget(root), null, root.getNumArgs(), // Built-in functions should not be tail called. It doesn't help with // stack consumption, since they aren't recursive, and it *does* // invalidate direct call sites, which hurts performance. false); env.set(MalSymbol.get(entry.getKey()), fnVal); } return env; } } abstract class AbstractInvokeNode extends Node { abstract Object invoke(CallTarget target, Object[] args); } /** A hack to make certain nodes sharable across languages. */ interface IMalLanguage { CallTarget evalForm(Object form); AbstractInvokeNode invokeNode(); PrintStream out(); BufferedReader in(); } abstract class BuiltinNode extends Node { protected IMalLanguage language; protected void setLanguage(IMalLanguage language) { this.language = language; } @TruffleBoundary protected static MalException illegalArgumentException(String expectedType, Object obj) { return new MalException("Illegal argument: '"+obj.toString()+"' is not of type "+expectedType); } final String name; protected BuiltinNode(String name) { this.name = name; } abstract Object executeGeneric(VirtualFrame frame); long executeLong(VirtualFrame frame) throws UnexpectedResultException { var value = executeGeneric(frame); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } boolean executeBoolean(VirtualFrame frame) throws UnexpectedResultException { var value = executeGeneric(frame); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } class ReadArgNode extends Node { final int argNum; ReadArgNode(int argNum) { this.argNum = argNum; } Object executeGeneric(VirtualFrame frame) { return frame.getArguments()[argNum]; } } class ReadArgsNode extends Node { final int argPos; ReadArgsNode(int argPos) { this.argPos = argPos; } Object executeGeneric(VirtualFrame frame) { Object[] args = frame.getArguments(); final var len = args.length - argPos; var result = new Object[len]; System.arraycopy(args, argPos, result, 0, len); return result; } } class BuiltinRootNode extends RootNode { private final int numArgs; @Child private BuiltinNode node; public BuiltinRootNode(TruffleLanguage lang, NodeFactory nodeFactory) { super(lang); var sig = nodeFactory.getExecutionSignature(); int numArgs = nodeFactory.getExecutionSignature().size(); Object[] readArgNodes = new Node[numArgs]; for (int i=0; i < numArgs; ++i) { if (sig.get(i).equals(ReadArgsNode.class)) { assert i == numArgs-1 : "ReadArgsNode must be last argument"; readArgNodes[i] = new ReadArgsNode(i+1); numArgs = -1; // variadic } else { readArgNodes[i] = new ReadArgNode(i+1); } } node = nodeFactory.createNode(readArgNodes); if (lang instanceof IMalLanguage) { node.setLanguage((IMalLanguage)lang); } this.numArgs = numArgs; } public int getNumArgs() { return numArgs; } @Override public Object execute(VirtualFrame frame) { return node.executeGeneric(frame); } @Override public String toString() { return "#"; } } /************** MATH *******************/ @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class AddBuiltin extends BuiltinNode { protected AddBuiltin() { super("+"); } @Specialization protected long add(long lhs, long rhs) { return lhs + rhs; } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class SubtractBuiltin extends BuiltinNode { protected SubtractBuiltin() { super("-"); } @Specialization protected long subtract(long lhs, long rhs) { return lhs - rhs; } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class MultiplyBuiltin extends BuiltinNode { protected MultiplyBuiltin() { super("*"); } @Specialization protected long multiply(long lhs, long rhs) { return lhs * rhs; } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class DivideBuiltin extends BuiltinNode { protected DivideBuiltin() { super("/"); } @Specialization protected long divide(long lhs, long rhs) { return lhs / rhs; } } /************** STRINGS *******************/ @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class PrnBuiltin extends BuiltinNode { protected PrnBuiltin() { super("prn"); } @Specialization @TruffleBoundary protected Object prn(Object[] args) { var buf = new StringBuilder(); if (args.length > 0) { Printer.prStr(buf, args[0], true); } for (int i=1; i < args.length; ++i) { buf.append(' '); Printer.prStr(buf, args[i], true); } language.out().println(buf.toString()); return MalNil.NIL; } } @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class PrStrBuiltin extends BuiltinNode { protected PrStrBuiltin() { super("pr-str"); } @Specialization @TruffleBoundary protected String prStr(Object... args) { var buf = new StringBuilder(); if (args.length > 0) { Printer.prStr(buf, args[0], true); } for (int i=1; i < args.length; ++i) { buf.append(' '); Printer.prStr(buf, args[i], true); } return buf.toString(); } } @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class StrBuiltin extends BuiltinNode { protected StrBuiltin() { super("str"); } @Specialization @TruffleBoundary protected String prStr(Object... args) { var buf = new StringBuilder(); for (int i=0; i < args.length; ++i) { Printer.prStr(buf, args[i], false); } return buf.toString(); } } @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class PrintlnBuiltin extends BuiltinNode { protected PrintlnBuiltin() { super("println"); } @Specialization @TruffleBoundary protected MalNil println(Object... args) { var buf = new StringBuilder(); if (args.length > 0) { Printer.prStr(buf, args[0], false); } for (int i=1; i < args.length; ++i) { buf.append(' '); Printer.prStr(buf, args[i], false); } // The correct thing is to use the output stream associated with our language context. // However, since each step is effectively its own language, and we wish // to share this node among them, we'll just cheat and call System.out directly. language.out().println(buf.toString()); return MalNil.NIL; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class ReadStringBuiltin extends BuiltinNode { protected ReadStringBuiltin() { super("read-string"); } @TruffleBoundary @Specialization protected Object readString(String s) { return Reader.readStr(s); } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class SlurpBuiltin extends BuiltinNode { protected SlurpBuiltin() { super("slurp"); } @TruffleBoundary @Specialization protected String slurp(String path) { try { var writer = new StringWriter(); var reader = new InputStreamReader(new FileInputStream(path)); try { reader.transferTo(writer); return writer.toString(); } finally { reader.close(); } } catch (FileNotFoundException ex) { throw new MalException(ex.getMessage()); } catch (IOException ex) { throw new MalException(ex.getMessage()); } } } /************ COLLECTIONS *****************/ @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class ListBuiltin extends BuiltinNode { protected ListBuiltin() { super("list"); } @Specialization protected MalList list(Object[] args) { var result = MalList.EMPTY; for (int i=args.length-1; i >= 0; --i) { result = result.cons(args[i]); } return result; } } @NodeChild(value = "list", type = ReadArgNode.class) @GenerateNodeFactory abstract class IsListBuiltin extends BuiltinNode { protected IsListBuiltin() { super("list?"); } @Specialization public boolean isList(MalList list) { return true; } @Fallback public boolean isList(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsEmptyBuiltin extends BuiltinNode { protected IsEmptyBuiltin() { super("empty?"); } @Specialization protected boolean isEmpty(MalList list) { return list.head == null; } @Specialization protected boolean isEmpty(MalVector vector) { return vector.size() == 0; } @Fallback protected Object typeError(Object arg) { throw illegalArgumentException("list", arg); } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class CountBuiltin extends BuiltinNode { protected CountBuiltin() { super("count"); } @Specialization protected long count(MalList arg) { return arg.length; } @Specialization protected long count(MalVector arg) { return arg.size(); } @Specialization protected long count(MalNil arg) { return 0; } @Fallback protected Object count(Object arg) { throw illegalArgumentException("list", arg); } } @NodeChild(value="obj", type=ReadArgNode.class) @NodeChild(value="list", type=ReadArgNode.class) @GenerateNodeFactory abstract class ConsBuiltin extends BuiltinNode { protected ConsBuiltin() { super("cons"); } @Specialization @TruffleBoundary protected MalList cons(Object obj, MalVector vec) { return cons(obj, vec.toList()); } @Specialization @TruffleBoundary protected MalList cons(Object obj, MalList list) { return list.cons(obj); } } @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class ConcatBuiltin extends BuiltinNode { protected ConcatBuiltin() { super("concat"); } private MalList concat1(MalList a, MalList b) { var elems = new Stack(); for (Object elem : a) { elems.push(elem); } while (!elems.isEmpty()) { b = b.cons(elems.pop()); } return b; } private MalList concat1(MalVector a, MalList b) { for (int i=a.size()-1; i >= 0; i--) { b = b.cons(a.get(i)); } return b; } @Specialization @TruffleBoundary protected MalList concat(Object... args) { if (args.length == 0) { return MalList.EMPTY; } Object arg = args[args.length-1]; MalList result; if (arg instanceof MalVector) { result = ((MalVector) arg).toList(); } else { result = (MalList)arg; } for (int i=args.length-2; i >= 0; --i) { arg = args[i]; if (arg instanceof MalVector) { result = concat1((MalVector)arg, result); } else { result = concat1((MalList)arg, result); } } return result; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class VecBuiltin extends BuiltinNode { protected VecBuiltin() { super("vec"); } @Specialization protected MalVector vec(MalVector v) { return v; } @Specialization protected MalVector vec(MalList l) { return MalVector.EMPTY.concat(l); } } @NodeChild(value="list", type=ReadArgNode.class) @NodeChild(value="n", type=ReadArgNode.class) @GenerateNodeFactory abstract class NthBuiltin extends BuiltinNode { protected NthBuiltin() { super("nth"); } @Specialization @TruffleBoundary protected Object nth(MalVector vec, long n) { if (n >= vec.size()) { throwInvalidArgument(); } return vec.get((int)n); } private void throwInvalidArgument() { throw new MalException("Out of bounds"); } @Specialization protected Object nth(MalList list, long n) { if (n >= list.length) { throwInvalidArgument(); } while (--n >= 0) { list = list.tail; } return list.head; } } @GenerateNodeFactory @NodeChild(value="arg", type=ReadArgNode.class) abstract class FirstBuiltin extends BuiltinNode { protected FirstBuiltin() { super("first"); } @Specialization protected MalNil first(MalNil nil) { return MalNil.NIL; } @Specialization protected Object first(MalVector vec) { if (vec.size() == 0) return MalNil.NIL; return vec.get(0); } @Specialization protected Object first(MalList list) { if (list.head == null) { return MalNil.NIL; } return list.head; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class RestBuiltin extends BuiltinNode { protected RestBuiltin() { super("rest"); } @Specialization protected MalList rest(MalNil nil) { return MalList.EMPTY; } @Specialization @TruffleBoundary protected MalList rest(MalVector vec) { return rest(vec.toList()); } @Specialization protected MalList rest(MalList list) { if (list.head == null) { return list; } return list.tail; } } @NodeChild(value="fn", type=ReadArgNode.class) @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class ApplyBuiltin extends BuiltinNode { @Child private AbstractInvokeNode invokeNode; protected ApplyBuiltin() { super("apply"); } @Override protected void setLanguage(IMalLanguage language) { super.setLanguage(language); this.invokeNode = language.invokeNode(); } @TruffleBoundary private Object[] getArgs(Object[] args) { Object[] fnArgs; if (args.length == 0) { fnArgs = args; } else { Object lastArg = args[args.length-1]; int lastArgSize; if (lastArg instanceof MalVector) { lastArgSize = ((MalVector)lastArg).size(); } else { lastArgSize = (int)((MalList)lastArg).length; } fnArgs = new Object[args.length + lastArgSize]; for (int i=0; i < args.length-1; i++) { fnArgs[i+1] = args[i]; } int i = args.length; assert lastArg instanceof Iterable; for (Object obj : ((Iterable)lastArg)) { fnArgs[i++] = obj; } } return fnArgs; } @Specialization protected Object apply(VirtualFrame frame, MalFunction fn, Object[] args) { var fnArgs = getArgs(args); fnArgs[0] = fn.closedOverEnv; return invokeNode.invoke(fn.callTarget, fnArgs); } } @NodeChild(value="fn", type=ReadArgNode.class) @NodeChild(value="col", type=ReadArgNode.class) @GenerateNodeFactory abstract class MapBuiltin extends BuiltinNode { @Child private AbstractInvokeNode invokeNode; protected MapBuiltin() { super("map"); } @Override protected void setLanguage(IMalLanguage language) { super.setLanguage(language); invokeNode = language.invokeNode(); } @TruffleBoundary private Object doMap(MalFunction fn, Iterable vals) { var result = new ArrayList(); Object[] args = new Object[2]; args[0] = fn.closedOverEnv; for (Object obj : vals) { args[1] = obj; result.add(invokeNode.invoke(fn.callTarget, args)); } return MalList.from(result); } @Specialization protected Object map(MalFunction fn, MalVector vec) { return doMap(fn, vec); } @Specialization protected Object map(MalFunction fn, MalList list) { return doMap(fn, list); } } @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class VectorBuiltin extends BuiltinNode { protected VectorBuiltin() { super("vector"); } @TruffleBoundary @Specialization public MalVector vector(Object[] args) { MalVector v = MalVector.EMPTY; for (Object arg : args) { v = v.append(arg); } return v; } } @NodeChild(value="col", type=ReadArgNode.class) @NodeChild(value="elems", type=ReadArgsNode.class) @GenerateNodeFactory abstract class ConjBuiltin extends BuiltinNode { protected ConjBuiltin() { super("conj"); } @Specialization protected MalList conj(MalList list, Object[] elems) { for (int i=0; i < elems.length; i++) { list = list.cons(elems[i]); } return list; } @Specialization protected MalVector conj(MalVector vec, Object[] elems) { for (int i=0; i < elems.length; i++) { vec = vec.append(elems[i]); } return vec; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class SeqBuiltin extends BuiltinNode { protected SeqBuiltin() { super("seq"); } @Specialization protected Object seq(MalList list) { if (list.length == 0) { return MalNil.NIL; } return list; } @Specialization protected Object seq(MalVector vec) { if (vec.size() == 0) { return MalNil.NIL; } return vec.toList(); } @Specialization protected Object seq(String str) { if (str.isEmpty()) { return MalNil.NIL; } MalList l = MalList.EMPTY; for (int i=str.length()-1; i >= 0; i--) { l = l.cons(str.substring(i, i+1)); } return l; } @Specialization protected MalNil seq(MalNil nil) { return nil; } } /************* Maps ********************/ @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class HashMapBuiltin extends BuiltinNode { protected HashMapBuiltin() { super("hash-map"); } @Specialization @TruffleBoundary protected MalMap hashMap(Object[] args) { MalMap map = MalMap.EMPTY; for (int i=0; i < args.length; i += 2) { map = map.assoc(args[i], args[i+1]); } return map; } } @NodeChild(value="map", type=ReadArgNode.class) @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class AssocBuiltin extends BuiltinNode { protected AssocBuiltin() { super("assoc"); } @Specialization protected Object assoc(MalMap map, Object[] args) { for (int i=0; i < args.length; i+=2) { map = map.assoc(args[i], args[i+1]); } return map; } } @NodeChild(value="map", type=ReadArgNode.class) @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class DissocBuiltin extends BuiltinNode { protected DissocBuiltin() { super("dissoc"); } @Specialization protected MalMap dissoc(MalMap map, Object[] args) { for (Object arg : args) { map = map.dissoc(arg); } return map; } } @NodeChild(value="map", type=ReadArgNode.class) @NodeChild(value="key", type=ReadArgNode.class) @GenerateNodeFactory abstract class GetBuiltin extends BuiltinNode { protected GetBuiltin() { super("get"); } @Specialization @TruffleBoundary protected Object get(MalMap map, Object key) { return map.map.getOrDefault(key, MalNil.NIL); } @Specialization protected Object get(MalNil nil, Object key) { return MalNil.NIL; } } @NodeChild(value="map", type=ReadArgNode.class) @NodeChild(value="key", type=ReadArgNode.class) @GenerateNodeFactory abstract class ContainsBuiltin extends BuiltinNode { protected ContainsBuiltin() { super("contains?"); } @Specialization @TruffleBoundary protected boolean contains(MalMap map, Object key) { return map.map.containsKey(key); } } @NodeChild(value="map", type=ReadArgNode.class) @GenerateNodeFactory abstract class KeysBuiltin extends BuiltinNode { protected KeysBuiltin() { super("keys"); } @Specialization @TruffleBoundary protected MalList keys(MalMap map) { MalList list = MalList.EMPTY; var iter = map.map.keyIterator(); while (iter.hasNext()) { list = list.cons(iter.next()); } return list; } } @NodeChild(value="map", type=ReadArgNode.class) @GenerateNodeFactory abstract class ValsBuiltin extends BuiltinNode { protected ValsBuiltin() { super("vals"); } @Specialization @TruffleBoundary protected Object vals(MalMap map) { MalList list = MalList.EMPTY; var iter = map.map.valIterator(); while (iter.hasNext()) { list = list.cons(iter.next()); } return list; } } /************* COMPARISONS *************/ @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class EqualsBuiltin extends BuiltinNode { protected EqualsBuiltin() { super("="); } @Specialization protected boolean equals(long lhs, long rhs) { return lhs == rhs; } @Specialization protected boolean equals(boolean lhs, boolean rhs) { return lhs == rhs; } @TruffleBoundary @Specialization protected boolean equals(String lhs, String rhs) { return lhs.equals(rhs); } @Specialization protected boolean equals(MalFunction lhs, MalFunction rhs) { return lhs == rhs; } @Specialization protected boolean equals(MalNil lhs, MalNil rhs) { return lhs == rhs; } @TruffleBoundary @Specialization protected boolean equals(MalValue lhs, MalValue rhs) { if (lhs == null) { return lhs == rhs; } else { return lhs.equals(rhs); } } @Fallback protected boolean equals(Object lhs, Object rhs) { return false; } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class GreaterThanBuiltin extends BuiltinNode { protected GreaterThanBuiltin() { super(">"); } @Specialization protected boolean greaterThan(long lhs, long rhs) { return lhs > rhs; } @Specialization protected Object typeError(Object lhs, long rhs) { throw illegalArgumentException("integer", lhs); } @Fallback protected Object typeError(Object lhs, Object rhs) { throw illegalArgumentException("integer", rhs); } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class GreaterThanEqualBuiltin extends BuiltinNode { protected GreaterThanEqualBuiltin() { super(">="); } @Specialization protected boolean greaterThanEqual(long lhs, long rhs) { return lhs >= rhs; } @Specialization protected Object typeError(Object lhs, long rhs) { throw illegalArgumentException("integer", lhs); } @Fallback protected Object typeError(Object lhs, Object rhs) { throw illegalArgumentException("integer", rhs); } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class LessThanBuiltin extends BuiltinNode { protected LessThanBuiltin() { super("<"); } @Specialization protected boolean lessThan(long lhs, long rhs) { return lhs < rhs; } @Specialization protected Object typeError(Object lhs, long rhs) { throw illegalArgumentException("integer", lhs); } @Fallback protected Object typeError(Object lhs, Object rhs) { throw illegalArgumentException("integer", rhs); } } @NodeChild(value="lhs", type=ReadArgNode.class) @NodeChild(value="rhs", type=ReadArgNode.class) @GenerateNodeFactory abstract class LessThanEqualBuiltin extends BuiltinNode { protected LessThanEqualBuiltin() { super("<="); } @Specialization protected boolean lessThanEqual(long lhs, long rhs) { return lhs <= rhs; } @Specialization protected Object typeError(Object lhs, long rhs) { throw illegalArgumentException("integer", lhs); } @Fallback protected Object typeError(Object lhs, Object rhs) { throw illegalArgumentException("integer", rhs); } } /*************** Atoms ********************/ @NodeChild(value="val", type=ReadArgNode.class) @GenerateNodeFactory abstract class AtomBuiltin extends BuiltinNode { protected AtomBuiltin() { super("atom"); } @Specialization protected MalAtom atom(Object val) { return new MalAtom(val); } } @NodeChild(value="val", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsAtomBuiltin extends BuiltinNode { protected IsAtomBuiltin() { super("atom?"); } @Specialization protected boolean isAtom(Object obj) { return obj instanceof MalAtom; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class DerefBuiltin extends BuiltinNode { protected DerefBuiltin() { super("deref"); } @Specialization protected Object deref(MalAtom atom) { return atom.deref(); } } @NodeChild(value="atom", type=ReadArgNode.class) @NodeChild(value="val", type=ReadArgNode.class) @GenerateNodeFactory abstract class ResetBuiltin extends BuiltinNode { protected ResetBuiltin() { super("reset!"); } @Specialization protected Object reset(MalAtom atom, Object val) { atom.reset(val); return val; } } @NodeChild(value="atom", type=ReadArgNode.class) @NodeChild(value="fn", type=ReadArgNode.class) @NodeChild(value="args", type=ReadArgsNode.class) @GenerateNodeFactory abstract class SwapBuiltin extends BuiltinNode { @Child private AbstractInvokeNode invokeNode; protected SwapBuiltin() { super("swap!"); } @Override protected void setLanguage(IMalLanguage language) { super.setLanguage(language); this.invokeNode = language.invokeNode(); } @Specialization protected Object swap(MalAtom atom, MalFunction fn, Object... args) { synchronized (atom) { Object[] fnArgs = new Object[2+args.length]; fnArgs[0] = fn.closedOverEnv; fnArgs[1] = atom.deref(); for (int i=0; i < args.length; i++) { fnArgs[i+2] = args[i]; } Object newVal = invokeNode.invoke(fn.callTarget, fnArgs); atom.reset(newVal); return newVal; } } } /*************** Predicates ***************/ @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsNilBuiltin extends BuiltinNode { protected IsNilBuiltin() { super("nil?"); } @Specialization protected boolean isNil(MalNil nil) { return true; } @Fallback protected boolean isNil(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsTrueBuiltin extends BuiltinNode { protected IsTrueBuiltin() { super("true?"); } @Specialization protected boolean isTrue(boolean b) { return b == true; } @Fallback protected boolean isTrue(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsFalseBuiltin extends BuiltinNode { protected IsFalseBuiltin() { super("false?"); } @Specialization protected boolean isFalse(boolean b) { return b == false; } @Fallback protected boolean isFalse(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsSymbolBuiltin extends BuiltinNode { protected IsSymbolBuiltin() { super("symbol?"); } @Specialization protected boolean isSymbol(MalSymbol sym) { return true; } @Fallback protected boolean isSymbol(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsKeywordBuiltin extends BuiltinNode { protected IsKeywordBuiltin() { super("keyword?"); } @Specialization protected boolean isKeyword(MalKeyword kw) { return true; } @Fallback protected boolean isKeyword(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsVectorBuiltin extends BuiltinNode { protected IsVectorBuiltin() { super("vector?"); } @Specialization protected boolean isVector(MalVector vec) { return true; } @Fallback protected boolean isVector(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsSequentialBuiltin extends BuiltinNode { protected IsSequentialBuiltin() { super("sequential?"); } @Specialization protected Object isSequential(MalList list) { return true; } @Specialization protected Object isSequential(MalVector vec) { return true; } @Fallback protected Object isSequential(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsMapBuiltin extends BuiltinNode { protected IsMapBuiltin() { super("map?"); } @Specialization protected boolean isMap(MalMap map) { return true; } @Fallback protected boolean isMap(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsStringBuiltin extends BuiltinNode { protected IsStringBuiltin() { super("string?"); } @Specialization protected boolean isString(String val) { return true; } @Fallback protected boolean isString(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsNumberBuiltin extends BuiltinNode { protected IsNumberBuiltin() { super("number?"); } @Specialization protected boolean isNumber(long n) { return true; } @Fallback protected boolean isNumber(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsFnBuiltin extends BuiltinNode { protected IsFnBuiltin() { super("fn?"); } @Specialization protected boolean isFn(MalFunction fn) { return !fn.isMacro; } @Fallback protected boolean isFn(Object obj) { return false; } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class IsMacroBuiltin extends BuiltinNode { protected IsMacroBuiltin() { super("macro?"); } @Specialization protected boolean isMacro(MalFunction fn) { return fn.isMacro; } @Fallback protected boolean isMacro(Object obj) { return false; } } /*************** Other ********************/ @NodeChild(value="ast", type=ReadArgNode.class) @GenerateNodeFactory abstract class EvalBuiltin extends BuiltinNode { protected EvalBuiltin() { super("eval"); } @Specialization @TruffleBoundary protected Object eval(Object ast) { return language.evalForm(ast).call(); } } @NodeChild(value="obj", type=ReadArgNode.class) @GenerateNodeFactory abstract class ThrowBuiltin extends BuiltinNode { protected ThrowBuiltin() { super("throw"); } @TruffleBoundary @Specialization protected Object throwException(String obj) { throw new MalException(obj); } @TruffleBoundary @Fallback protected Object throwException(Object obj) { throw new MalException(obj); } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class SymbolBuiltin extends BuiltinNode { protected SymbolBuiltin() { super("symbol"); } @Specialization protected MalSymbol symbol(String str) { return MalSymbol.get(str); } @Specialization protected MalSymbol symbol(MalSymbol sym) { return sym; } } @GenerateNodeFactory @NodeChild(value="arg", type=ReadArgNode.class) abstract class KeywordBuiltin extends BuiltinNode { protected KeywordBuiltin() { super("keyword"); } @Specialization protected MalKeyword keyword(String arg) { return MalKeyword.get(arg); } @Specialization protected MalKeyword keyword(MalKeyword kw) { return kw; } } @NodeChild(value="prompt", type=ReadArgNode.class) @GenerateNodeFactory abstract class ReadlineBuiltin extends BuiltinNode { protected ReadlineBuiltin() { super("readline"); } @Specialization @TruffleBoundary protected Object readline(String prompt) { language.out().print(prompt); language.out().flush(); try { String s = language.in().readLine(); return s == null ? MalNil.NIL : s; } catch (IOException ex) { throw new MalException(ex.getMessage()); } } } @NodeChild(value="arg", type=ReadArgNode.class) @GenerateNodeFactory abstract class MetaBuiltin extends BuiltinNode { protected MetaBuiltin() { super("meta"); } @Specialization protected Object meta(MetaHolder arg) { return arg.getMeta(); } @Fallback protected Object meta(Object obj) { return MalNil.NIL; } } @NodeChild(value="arg", type=ReadArgNode.class) @NodeChild(value="meta", type=ReadArgNode.class) @GenerateNodeFactory abstract class WithMetaBuiltin extends BuiltinNode { protected WithMetaBuiltin() { super("with-meta"); } @Specialization protected Object withMeta(MetaHolder holder, Object meta) { return holder.withMeta(meta); } } @GenerateNodeFactory abstract class TimeMsBuiltin extends BuiltinNode { protected TimeMsBuiltin() { super("time-ms"); } @TruffleBoundary @Specialization protected long timeMs() { return System.nanoTime() / 1000000; } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/MalEnv.java ================================================ package truffle.mal; import java.util.HashMap; import java.util.Map; import com.oracle.truffle.api.Assumption; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.interop.InteropLibrary; import com.oracle.truffle.api.interop.InvalidArrayIndexException; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.library.ExportLibrary; import com.oracle.truffle.api.library.ExportMessage; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.utilities.UnionAssumption; import truffle.mal.LexicalScope.EnvSlot; @ExportLibrary(InteropLibrary.class) class MalEnv implements TruffleObject { final Class> language; final MalEnv outer; // bindings is initialized lazily, to avoid the overhead of creating a new HashMap // in cases where nothing will be bound (e.g. invoking a function with no arguments) private Map bindings; final LexicalScope scope; final Object[] staticBindings; private Map cachedResults; private MalEnv(Class> language, MalEnv outer, LexicalScope scope, Object[] staticBindings) { this.language = language; this.outer = outer; this.scope = scope; this.staticBindings = staticBindings; } MalEnv(Class> language) { this(language, null, null, null); } MalEnv(MalEnv outer) { this(outer.language, outer, null, null); } MalEnv(Class> language, LexicalScope scope) { this(language, null, scope, new Object[scope.getStaticBindingCount()]); } MalEnv(MalEnv outer, LexicalScope scope) { this(outer.language, outer, scope, new Object[scope.getStaticBindingCount()]); } /** * Dynamic set, for use by def! to bind a symbol that wasn't assigned a slot via a LexicalScope. * * @param symbol the symbol to bind * @param value its new value */ @TruffleBoundary void set(MalSymbol symbol, Object value) { if (bindings == null) { bindings = new HashMap<>(); } if (!bindings.containsKey(symbol) && scope != null) { scope.wasDynamicallyBound(symbol); } if (cachedResults != null) { var result = cachedResults.get(symbol); if (result != null) { result.notRedefined.invalidate(); } } bindings.put(symbol, value); } /** * Bind a symbol that was assigned a slot via a LexicalScope. * @param slot the slot assigned to the symbol * @param value the symbol's new value */ void set(EnvSlot slot, Object value) { assert slot.height == 0; staticBindings[slot.slotNum] = value; } /** * Dynamic get, for when the looked-up symbol has been assigned a slot * but isn't guaranteed to resolve from that lexical scope, e.g. because a def! * may have dynamically bound it in an inner scope. * * @param symbol * @param slot * @return */ @TruffleBoundary Object get(MalSymbol symbol, EnvSlot slot) { var env = this; int height = 0; while (height < slot.height) { Object result = null; if (env.bindings != null) { result = env.bindings.get(symbol); } if (result != null) { return result; } env = env.outer; height++; } return env.staticBindings[slot.slotNum]; } /** * Dynamic get, for when the looked-up symbol has no statically assigned slot. * * @param symbol the symbol to look up * @return its current value, or null if unbound */ @TruffleBoundary Object get(MalSymbol symbol) { MalEnv env = this; while (env != null) { if (env.bindings != null) { var result = env.bindings.get(symbol); if (result != null) { return result; } } env = env.outer; } return null; } @TruffleBoundary CachedResult cachedGet(MalSymbol symbol) { if (cachedResults == null) { cachedResults = new HashMap<>(); } var result = cachedResults.get(symbol); if (result == null) { Object obj = null; if (bindings != null) { obj = bindings.get(symbol); } if (obj == null && outer != null) { result = outer.cachedGet(symbol); } else { result = new CachedResult(obj); } cachedResults.put(symbol, result); } return result; } /** * Static get, for when the looked-up symbol is guaranteed to resolve from a particular lexical scope. * @param slot * @return */ @ExplodeLoop Object get(EnvSlot slot) { MalEnv env = this; for (int i=0; i < slot.height; i++) { env = env.outer; } return env.staticBindings[slot.slotNum]; } @ExportMessage boolean hasLanguage() { return true; } @ExportMessage Class> getLanguage() { return language; } @ExportMessage boolean hasMembers() { return true; } @ExportMessage @TruffleBoundary Object readMember(String member) { return bindings.get(MalSymbol.get(member)); } @ExportMessage @TruffleBoundary boolean isMemberReadable(String member) { return bindings.containsKey(MalSymbol.get(member)); } @ExportMessage @TruffleBoundary Object toDisplayString(boolean allowSideEffects) { return "#"; } @ExportMessage @TruffleBoundary boolean isMemberInsertable(String member) { return !bindings.containsKey(MalSymbol.get(member)); } @ExportMessage @TruffleBoundary boolean isMemberModifiable(String member) { return bindings.containsKey(MalSymbol.get(member)); } @ExportMessage @TruffleBoundary void writeMember(String member, Object value) { set(MalSymbol.get(member), value); } @ExportMessage @TruffleBoundary Object getMembers(boolean includeInternal) { Object[] names = new Object[bindings.size()]; int i=0; for (MalSymbol sym : bindings.keySet()) { names[i++] = sym.symbol; } return new EnvMembersObject(names); } static class CachedResult { final Object result; final Assumption notRedefined = Truffle.getRuntime().createAssumption(); CachedResult(Object result) { this.result = result; } } } @ExportLibrary(InteropLibrary.class) final class EnvMembersObject implements TruffleObject { private final Object[] names; EnvMembersObject(Object[] names) { this.names = names; } @ExportMessage boolean hasArrayElements() { return true; } @ExportMessage boolean isArrayElementReadable(long index) { return index >= 0 && index < names.length; } @ExportMessage long getArraySize() { return names.length; } @ExportMessage Object readArrayElement(long index) throws InvalidArrayIndexException { if (!isArrayElementReadable(index)) { CompilerDirectives.transferToInterpreter(); throw InvalidArrayIndexException.create(index); } return names[(int)index]; } } /** * A LexicalScope tracks the variables known statically to be in a given lexical scope, and keeps track of * associated environment slots. */ class LexicalScope { final LexicalScope parent; final int depth; final Map slots; private int staticBindingCount; final Map notDynamicallyBound; LexicalScope() { this(null); } LexicalScope(LexicalScope parent) { this.parent = parent; this.depth = parent == null? 0 : parent.depth+1; this.slots = new HashMap<>(); this.staticBindingCount = 0; this.notDynamicallyBound = new HashMap<>(); } private Assumption getNotDynamicallyBound(MalSymbol symbol) { var assumption = notDynamicallyBound.get(symbol); if (assumption == null) { assumption = Truffle.getRuntime().createAssumption(symbol.symbol+" not dynamically shadowed"); notDynamicallyBound.put(symbol, assumption); } return assumption; } /** * Allocate a slot for a symbol in this lexical scope, or return the slot already bound to the symbol. * * @param symbol * @return */ @TruffleBoundary public EnvSlot allocateSlot(MalSymbol symbol) { var slot = new EnvSlot(0, slots.size(), getNotDynamicallyBound(symbol)); slots.put(symbol, slot); staticBindingCount++; return slot; } /** * If symbols is statically known to be in scope, returns a slot that can be used to look up * the bound symbol efficiently. Otherwise, returns null; * * @param symbol * @return */ @TruffleBoundary public EnvSlot getSlot(MalEnv env, MalSymbol symbol) { int height = 0; var scope = this; Assumption assumption = getNotDynamicallyBound(symbol); while (scope != null) { if (scope.slots.containsKey(symbol)) { var slot = scope.slots.get(symbol); if (env.get(slot) != null) { if (height == 0) { return slot; } else { return new EnvSlot(height, scope.slots.get(symbol).slotNum, assumption); } } } height++; scope = scope.parent; env = env.outer; if (scope != null) { assumption = new UnionAssumption(assumption, scope.getNotDynamicallyBound(symbol)); } } return null; } @TruffleBoundary public void wasDynamicallyBound(MalSymbol sym) { var assumption = notDynamicallyBound.get(sym); if (assumption != null) { assumption.invalidate(); } } public int getStaticBindingCount() { return staticBindingCount; } static class EnvSlot { public final int height; public final int slotNum; public final Assumption notDynamicallyBound; private EnvSlot(int height, int slotNum, Assumption notDynamicallyBound) { this.height = height; this.slotNum = slotNum; this.notDynamicallyBound = notDynamicallyBound; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/Printer.java ================================================ package truffle.mal; public class Printer { public static String prStr(Object form, boolean printReadably) { var buf = new StringBuilder(); prStr(buf, form, printReadably); return buf.toString(); } public static void prStr(StringBuilder buf, Object form, boolean printReadably) { if (form instanceof Boolean) { buf.append((boolean)form); } else if (form instanceof Long) { buf.append((long)form); } else if (form instanceof String) { var s = (String)form; if (printReadably) { buf.append('"'); buf.append(s.replace("\\", "\\\\").replace("\n", "\\n").replace("\"", "\\\"")); buf.append('"'); } else { buf.append(s); } } else if (form instanceof MalSymbol) { buf.append(((MalSymbol)form).symbol); } else if (form instanceof MalKeyword) { buf.append(':'); buf.append(((MalKeyword)form).keyword); } else if (form instanceof MalNil) { buf.append("nil"); } else if (form instanceof MalList) { var list = (MalList)form; buf.append("("); MalList l = list; while (l != null && l.head != null) { prStr(buf, l.head, printReadably); l = l.tail; if (l.head != null) { buf.append(' '); } } buf.append(")"); } else if (form instanceof MalVector) { var vector = (MalVector)form; final int size = vector.size(); buf.append('['); for (int i=0; i < size; ++i) { prStr(buf, vector.get(i), printReadably); if (i < size-1) { buf.append(' '); } } buf.append(']'); } else if (form instanceof MalMap) { var map = (MalMap)form; int i = 0; buf.append('{'); for (var entry : map.map) { prStr(buf, entry.getKey(), printReadably); buf.append(' '); prStr(buf, entry.getValue(), printReadably); if (++i < map.map.size()) { buf.append(' '); } } buf.append('}'); } else if (form instanceof MalFunction) { buf.append("#"); } else if (form instanceof MalAtom) { buf.append("(atom "); prStr(buf, ((MalAtom)form).deref(), printReadably); buf.append(")"); } else { throw new RuntimeException("Not a MAL type: "+form.getClass().getCanonicalName()); } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/Reader.java ================================================ package truffle.mal; import java.util.ArrayList; import java.util.List; import java.util.regex.Pattern; public class Reader { private static final Pattern TOKEN_PATTERN = Pattern.compile("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)"); public static List tokenize(String s) { var m = TOKEN_PATTERN.matcher(s); var result = new ArrayList(); while (m.find()) { String t = m.group(1); if (!t.isEmpty()) { result.add(t); } } return result; } public static Object readStr(String s) { return new Reader(tokenize(s)).readForm(); } private int i = 0; private final List tokens; private Reader(List tokens) { this.tokens = tokens; } private boolean hasNext() { return i < tokens.size(); } private String peek() { if (!hasNext()) { throw new MalException("EOF"); } return tokens.get(i); } private String next() { if (!hasNext()) { throw new MalException("EOF"); } return tokens.get(i++); } private Object readForm() { if (!hasNext()) { return MalNil.NIL; } String t = peek(); if (t.equals("'")) { next(); return MalList.EMPTY.cons(readForm()).cons(MalSymbol.QUOTE); } else if (t.equals("`")) { next(); return MalList.EMPTY.cons(readForm()).cons(MalSymbol.QUASIQUOTE); } else if (t.equals("@")) { next(); return MalList.EMPTY.cons(readForm()).cons(MalSymbol.DEREF); } else if (t.equals("~")) { next(); return MalList.EMPTY.cons(readForm()).cons(MalSymbol.UNQUOTE); } else if (t.equals("~@")) { next(); return MalList.EMPTY.cons(readForm()).cons(MalSymbol.SPLICE_UNQUOTE); } else if (t.equals("^")) { next(); var meta = readForm(); var obj = readForm(); return MalList.EMPTY.cons(meta).cons(obj).cons(MalSymbol.get("with-meta")); } else if (t.equals("(")) { return readList(); } else if (t.equals("[")) { return readVector(); } else if (t.equals("{")) { return readMap(); } else if (t.startsWith(";")) { // gobble up consecutive comments without consuming stack space while (t.startsWith(";")) { next(); if (!hasNext()) break; t = peek(); } return readForm(); } else { return readAtom(); } } private MalVector readVector() { var elements = new ArrayList(); next(); // consume '[' while (!peek().equals("]")) { elements.add(readForm()); } next(); // consume ']' return MalVector.EMPTY.concat(elements); } private MalList readList() { var elements = new ArrayList(); next(); // consume '(' while (!peek().equals(")")) { elements.add(readForm()); } next(); // consume ')' MalList result = MalList.EMPTY; var iter = elements.listIterator(elements.size()); while (iter.hasPrevious()) { result = result.cons(iter.previous()); } return result; } private MalMap readMap() { MalMap map = MalMap.EMPTY; next(); // consume '{' while (!peek().equals("}")) { map = map.assoc(readForm(), readForm()); } next(); // consume '}' return map; } private Object readAtom() { String t = next(); if (t.charAt(0) == '"') { StringBuilder sb = new StringBuilder(); int i=1; for (int j=t.indexOf('\\', i); j != -1; j=t.indexOf('\\', i)) { sb.append(t.subSequence(i, j)); switch (t.charAt(j+1)) { case 'n': sb.append('\n'); break; case '"': sb.append('"'); break; case '\\': sb.append('\\'); break; } i = j+2; } if (i > t.length()-1 || t.charAt(t.length()-1) != '"') { throw new MalException("EOF"); } sb.append(t.substring(i, t.length()-1)); return sb.toString(); } else if (t.charAt(0) == ':') { return MalKeyword.get(t.substring(1)); } else if (t.charAt(0) >= '0' && t.charAt(0) <= '9') { return Long.parseLong(t); } else if (t.length() > 1 && t.charAt(0) == '-' && t.charAt(1) >= '0' && t.charAt(1) <= '9') { return Long.parseLong(t); } else if (t.equals("true")) { return true; } else if (t.equals("false")) { return false; } else if (t.equals("nil")) { return MalNil.NIL; } else { return MalSymbol.get(t); } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/Types.java ================================================ package truffle.mal; import java.util.Iterator; import java.util.Stack; import org.organicdesign.fp.collections.PersistentHashMap; import org.organicdesign.fp.collections.PersistentVector; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.TruffleException; import com.oracle.truffle.api.interop.InteropLibrary; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.library.ExportLibrary; import com.oracle.truffle.api.library.ExportMessage; import com.oracle.truffle.api.nodes.Node; public class Types { } interface MetaHolder { Object getMeta(); T withMeta(Object meta); } @SuppressWarnings("serial") class MalException extends RuntimeException implements TruffleException { final Object obj; MalException(String message) { super(message); this.obj = message; } MalException(Object obj) { super(Printer.prStr(obj, true)); this.obj = obj; } @Override public Throwable fillInStackTrace() { return this; } @Override public Node getLocation() { return null; } } abstract class MalValue { @Override @TruffleBoundary public String toString() { return Printer.prStr(this, true); } } @ExportLibrary(InteropLibrary.class) class MalNil extends MalValue implements TruffleObject { public static final MalNil NIL = new MalNil(); private MalNil() {} @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } } @ExportLibrary(InteropLibrary.class) class MalList extends MalValue implements TruffleObject, Iterable, MetaHolder { public static final MalList EMPTY = new MalList(); @TruffleBoundary public static MalList from(Iterable list) { var result = EMPTY; var stack = new Stack(); list.forEach(stack::add); while (!stack.isEmpty()) { result = result.cons(stack.pop()); } return result; } private static int computeHash(Object head, MalList tail) { final int prime = 31; int result = 1; result = prime * result + head.hashCode(); result = prime * result + tail.hashCode(); return result; } public final Object head; public final MalList tail; private final int hash; // The lazy programmer's way of ensuring constant-time size() calls: waste lots of memory! public final int length; public final Object meta; @TruffleBoundary private MalList() { this.head = null; this.tail = null; this.hash = 31; this.length = 0; this.meta = MalNil.NIL; } @TruffleBoundary private MalList(MalList list, Object meta) { this.head = list.head; this.tail = list.tail; this.hash = list.hash; this.length = list.length; this.meta = meta; } @TruffleBoundary private MalList(Object head, MalList tail, Object meta) { this.head = head; this.tail = tail; this.hash = computeHash(head, tail); this.length = tail.length+1; this.meta = meta; } public boolean isEmpty() { return head == null; } @TruffleBoundary public MalList cons(Object val) { return new MalList(val, this, this.meta); } @Override public int hashCode() { return hash; } @Override @TruffleBoundary public boolean equals(Object obj) { if (this == obj) return true; if (obj == null) return false; if (obj instanceof MalVector) { MalVector other = (MalVector)obj; if (this.length != other.size()) return false; int i=0; MalList list = this; while (!list.isEmpty()) { if (!list.head.equals(other.get(i))) { return false; } i++; list = list.tail; } return true; } if (this.getClass() != obj.getClass()) return false; MalList other = (MalList) obj; if (head == null) { if (other.head != null) return false; } else if (!head.equals(other.head)) return false; if (tail == null) { if (other.tail != null) return false; } else if (!tail.equals(other.tail)) return false; return true; } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } @Override public Iterator iterator() { return new MalListIterator(this); } private static class MalListIterator implements Iterator { private MalList list; MalListIterator(MalList list) { this.list = list; } @Override public boolean hasNext() { return !list.equals(MalList.EMPTY); } @Override public Object next() { Object obj = list.head; list = list.tail; return obj; } } @Override public Object getMeta() { return meta; } @Override public MalList withMeta(Object meta) { return new MalList(this, meta); } } @ExportLibrary(InteropLibrary.class) class MalVector extends MalValue implements TruffleObject, Iterable, MetaHolder { public static final MalVector EMPTY = new MalVector(); private final PersistentVector vector; private final Object meta; private MalVector() { vector = PersistentVector.empty(); meta = MalNil.NIL; } private MalVector(PersistentVector vector, Object meta) { this.vector = vector; this.meta = meta; } @TruffleBoundary public MalVector append(Object obj) { return new MalVector(vector.append(obj), this.meta); } @TruffleBoundary public MalVector concat(Object[] objs) { var v = vector.mutable(); for (int i=0; i < objs.length; ++i) { v.append(objs[i]); } return new MalVector(v.immutable(), meta); } @TruffleBoundary public MalVector concat(Iterable objs) { return new MalVector(vector.concat(objs), meta); } public int size() { return vector.size(); } public Object get(int i) { return vector.get(i); } @Override public int hashCode() { return vector.hashCode(); } @Override @TruffleBoundary public boolean equals(Object obj) { if (this == obj) return true; if (obj == null) return false; if (obj instanceof MalList) return obj.equals(this); if (getClass() != obj.getClass()) return false; MalVector other = (MalVector) obj; return vector.equals(other.vector); } @Override public Iterator iterator() { return vector.iterator(); } @TruffleBoundary public MalList toList() { MalList result = MalList.EMPTY; for (int i=vector.size()-1; i >= 0; i--) { result = result.cons(vector.get(i)); } return result; } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } @Override public Object getMeta() { return meta; } @Override public MalVector withMeta(Object meta) { return new MalVector(this.vector, meta); } } @ExportLibrary(InteropLibrary.class) class MalMap extends MalValue implements TruffleObject, MetaHolder { public static final MalMap EMPTY = new MalMap(); public final PersistentHashMap map; private final Object meta; private MalMap() { map = PersistentHashMap.EMPTY; meta = MalNil.NIL; } private MalMap(PersistentHashMap map, Object meta) { this.map = map; this.meta = meta; } @TruffleBoundary public MalMap assoc(Object key, Object val) { return new MalMap(map.assoc(key, val), meta); } @TruffleBoundary public MalMap dissoc(Object key) { return new MalMap(map.without(key), meta); } @TruffleBoundary public Object get(Object key) { if (map.containsKey(key)) { return map.get(key); } else { return MalNil.NIL; } } @TruffleBoundary @Override public int hashCode() { return map.hashCode(); } @TruffleBoundary @Override public boolean equals(Object obj) { if (this == obj) return true; if (obj == null) return false; if (getClass() != obj.getClass()) return false; MalMap other = (MalMap) obj; return map.equals(other.map); } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } @Override public Object getMeta() { return meta; } @Override public MalMap withMeta(Object meta) { return new MalMap(map, meta); } } @ExportLibrary(InteropLibrary.class) class MalKeyword extends MalValue implements TruffleObject { public static final MalKeyword INLINE_Q = MalKeyword.get("inline?"); public final String keyword; public static MalKeyword get(String keyword) { return new MalKeyword(keyword); } private MalKeyword(String keyword) { this.keyword = keyword; } @Override public int hashCode() { return keyword.hashCode(); } @Override public boolean equals(Object obj) { if (obj == null) { return false; } if (!(obj instanceof MalKeyword)) { return false; } return keyword.equals(((MalKeyword)obj).keyword); } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } } @ExportLibrary(InteropLibrary.class) class MalSymbol extends MalValue implements TruffleObject { public static MalSymbol get(String symbol) { return new MalSymbol(symbol); } public static final MalSymbol LET_STAR = MalSymbol.get("let*"); public static final MalSymbol DEF_BANG = MalSymbol.get("def!"); public static final MalSymbol DO = MalSymbol.get("do"); public static final MalSymbol IF = MalSymbol.get("if"); public static final MalSymbol FN_STAR = MalSymbol.get("fn*"); public static final MalSymbol AMPERSAND = MalSymbol.get("&"); public static final MalSymbol QUOTE = MalSymbol.get("quote"); public static final MalSymbol QUASIQUOTE = MalSymbol.get("quasiquote"); public static final MalSymbol UNQUOTE = MalSymbol.get("unquote"); public static final MalSymbol SPLICE_UNQUOTE = MalSymbol.get("splice-unquote"); public static final MalSymbol DEFMACRO = MalSymbol.get("defmacro!"); public static final MalSymbol MACROEXPAND = MalSymbol.get("macroexpand"); public static final MalSymbol DEREF = MalSymbol.get("deref"); public static final MalSymbol TRY = MalSymbol.get("try*"); public static final MalSymbol CATCH = MalSymbol.get("catch*"); public final String symbol; private MalSymbol(String symbol) { this.symbol = symbol; } @Override public int hashCode() { return symbol.hashCode(); } @Override public boolean equals(Object obj) { if (this == obj) return true; if (obj == null) return false; if (getClass() != obj.getClass()) return false; MalSymbol other = (MalSymbol) obj; if (symbol == null) { if (other.symbol != null) return false; } else if (!symbol.equals(other.symbol)) return false; return true; } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } } @ExportLibrary(InteropLibrary.class) class MalFunction extends MalValue implements TruffleObject, MetaHolder { final RootCallTarget callTarget; final MalEnv closedOverEnv; final int numArgs; final boolean isMacro; final Object meta; final boolean canBeTailCalled; MalFunction(RootCallTarget callTarget, MalEnv closedOverEnv, int numArgs, boolean canBeTailCalled) { this.callTarget = callTarget; this.closedOverEnv = closedOverEnv; this.numArgs = numArgs; this.isMacro = false; this.meta = MalNil.NIL; this.canBeTailCalled = canBeTailCalled; } MalFunction(RootCallTarget callTarget, MalEnv closedOverEnv, int numArgs) { this(callTarget, closedOverEnv, numArgs, true); } MalFunction(MalFunction f, boolean isMacro) { this(f, f.meta, isMacro, true); } MalFunction(MalFunction f, Object meta, boolean isMacro) { this(f, meta, isMacro, true); } MalFunction(MalFunction f, Object meta, boolean isMacro, boolean canBeTailCalled) { this.callTarget = f.callTarget; this.closedOverEnv = f.closedOverEnv; this.numArgs = f.numArgs; this.isMacro = isMacro; this.meta = meta; this.canBeTailCalled = canBeTailCalled; } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } @Override public Object getMeta() { return meta; } @Override public MalFunction withMeta(Object meta) { return new MalFunction(this, meta, this.isMacro); } } @ExportLibrary(InteropLibrary.class) class MalAtom extends MalValue implements TruffleObject { private Object value; public MalAtom(Object initialValue) { this.value = initialValue; } public Object deref() { return value; } public Object reset(Object newValue) { this.value = newValue; return newValue; } @ExportMessage Object toDisplayString(boolean allowSideEffects) { return this.toString(); } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step0_repl.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; public class step0_repl { private static String READ(String s) { return s; } private static void PRINT(String s) { System.out.println(s); } private static void rep(String s) { PRINT(READ(s)); } public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { rep(s); } } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step1_read_print.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; public class step1_read_print { public static void main(String[] args) throws IOException { boolean done = false; var reader = new BufferedReader(new InputStreamReader(System.in)); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { System.out.println(Printer.prStr(Reader.readStr(s), true)); } catch (MalException ex) { System.out.println(ex.getMessage()); } } } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step2_eval.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.util.HashMap; import java.util.Map; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step2_eval { static final String LANGUAGE_ID = "mal_step2"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); System.out.println(val.toString()); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static Map replEnv = new HashMap<>(); static { replEnv.put(MalSymbol.get("+"), new BuiltinFn(args -> { return (long)args[0]+(long)args[1]; })); replEnv.put(MalSymbol.get("-"), new BuiltinFn(args -> { return (long)args[0]-(long)args[1]; })); replEnv.put(MalSymbol.get("*"), new BuiltinFn(args -> { return (long)args[0]*(long)args[1]; })); replEnv.put(MalSymbol.get("/"), new BuiltinFn(args -> { return (long)args[0]/(long)args[1]; })); }; static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame); public long executeLong(VirtualFrame frame) throws UnexpectedResultException { var value = executeGeneric(frame); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame) throws UnexpectedResultException { var value = executeGeneric(frame); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static MalNode formToNode(Object form) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode((MalVector)form); } else if (form instanceof MalMap) { return new MapNode((MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { return new ApplyNode((MalList)form); } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(vector.get(i)); } } @Override public Object executeGeneric(VirtualFrame frame) { var elements = new Object[elementNodes.length]; for (int i=0; i < elementNodes.length; i++) { elements[i] = elementNodes[i].executeGeneric(frame); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(entry.getKey()); nodes[i++] = formToNode(entry.getValue()); } } @Override public Object executeGeneric(VirtualFrame frame) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame), nodes[i+1].executeGeneric(frame)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @TruffleBoundary private Object lookup() { var result = replEnv.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } @Override public Object executeGeneric(VirtualFrame frame) { return lookup(); } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; ApplyNode(MalList list) { super(list); fnNode = formToNode(list.head); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(list.head); list = list.tail; } } @Override public Object executeGeneric(VirtualFrame frame) { var fn = (BuiltinFn)fnNode.executeGeneric(frame); var args = new Object[argNodes.length]; for (int i=0; i < args.length; i++) { args[i] = argNodes[i].executeGeneric(frame); } return fn.fn.apply(args); } } static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(TruffleLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; this.body = formToNode(form); } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame); } } public final static class MalContext { } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); var root = new MalRootNode(this, Reader.readStr(s)); return Truffle.getRuntime().createCallTarget(root); } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step3_env.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.util.ArrayList; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step3_env { static final String LANGUAGE_ID = "mal_step3"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); System.out.println(val.toString()); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static MalNode formToNode(Object form) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode((MalVector)form); } else if (form instanceof MalMap) { return new MapNode((MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head)) { return new DefNode(list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(list); } else { return new ApplyNode(list); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(vector.get(i)); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(entry.getKey()); nodes[i++] = formToNode(entry.getValue()); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; ApplyNode(MalList list) { super(list); fnNode = formToNode(list.head); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(list.head); list = list.tail; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (BuiltinFn)fnNode.executeGeneric(frame, env); var args = new Object[argNodes.length]; for (int i=0; i < args.length; i++) { args[i] = argNodes[i].executeGeneric(frame, env); } return fn.fn.apply(args); } } static class DefNode extends MalNode { private final MalSymbol symbol; @Child private MalNode valueNode; DefNode(MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.valueNode = formToNode(list.tail.tail.head); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(valueForm); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalList form) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode((MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(form.tail.tail.head); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(TruffleLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; this.body = formToNode(form); } @Override public Object execute(VirtualFrame frame) { var ctx = lookupContextReference(MalLanguage.class).get(); return body.executeGeneric(frame, ctx.globalEnv); } } final static class MalContext { final MalEnv globalEnv = new MalEnv(MalLanguage.class); } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage { @Override protected MalContext createContext(Env env) { var ctx = new MalContext(); ctx.globalEnv.set(MalSymbol.get("+"), new BuiltinFn(args -> { return (long)args[0]+(long)args[1]; })); ctx.globalEnv.set(MalSymbol.get("-"), new BuiltinFn(args -> { return (long)args[0]-(long)args[1]; })); ctx.globalEnv.set(MalSymbol.get("*"), new BuiltinFn(args -> { return (long)args[0]*(long)args[1]; })); ctx.globalEnv.set(MalSymbol.get("/"), new BuiltinFn(args -> { return (long)args[0]/(long)args[1]; })); return ctx; } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); var root = new MalRootNode(this, Reader.readStr(s)); return Truffle.getRuntime().createCallTarget(root); } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step4_if_fn_do.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step4_if_fn_do { static final String LANGUAGE_ID = "mal_step4"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static MalNode formToNode(MalLanguage language, Object form) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else { return new ApplyNode(language, list); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i)); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey()); nodes[i++] = formToNode(language, entry.getValue()); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } static class InvokeNode extends AbstractInvokeNode { @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode() { } Object invoke(CallTarget target, Object[] args) { return callNode.call(target, args); } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); ApplyNode(MalLanguage language, MalList list) { super(list); fnNode = formToNode(language, list.head); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head); list = list.tail; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return callNode.call(fn.callTarget, args); } } static class DefNode extends MalNode { private final MalSymbol symbol; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.valueNode = formToNode(language, list.tail.tail.head); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(MalLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; this.body = formToNode(language, form); } @Override public Object execute(VirtualFrame frame) { var ctx = lookupContextReference(MalLanguage.class).get(); return body.executeGeneric(frame, ctx.globalEnv); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form) { super(form); conditionNode = formToNode(language, form.tail.head); trueNode = formToNode(language, form.tail.tail.head); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var root = new MalRootNode(this, form); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step5_tco.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step5_tco { static final String LANGUAGE_ID = "mal_step5"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { if (tailPosition) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } static class DefNode extends MalNode { private final MalSymbol symbol; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a top-level evaluated form. */ static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(MalLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, false); } @Override public Object execute(VirtualFrame frame) { var ctx = lookupContextReference(MalLanguage.class).get(); return body.executeGeneric(frame, ctx.globalEnv); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var root = new MalRootNode(this, form); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step6_file.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step6_file { static final String LANGUAGE_ID = "mal_step6"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { if (tailPosition) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } static class DefNode extends MalNode { private final MalSymbol symbol; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a top-level evaluated form. */ static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(MalLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, false); } @Override public Object execute(VirtualFrame frame) { var ctx = lookupContextReference(MalLanguage.class).get(); return body.executeGeneric(frame, ctx.globalEnv); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var root = new MalRootNode(this, form); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step7_quote.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step7_quote { static final String LANGUAGE_ID = "mal_step7"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { if (tailPosition) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } static class ApplyNode extends MalNode { @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } static class DefNode extends MalNode { private final MalSymbol symbol; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a top-level evaluated form. */ static class MalRootNode extends RootNode { final Object form; @Child MalNode body; MalRootNode(MalLanguage language, Object form) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, false); } @Override public Object execute(VirtualFrame frame) { var ctx = lookupContextReference(MalLanguage.class).get(); return body.executeGeneric(frame, ctx.globalEnv); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var root = new MalRootNode(this, form); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step8_macros.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step8_macros { static final String LANGUAGE_ID = "mal_step8"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException(symbol+" not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); this.language = language; fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var env = getCurrentContext(MalLanguage.class).globalEnv; var root = new MalRootNode(this, form, env, false); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/step9_try.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class step9_try { static final String LANGUAGE_ID = "mal_step9"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException("'"+symbol+"' not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); this.language = language; fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-2); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final MalSymbol exSymbol; TryNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { exSymbol = (MalSymbol)catchForm.tail.head; catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); } else { exSymbol = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env); catchEnv.set(exSymbol, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var env = getCurrentContext(MalLanguage.class).globalEnv; var root = new MalRootNode(this, form, env, false); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/stepA_mal.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class stepA_mal { static final String LANGUAGE_ID = "mal_stepA"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } @TruffleBoundary private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException("'"+symbol+"' not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @Child private IndirectCallNode callNode = Truffle.getRuntime().createIndirectCallNode(); InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { while (true) { try { return callNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); this.language = language; fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } @Override public String toString() { return form.toString(); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final MalSymbol exSymbol; TryNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { exSymbol = (MalSymbol)catchForm.tail.head; catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); } else { exSymbol = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env); catchEnv.set(exSymbol, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var env = getCurrentContext(MalLanguage.class).globalEnv; var root = new MalRootNode(this, form, env, false); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/stepB_calls.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.DirectCallNode; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; public class stepB_calls { static final String LANGUAGE_ID = "mal_stepB"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } @TruffleBoundary private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition); } else { return new ApplyNode(language, list, tailPosition); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false); nodes[i++] = formToNode(language, entry.getValue(), false); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { result = result.assoc(nodes[i].executeGeneric(frame, env), nodes[i+1].executeGeneric(frame, env)); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; LookupNode(MalSymbol symbol) { super(symbol); this.symbol = symbol; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = env.get(symbol); if (result == null) { throw new MalException("'"+symbol+"' not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; @TruffleBoundary TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedTarget; @CompilationFinal private CallTarget cachedTarget; @CompilationFinal @Child private DirectCallNode directCallNode; @CompilationFinal @Child private IndirectCallNode indirectCallNode; InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; usingCachedTarget = true; cachedTarget = target; directCallNode = Truffle.getRuntime().createDirectCallNode(target); } while (true) { try { if (usingCachedTarget) { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedTarget = false; indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); } return indirectCallNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedFn; @CompilationFinal private MalFunction cachedFn; ApplyNode(MalLanguage language, MalList list, boolean tailPosition) { super(list); this.language = language; fnNode = formToNode(language, list.head, false); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; cachedFn = fn; usingCachedFn = true; } if (usingCachedFn) { if (fn != cachedFn) { CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedFn = false; } else { fn = cachedFn; } } if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; @Child private MalNode valueNode; DefNode(MalLanguage language, MalList list) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.valueNode = formToNode(language, list.tail.tail.head, false); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } env.set(symbol, value); return value; } } static class LetBindingNode extends Node { private final MalSymbol symbol; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm) { this.symbol = symbol; this.valueNode = formToNode(language, valueForm, false); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(symbol, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1)); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); conditionNode = formToNode(language, form.tail.head, false); trueNode = formToNode(language, form.tail.tail.head, tailPosition); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || val == Boolean.FALSE) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final MalSymbol symbol; protected final int argPos; protected AbstractBindArgNode(MalSymbol symbol, int argPos) { this.symbol = symbol; this.argPos = argPos; } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos) { super(symbol, argPos); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(symbol, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1); } } this.bodyNode = formToNode(language, form.tail.tail.head, true); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0]); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } @Override public String toString() { return form.toString(); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form) { super(form); fnRoot = new FnRootNode(language, form); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final MalSymbol exSymbol; TryNode(MalLanguage language, MalList form, boolean tailPosition) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { exSymbol = (MalSymbol)catchForm.tail.head; catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition); } else { exSymbol = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env); catchEnv.set(exSymbol, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var env = getCurrentContext(MalLanguage.class).globalEnv; var root = new MalRootNode(this, form, env, false); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/stepC_slots.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.DirectCallNode; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; import truffle.mal.LexicalScope.EnvSlot; public class stepC_slots { static final String LANGUAGE_ID = "mal_stepC"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } @TruffleBoundary private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form, scope); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form, scope); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form, scope); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list, scope); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition, scope); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition, scope); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition, scope); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list, scope); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition, scope); } else { return new ApplyNode(language, list, tailPosition, scope); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false, scope); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map, LexicalScope scope) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false, scope); nodes[i++] = formToNode(language, entry.getValue(), false, scope); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { var k = nodes[i].executeGeneric(frame, env); var v = nodes[i+1].executeGeneric(frame, env); result = result.assoc(k, v); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; private final LexicalScope scope; @CompilationFinal boolean initialized = false; @CompilationFinal EnvSlot slot; LookupNode(MalSymbol symbol, LexicalScope scope) { super(symbol); this.symbol = symbol; this.scope = scope; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; slot = scope.getSlot(env, symbol); } Object result = null; if (slot != null) { if (slot.notDynamicallyBound.isValid()) { result = env.get(slot); } else { result = env.get(symbol, slot); } } else { result = env.get(symbol); } if (result == null) { throw new MalException("'"+symbol.symbol+"' not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedTarget; @CompilationFinal private CallTarget cachedTarget; @CompilationFinal @Child private DirectCallNode directCallNode; @CompilationFinal @Child private IndirectCallNode indirectCallNode; InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; usingCachedTarget = true; cachedTarget = target; directCallNode = Truffle.getRuntime().createDirectCallNode(target); } while (true) { try { if (usingCachedTarget) { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedTarget = false; indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); } return indirectCallNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; final LexicalScope scope; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedFn; @CompilationFinal private MalFunction cachedFn; ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { super(list); this.language = language; this.scope = scope; fnNode = formToNode(language, list.head, false, scope); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false, scope); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition, scope); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; cachedFn = fn; usingCachedFn = true; } if (usingCachedFn) { if (fn != cachedFn) { CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedFn = false; } else { fn = cachedFn; } } if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; private final LexicalScope scope; @Child private MalNode valueNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private EnvSlot slot; DefNode(MalLanguage language, MalList list, LexicalScope scope) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.scope = scope; this.valueNode = formToNode(language, list.tail.tail.head, false, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; var slot = scope.getSlot(env, symbol); if (slot != null && slot.height == 0) { this.slot = slot; } } if (slot != null) { env.set(slot, value); } else { env.set(symbol, value); } return value; } } static class LetBindingNode extends Node { private final EnvSlot slot; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { this.slot = scope.allocateSlot(symbol); this.valueNode = formToNode(language, valueForm, false, scope); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(slot, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { private final LexicalScope scope; @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; scope = new LexicalScope(outerScope); for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv, scope); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition, scope); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); conditionNode = formToNode(language, form.tail.head, false, scope); trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final int argPos; protected final EnvSlot slot; protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { this.argPos = argPos; this.slot = scope.allocateSlot(symbol); } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(slot, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(slot, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; final LexicalScope scope; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; this.scope = new LexicalScope(outerScope); for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); } } this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } @Override public String toString() { return form.toString(); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form, LexicalScope scope) { super(form); fnRoot = new FnRootNode(language, form, scope); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final EnvSlot exSlot; final LexicalScope catchScope; TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false, scope); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { catchScope = new LexicalScope(scope); var exSymbol = (MalSymbol)catchForm.tail.head; exSlot = catchScope.allocateSlot(exSymbol); catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); } else { catchScope = null; exSlot = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env, catchScope); catchEnv.set(exSlot, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final LexicalScope globalScope; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); globalScope = new LexicalScope(); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var ctx = getCurrentContext(MalLanguage.class); var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/stepD_caching.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.Assumption; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.DirectCallNode; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; import truffle.mal.LexicalScope.EnvSlot; import truffle.mal.MalEnv.CachedResult; public class stepD_caching { static final String LANGUAGE_ID = "mal_stepD"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(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)))))))"); context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } @TruffleBoundary private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form, scope); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form, scope); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form, scope); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list, scope); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition, scope); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition, scope); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition, scope); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list, scope); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition, scope); } else { return new ApplyNode(language, list, tailPosition, scope); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false, scope); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new ArrayList<>(elementNodes.length); for (int i=0; i < elementNodes.length; i++) { elements.add(elementNodes[i].executeGeneric(frame, env)); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map, LexicalScope scope) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false, scope); nodes[i++] = formToNode(language, entry.getValue(), false, scope); } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { var k = nodes[i].executeGeneric(frame, env); var v = nodes[i+1].executeGeneric(frame, env); result = result.assoc(k, v); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; private final LexicalScope scope; @CompilationFinal boolean initialized = false; @CompilationFinal EnvSlot slot; @CompilationFinal CachedResult cachedResult; @CompilationFinal Assumption notRedefined; LookupNode(MalSymbol symbol, LexicalScope scope) { super(symbol); this.symbol = symbol; this.scope = scope; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; slot = scope.getSlot(env, symbol); if (slot == null) { cachedResult = env.cachedGet(symbol); notRedefined = cachedResult.notRedefined; } } Object result = null; if (slot != null) { if (slot.notDynamicallyBound.isValid()) { result = env.get(slot); } else { result = env.get(symbol, slot); } } else { if (notRedefined.isValid()) { result = cachedResult.result; } else { result = env.get(symbol); } } if (result == null) { throw new MalException("'"+symbol.symbol+"' not found"); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedTarget; @CompilationFinal private CallTarget cachedTarget; @CompilationFinal @Child private DirectCallNode directCallNode; @CompilationFinal @Child private IndirectCallNode indirectCallNode; InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; usingCachedTarget = true; cachedTarget = target; directCallNode = Truffle.getRuntime().createDirectCallNode(target); } while (true) { try { if (usingCachedTarget) { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedTarget = false; indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); } return indirectCallNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } static class ApplyNode extends MalNode { final MalLanguage language; final LexicalScope scope; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedFn; @CompilationFinal private MalFunction cachedFn; ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { super(list); this.language = language; this.scope = scope; fnNode = formToNode(language, list.head, false, scope); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false, scope); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private CallTarget applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); var newRoot = new MalRootNode(language, result, env, invokeNode.tailPosition, scope); return Truffle.getRuntime().createCallTarget(newRoot); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; cachedFn = fn; usingCachedFn = true; } if (usingCachedFn) { if (fn != cachedFn) { CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedFn = false; } else { fn = cachedFn; } } if (fn.isMacro) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = applyMacro(env, fn); return invokeNode.invoke(target, new Object[] {}, false); } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; private final LexicalScope scope; @Child private MalNode valueNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private EnvSlot slot; DefNode(MalLanguage language, MalList list, LexicalScope scope) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.scope = scope; this.valueNode = formToNode(language, list.tail.tail.head, false, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; var slot = scope.getSlot(env, symbol); if (slot != null && slot.height == 0) { this.slot = slot; } } if (slot != null) { env.set(slot, value); } else { env.set(symbol, value); } return value; } } static class LetBindingNode extends Node { private final EnvSlot slot; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { this.slot = scope.allocateSlot(symbol); this.valueNode = formToNode(language, valueForm, false, scope); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(slot, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { private final LexicalScope scope; @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; scope = new LexicalScope(outerScope); for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv, scope); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition, scope); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); conditionNode = formToNode(language, form.tail.head, false, scope); trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final int argPos; protected final EnvSlot slot; protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { this.argPos = argPos; this.slot = scope.allocateSlot(symbol); } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(slot, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } @TruffleBoundary private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(slot, buildVarArgsList(frame.getArguments())); } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; final LexicalScope scope; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; this.scope = new LexicalScope(outerScope); for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); } } this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } @Override public String toString() { return form.toString(); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form, LexicalScope scope) { super(form); fnRoot = new FnRootNode(language, form, scope); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final EnvSlot exSlot; final LexicalScope catchScope; TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false, scope); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { catchScope = new LexicalScope(scope); var exSymbol = (MalSymbol)catchForm.tail.head; exSlot = catchScope.allocateSlot(exSymbol); catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); } else { catchScope = null; exSlot = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env, catchScope); catchEnv.set(exSlot, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final LexicalScope globalScope; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); globalScope = new LexicalScope(); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var ctx = getCurrentContext(MalLanguage.class); var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/java-truffle/src/main/java/truffle/mal/stepE_macros.java ================================================ package truffle.mal; import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; import java.io.PrintStream; import java.util.ArrayList; import java.util.Collections; import java.util.function.Function; import org.graalvm.polyglot.Context; import org.graalvm.polyglot.PolyglotException; import org.graalvm.polyglot.Value; import com.oracle.truffle.api.Assumption; import com.oracle.truffle.api.CallTarget; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; import com.oracle.truffle.api.Scope; import com.oracle.truffle.api.Truffle; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.frame.FrameDescriptor; import com.oracle.truffle.api.frame.VirtualFrame; import com.oracle.truffle.api.interop.TruffleObject; import com.oracle.truffle.api.nodes.ControlFlowException; import com.oracle.truffle.api.nodes.DirectCallNode; import com.oracle.truffle.api.nodes.ExplodeLoop; import com.oracle.truffle.api.nodes.IndirectCallNode; import com.oracle.truffle.api.nodes.Node; import com.oracle.truffle.api.nodes.RootNode; import com.oracle.truffle.api.nodes.UnexpectedResultException; import com.oracle.truffle.api.source.Source; import truffle.mal.LexicalScope.EnvSlot; import truffle.mal.MalEnv.CachedResult; public class stepE_macros { static final String LANGUAGE_ID = "mal_stepE"; public static void main(String[] args) throws IOException { boolean done = false; BufferedReader reader = new BufferedReader(new InputStreamReader(System.in)); var context = Context.create(LANGUAGE_ID); context.eval(LANGUAGE_ID, "(def! not (fn* [a] (if a false true)))"); context.eval(LANGUAGE_ID, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); context.eval(LANGUAGE_ID, "(defmacro! cond ^{:inline? true} (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)))))))"); context.eval(LANGUAGE_ID, "(def! *host-language* \"java-truffle\")"); var buf = new StringBuilder(); buf.append("(def! *ARGV* (list"); for (int i=1; i < args.length; i++) { buf.append(' '); buf.append(Printer.prStr(args[i], true)); } buf.append("))"); context.eval(LANGUAGE_ID, buf.toString()); if (args.length > 0) { context.eval(LANGUAGE_ID, "(load-file \""+args[0]+"\")"); return; } while (!done) { System.out.print("user> "); String s = reader.readLine(); if (s == null) { done = true; } else { try { Value val = context.eval(LANGUAGE_ID, s); context.getBindings(LANGUAGE_ID).putMember("*1", val); context.eval(LANGUAGE_ID, "(prn *1)"); } catch (PolyglotException ex) { if (ex.isGuestException()) { System.out.println("Error: "+ex.getMessage()); } else { throw ex; } } } } } static class BuiltinFn implements TruffleObject { final Function fn; BuiltinFn(Function fn) { this.fn = fn; } } static abstract class MalNode extends Node { final Object form; protected MalNode(Object form) { this.form = form; } public abstract Object executeGeneric(VirtualFrame frame, MalEnv env); public long executeLong(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Long) { return (long)value; } throw new UnexpectedResultException(value); } public boolean executeBoolean(VirtualFrame frame, MalEnv env) throws UnexpectedResultException { var value = executeGeneric(frame, env); if (value instanceof Boolean) { return (boolean)value; } throw new UnexpectedResultException(value); } } private static boolean isPair(Object obj) { return (obj instanceof MalList && ((MalList)obj).length > 0) || (obj instanceof MalVector && ((MalVector)obj).size() > 0); } private static Object quasiquote(Object form) { if (!isPair(form)) { return MalList.EMPTY.cons(form).cons(MalSymbol.QUOTE); } MalList list = (form instanceof MalVector) ? ((MalVector)form).toList() : (MalList)form; if (MalSymbol.UNQUOTE.equals(list.head)) { return list.tail.head; } var result = new ArrayList(); if (isPair(list.head) && MalSymbol.SPLICE_UNQUOTE.equals(((MalList)list.head).head)) { result.add(MalSymbol.get("concat")); result.add(((MalList)list.head).tail.head); } else { result.add(MalSymbol.get("cons")); result.add(quasiquote(list.head)); } result.add(quasiquote(list.tail)); return MalList.from(result); } @TruffleBoundary private static MalNode formToNode(MalLanguage language, Object form, boolean tailPosition, LexicalScope scope) { if (form instanceof MalSymbol) { return new LookupNode((MalSymbol)form, scope); } else if (form instanceof MalVector) { return new VectorNode(language, (MalVector)form, scope); } else if (form instanceof MalMap) { return new MapNode(language, (MalMap)form, scope); } else if (form instanceof MalList && !((MalList)form).isEmpty()) { var list = (MalList)form; var head = list.head; if (MalSymbol.DEF_BANG.equals(head) || MalSymbol.DEFMACRO.equals(head)) { return new DefNode(language, list, scope); } else if (MalSymbol.LET_STAR.equals(head)) { return new LetNode(language, list, tailPosition, scope); } else if (MalSymbol.DO.equals(head)) { return new DoNode(language, list, tailPosition, scope); } else if (MalSymbol.IF.equals(head)) { return new IfNode(language, list, tailPosition, scope); } else if (MalSymbol.FN_STAR.equals(head)) { return new FnNode(language, list, scope); } else if (MalSymbol.QUOTE.equals(head)) { return new QuoteNode(language, list); } else if (MalSymbol.QUASIQUOTE.equals(head)) { return formToNode(language, quasiquote(list.tail.head), tailPosition, scope); } else if (MalSymbol.MACROEXPAND.equals(head)) { return new MacroexpandNode(list); } else if (MalSymbol.TRY.equals(head)) { return new TryNode(language, list, tailPosition, scope); } else { return new ApplyNode(language, list, tailPosition, scope); } } else { return new LiteralNode(form); } } static class LiteralNode extends MalNode { LiteralNode(Object form) { super(form); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return form; } } static class VectorNode extends MalNode { @Children private MalNode[] elementNodes; VectorNode(MalLanguage language, MalVector vector, LexicalScope scope) { super(vector); this.elementNodes = new MalNode[vector.size()]; for (int i=0; i < vector.size(); i++) { elementNodes[i] = formToNode(language, vector.get(i), false, scope); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var elements = new Object[elementNodes.length]; for (int i=0; i < elementNodes.length; i++) { elements[i] = elementNodes[i].executeGeneric(frame, env); } return MalVector.EMPTY.concat(elements); } } static class MapNode extends MalNode { @Children private MalNode[] nodes; MapNode(MalLanguage language, MalMap map, LexicalScope scope) { super(map); nodes = new MalNode[map.map.size()*2]; int i=0; for (var entry : map.map) { nodes[i++] = formToNode(language, entry.getKey(), false, scope); nodes[i++] = formToNode(language, entry.getValue(), false, scope); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var result = MalMap.EMPTY; for (int i=0; i < nodes.length; i += 2) { var k = nodes[i].executeGeneric(frame, env); var v = nodes[i+1].executeGeneric(frame, env); result = result.assoc(k, v); } return result; } } static class LookupNode extends MalNode { private final MalSymbol symbol; private final LexicalScope scope; @CompilationFinal boolean initialized = false; @CompilationFinal EnvSlot slot; @CompilationFinal CachedResult cachedResult; @CompilationFinal Assumption notRedefined; LookupNode(MalSymbol symbol, LexicalScope scope) { super(symbol); this.symbol = symbol; this.scope = scope; } @TruffleBoundary private void throwNotFound() { throw new MalException("'"+symbol.symbol+"' not found"); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; slot = scope.getSlot(env, symbol); if (slot == null) { cachedResult = env.cachedGet(symbol); notRedefined = cachedResult.notRedefined; } } Object result = null; if (slot != null) { if (slot.notDynamicallyBound.isValid()) { result = env.get(slot); } else { result = env.get(symbol, slot); } } else { if (notRedefined.isValid()) { result = cachedResult.result; } else { result = env.get(symbol); } } if (result == null) { throwNotFound(); } return result; } } @SuppressWarnings("serial") static class TailCallException extends ControlFlowException { final CallTarget callTarget; final Object[] args; TailCallException(CallTarget target, Object[] args) { this.callTarget = target; this.args = args; } } static class InvokeNode extends AbstractInvokeNode { final boolean tailPosition; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedTarget; @CompilationFinal private CallTarget cachedTarget; @CompilationFinal @Child private DirectCallNode directCallNode; @CompilationFinal @Child private IndirectCallNode indirectCallNode; InvokeNode(boolean tailPosition) { this.tailPosition = tailPosition; } Object invoke(CallTarget target, Object[] args) { return invoke(target, args, true); } Object invoke(CallTarget target, Object[] args, boolean allowTailCall) { if (tailPosition && allowTailCall) { throw new TailCallException(target, args); } else { if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; usingCachedTarget = true; cachedTarget = target; directCallNode = Truffle.getRuntime().createDirectCallNode(target); } while (true) { try { if (usingCachedTarget) { if (cachedTarget == target) { return directCallNode.call(args); } CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedTarget = false; indirectCallNode = Truffle.getRuntime().createIndirectCallNode(); } return indirectCallNode.call(target, args); } catch (TailCallException ex) { target = ex.callTarget; args = ex.args; } } } } } private static MalFunction getMacroFn(MalEnv env, Object form) { if (!(form instanceof MalList)) return null; MalList list = (MalList)form; if (!(list.head instanceof MalSymbol)) return null; MalSymbol fnSym = (MalSymbol)list.head; var obj = env.get(fnSym); if (obj == null) return null; if (!(obj instanceof MalFunction)) return null; MalFunction fn = (MalFunction)obj; return fn.isMacro ? fn : null; } static Object macroexpand(InvokeNode invokeNode, MalEnv env, Object form) { var fn = getMacroFn(env, form); while (fn != null) { MalList list = (MalList)form; var args = new Object[(int)list.length]; args[0] = fn.closedOverEnv; int i=1; list = list.tail; while (!list.isEmpty()) { args[i++] = list.head; list = list.tail; } form = invokeNode.invoke(fn.callTarget, args, false); fn = getMacroFn(env, form); } return form; } static class MacroexpandNode extends MalNode { @Child private InvokeNode invokeNode = new InvokeNode(false); private final Object body; MacroexpandNode(MalList form) { super(form); this.body = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return macroexpand(invokeNode, env, body); } } private static boolean isInlinableMacro(MalFunction fn) { var meta = fn.getMeta(); if (meta == null || !(meta instanceof MalMap)) return false; var inline = ((MalMap)meta).get(MalKeyword.INLINE_Q); return Boolean.TRUE.equals(inline); } static class InlinedMacroNode extends MalNode { @Child private DirectCallNode node; InlinedMacroNode(Object form, CallTarget target) { super(form); node = Truffle.getRuntime().createDirectCallNode(target); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return node.call(); } } static class ApplyNode extends MalNode { final MalLanguage language; final LexicalScope scope; @Child private MalNode fnNode; @Children private MalNode[] argNodes; @Child private InvokeNode invokeNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private boolean usingCachedFn; @CompilationFinal private MalFunction cachedFn; ApplyNode(MalLanguage language, MalList list, boolean tailPosition, LexicalScope scope) { super(list); this.language = language; this.scope = scope; fnNode = formToNode(language, list.head, false, scope); argNodes = new MalNode[list.length-1]; int i=0; list = list.tail; while (!list.isEmpty()) { argNodes[i++] = formToNode(language, list.head, false, scope); list = list.tail; } invokeNode = new InvokeNode(tailPosition); } @TruffleBoundary private MalRootNode applyMacro(MalEnv env, MalFunction fn) { Object[] args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; ++i) { args[i+1] = argNodes[i].form; } // We should never throw a tail call during expansion! Object form = invokeNode.invoke(fn.callTarget, args, false); var result = macroexpand(invokeNode, env, form); return new MalRootNode(language, result, env, invokeNode.tailPosition, scope); } @TruffleBoundary private Object invokeMacro(MalRootNode macroNode) { // Mal's macro semantics are... interesting. To preserve them in the // general case, we must re-expand a macro each time it's applied. // Executing the result means turning it into a Truffle AST, creating // a CallTarget, calling it, and then throwing it away. // This is TERRIBLE for performance! Truffle should not be used like this! var target = Truffle.getRuntime().createCallTarget(macroNode); return invokeNode.invoke(target, new Object[] {}, false); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var fn = (MalFunction)fnNode.executeGeneric(frame, env); if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; cachedFn = fn; usingCachedFn = true; } if (usingCachedFn) { if (fn != cachedFn) { CompilerDirectives.transferToInterpreterAndInvalidate(); usingCachedFn = false; } else { fn = cachedFn; } } if (fn.isMacro) { var expanded = applyMacro(env, fn); if (isInlinableMacro(fn)) { CompilerDirectives.transferToInterpreterAndInvalidate(); var newNode = expanded.body; this.replace(newNode); return newNode.executeGeneric(frame, env); } else { return invokeMacro(expanded); } } else { var args = new Object[argNodes.length+1]; args[0] = fn.closedOverEnv; for (int i=0; i < argNodes.length; i++) { args[i+1] = argNodes[i].executeGeneric(frame, env); } return invokeNode.invoke(fn.callTarget, args, fn.canBeTailCalled); } } } static class DefNode extends MalNode { private final MalSymbol symbol; private final boolean macro; private final LexicalScope scope; @Child private MalNode valueNode; @CompilationFinal private boolean initialized = false; @CompilationFinal private EnvSlot slot; DefNode(MalLanguage language, MalList list, LexicalScope scope) { super(list); this.symbol = (MalSymbol)list.tail.head; this.macro = MalSymbol.DEFMACRO.equals(list.head); this.scope = scope; this.valueNode = formToNode(language, list.tail.tail.head, false, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var value = valueNode.executeGeneric(frame, env); if (macro) { value = new MalFunction((MalFunction)value, true); } if (!initialized) { CompilerDirectives.transferToInterpreterAndInvalidate(); initialized = true; var slot = scope.getSlot(env, symbol); if (slot != null && slot.height == 0) { this.slot = slot; } } if (slot != null) { env.set(slot, value); } else { env.set(symbol, value); } return value; } } static class LetBindingNode extends Node { private final EnvSlot slot; @Child private MalNode valueNode; LetBindingNode(MalLanguage language, MalSymbol symbol, Object valueForm, LexicalScope scope) { this.slot = scope.allocateSlot(symbol); this.valueNode = formToNode(language, valueForm, false, scope); } public void executeGeneric(VirtualFrame frame, MalEnv env) { env.set(slot, valueNode.executeGeneric(frame, env)); } } static class LetNode extends MalNode { private final LexicalScope scope; @Children private LetBindingNode[] bindings; @Child private MalNode bodyNode; LetNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope outerScope) { super(form); var bindingForms = new ArrayList(); assert form.tail.head instanceof Iterable; ((Iterable)form.tail.head).forEach(bindingForms::add); bindings = new LetBindingNode[bindingForms.size()/2]; scope = new LexicalScope(outerScope); for (int i=0; i < bindingForms.size(); i+=2) { bindings[i/2] = new LetBindingNode(language, (MalSymbol)bindingForms.get(i), bindingForms.get(i+1), scope); } bodyNode = formToNode(language, form.tail.tail.head, tailPosition, scope); } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv outerEnv) { var innerEnv = new MalEnv(outerEnv, scope); for (int i=0; i < bindings.length; i++) { bindings[i].executeGeneric(frame, innerEnv); } return bodyNode.executeGeneric(frame, innerEnv); } } /** * Represents a form to be evaluated, together with an environment. */ static class MalRootNode extends RootNode { final Object form; final MalEnv env; @Child MalNode body; MalRootNode(MalLanguage language, Object form, MalEnv env, boolean tailPosition, LexicalScope scope) { super(language, new FrameDescriptor()); this.form = form; // There's no stack to unwind at the top level, so // a top-level form is never in tail position. this.body = formToNode(language, form, tailPosition, scope); this.env = env; } @Override public Object execute(VirtualFrame frame) { return body.executeGeneric(frame, env); } @Override public String toString() { return Printer.prStr(form, true); } } static class DoNode extends MalNode { @Children private MalNode[] bodyNodes; DoNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); bodyNodes = new MalNode[form.length-1]; int i = 0; for (var f : form.tail) { bodyNodes[i++] = formToNode(language, f, tailPosition && i == form.length-1, scope); } } @ExplodeLoop @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { if (bodyNodes.length == 0) { return MalNil.NIL; } for (int i=0; i < bodyNodes.length-1; i++) { bodyNodes[i].executeGeneric(frame, env); } return bodyNodes[bodyNodes.length-1].executeGeneric(frame, env); } } static class IfNode extends MalNode { @Child private MalNode conditionNode; @Child private MalNode trueNode; @Child private MalNode falseNode; IfNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); conditionNode = formToNode(language, form.tail.head, false, scope); trueNode = formToNode(language, form.tail.tail.head, tailPosition, scope); var falseForm = form.tail.tail.tail.head; falseNode = falseForm == null ? null : formToNode(language, falseForm, tailPosition, scope); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { var val = conditionNode.executeGeneric(frame, env); if (val == MalNil.NIL || Boolean.FALSE.equals(val)) { if (falseNode == null) { return MalNil.NIL; } else { return falseNode.executeGeneric(frame, env); } } else { return trueNode.executeGeneric(frame, env); } } } static abstract class AbstractBindArgNode extends Node { protected final int argPos; protected final EnvSlot slot; protected AbstractBindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { this.argPos = argPos; this.slot = scope.allocateSlot(symbol); } public abstract void execute(VirtualFrame frame, MalEnv env); } static class BindArgNode extends AbstractBindArgNode { public BindArgNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } @Override public void execute(VirtualFrame frame, MalEnv env) { env.set(slot, frame.getArguments()[argPos]); } } static class BindVarargsNode extends BindArgNode { public BindVarargsNode(MalSymbol symbol, int argPos, LexicalScope scope) { super(symbol, argPos, scope); } private MalList buildVarArgsList(Object[] args) { MalList varArgs = MalList.EMPTY; for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } return varArgs; } @Override public void execute(VirtualFrame frame, MalEnv env) { //env.set(slot, buildVarArgsList(frame.getArguments())); MalList varArgs = MalList.EMPTY; var args = frame.getArguments(); for (int i=args.length-1; i >= argPos; --i) { varArgs = varArgs.cons(args[i]); } //env.set(slot, varArgs); env.staticBindings[slot.slotNum] = varArgs; } } /** * Root node of a user-defined function, responsible for managing * the environment when the function is invoked. */ static class FnRootNode extends RootNode { final MalList form; final int numArgs; final LexicalScope scope; @Children AbstractBindArgNode[] bindNodes; @Child MalNode bodyNode; FnRootNode(MalLanguage language, MalList form, LexicalScope outerScope) { super(language, new FrameDescriptor()); this.form = form; var argNamesList = new ArrayList(); assert form.tail.head instanceof Iterable; var foundAmpersand = false; for (var name : (Iterable)form.tail.head) { if (MalSymbol.AMPERSAND.equals(name)) { foundAmpersand = true; } else { argNamesList.add((MalSymbol)name); } } this.numArgs = foundAmpersand? -1 : argNamesList.size(); this.bindNodes = new AbstractBindArgNode[argNamesList.size()]; this.scope = new LexicalScope(outerScope); for (int i=0; i < argNamesList.size(); i++) { if (numArgs == -1 && i == argNamesList.size()-1) { bindNodes[i] = new BindVarargsNode(argNamesList.get(i), i+1, scope); } else { bindNodes[i] = new BindArgNode(argNamesList.get(i), i+1, scope); } } this.bodyNode = formToNode(language, form.tail.tail.head, true, scope); } @ExplodeLoop @Override public Object execute(VirtualFrame frame) { var env = new MalEnv((MalEnv)frame.getArguments()[0], scope); for (int i=0; i < bindNodes.length; i++) { bindNodes[i].execute(frame, env); } return bodyNode.executeGeneric(frame, env); } @Override public String toString() { return form.toString(); } } /** * Node representing a (fn* ...) form. */ static class FnNode extends MalNode { final FnRootNode fnRoot; final RootCallTarget fnCallTarget; FnNode(MalLanguage language, MalList form, LexicalScope scope) { super(form); fnRoot = new FnRootNode(language, form, scope); this.fnCallTarget = Truffle.getRuntime().createCallTarget(fnRoot); } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return new MalFunction(fnCallTarget, env, fnRoot.numArgs); } } static class QuoteNode extends MalNode { final Object quoted; QuoteNode(MalLanguage language, MalList form) { super(form); quoted = form.tail.head; } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { return quoted; } } static class TryNode extends MalNode { @Child private MalNode tryBody; @Child private MalNode catchBody; final EnvSlot exSlot; final LexicalScope catchScope; TryNode(MalLanguage language, MalList form, boolean tailPosition, LexicalScope scope) { super(form); var tryForm = form.tail.head; var catchForm = (MalList)form.tail.tail.head; // We don't allow tail calls inside a try body, because // they'd get thrown past the catch that should catch subsequent failures. this.tryBody = formToNode(language, tryForm, false, scope); if (catchForm != null && MalSymbol.CATCH.equals(catchForm.head)) { catchScope = new LexicalScope(scope); var exSymbol = (MalSymbol)catchForm.tail.head; exSlot = catchScope.allocateSlot(exSymbol); catchBody = formToNode(language, catchForm.tail.tail.head, tailPosition, catchScope); } else { catchScope = null; exSlot = null; } } @Override public Object executeGeneric(VirtualFrame frame, MalEnv env) { try { return tryBody.executeGeneric(frame, env); } catch (MalException ex) { if (catchBody == null) { throw ex; } var catchEnv = new MalEnv(env, catchScope); catchEnv.set(exSlot, ex.obj); return catchBody.executeGeneric(frame, catchEnv); } } } final static class MalContext { final MalEnv globalEnv; final LexicalScope globalScope; final Iterable topScopes; final PrintStream out; final BufferedReader in; MalContext(MalLanguage language) { globalEnv = Core.newGlobalEnv(MalLanguage.class, language); globalScope = new LexicalScope(); topScopes = Collections.singleton(Scope.newBuilder("global", globalEnv).build()); out = System.out; in = new BufferedReader(new InputStreamReader(System.in)); } } @TruffleLanguage.Registration( id=LANGUAGE_ID, name=LANGUAGE_ID, defaultMimeType = "application/x-"+LANGUAGE_ID, characterMimeTypes = "application/x-"+LANGUAGE_ID) public final static class MalLanguage extends TruffleLanguage implements IMalLanguage { @Override protected MalContext createContext(Env env) { return new MalContext(this); } @Override public CallTarget evalForm(Object form) { var ctx = getCurrentContext(MalLanguage.class); var root = new MalRootNode(this, form, ctx.globalEnv, false, ctx.globalScope); return Truffle.getRuntime().createCallTarget(root); } @Override public AbstractInvokeNode invokeNode() { return new InvokeNode(false); } @Override protected CallTarget parse(ParsingRequest request) throws Exception { Source source = request.getSource(); String s = source.getCharacters().toString(); return evalForm(Reader.readStr(s)); } @Override protected Iterable findTopScopes(MalContext context) { return context.topScopes; } @Override public PrintStream out() { return getCurrentContext(MalLanguage.class).out; } @Override public BufferedReader in() { return getCurrentContext(MalLanguage.class).in; } } } ================================================ FILE: impls/jq/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ######################################################### # Specific implementation requirements ######################################################### RUN DEBIAN_FRONTEND=noninteractive apt-get -y install jq ================================================ FILE: impls/jq/Makefile ================================================ all: clean: rm -fr .mypy_cache/ check: flake8 run pylint run mypy run .PHONY: all clean check ================================================ FILE: impls/jq/core.jq ================================================ include "utils"; include "printer"; include "reader"; def core_identify: { "+": { kind: "fn", # native function inputs: 2, function: "number_add" }, "-": { kind: "fn", # native function inputs: 2, function: "number_sub" }, "*": { kind: "fn", # native function inputs: 2, function: "number_mul" }, "/": { kind: "fn", # native function inputs: 2, function: "number_div" }, "eval": { kind: "fn", inputs: 1, function: "eval" }, "env": { kind: "fn", function: "env", inputs: 0 }, "prn": { kind: "fn", function: "prn", inputs: -1 }, "pr-str": { kind: "fn", function: "pr-str", inputs: -1 }, "str": { kind: "fn", function: "str", inputs: -1 }, "println": { kind: "fn", function: "println", inputs: -1 }, "list": { kind: "fn", function: "list", inputs: -1 }, "list?": { kind: "fn", function: "list?", inputs: 1 }, "empty?": { kind: "fn", function: "empty?", inputs: 1 }, "count": { kind: "fn", function: "count", inputs: 1 }, "=": { kind: "fn", function: "=", inputs: 2 }, "<": { kind: "fn", function: "<", inputs: 2 }, "<=": { kind: "fn", function: "<=", inputs: 2 }, ">": { kind: "fn", function: ">", inputs: 2 }, ">=": { kind: "fn", function: ">=", inputs: 2 }, "read-string": { kind: "fn", function: "read-string", inputs: 1 }, "slurp": { kind: "fn", function: "slurp", inputs: 1 }, "atom": { kind: "fn", function: "atom", inputs: 1 }, "atom?": { kind: "fn", function: "atom?", inputs: 1 }, "deref": { kind: "fn", function: "deref", inputs: 1 }, "reset!": { # defined in interp kind: "fn", function: "reset!", inputs: 2 }, "swap!": { # defined in interp kind: "fn", function: "swap!", inputs: -3 }, "cons": { kind: "fn", function: "cons", inputs: 2 }, "concat": { kind: "fn", function: "concat", inputs: -1 }, "vec": { kind: "fn", function: "vec", inputs: 1 }, "nth": { kind: "fn", function: "nth", inputs: 2 }, "first": { kind: "fn", function: "first", inputs: 1 }, "rest": { kind: "fn", function: "rest", inputs: 1 }, "throw": { kind: "fn", function: "throw", inputs: 1 }, "apply": { # defined in interp kind: "fn", function: "apply", inputs: -3 }, "map": { # defined in interp kind: "fn", function: "map", inputs: 2 }, "nil?": { kind: "fn", function: "nil?", inputs: 1 }, "true?": { kind: "fn", function: "true?", inputs: 1 }, "false?": { kind: "fn", function: "false?", inputs: 1 }, "symbol": { kind: "fn", function: "symbol", inputs: 1 }, "symbol?": { kind: "fn", function: "symbol?", inputs: 1 }, "keyword": { kind: "fn", function: "keyword", inputs: 1 }, "keyword?": { kind: "fn", function: "keyword?", inputs: 1 }, "vector": { kind: "fn", function: "vector", inputs: -1 }, "vector?": { kind: "fn", function: "vector?", inputs: 1 }, "sequential?": { kind: "fn", function: "sequential?", inputs: 1 }, "hash-map": { kind: "fn", function: "hash-map", inputs: -1 }, "map?": { kind: "fn", function: "map?", inputs: 1 }, "assoc": { kind: "fn", function: "assoc", inputs: -2 }, "dissoc": { kind: "fn", function: "dissoc", inputs: -2 }, "get": { kind: "fn", function: "get", inputs: 2 }, "contains?": { kind: "fn", function: "contains?", inputs: 2 }, "keys": { kind: "fn", function: "keys", inputs: 1 }, "vals": { kind: "fn", function: "vals", inputs: 1 }, "string?": { kind: "fn", function: "string?", inputs: 1 }, "fn?": { kind: "fn", function: "fn?", inputs: 1 }, "number?": { kind: "fn", function: "number?", inputs: 1 }, "macro?": { kind: "fn", function: "macro?", inputs: 1 }, "readline": { kind: "fn", function: "readline", inputs: 1 }, "time-ms": { kind: "fn", function: "time-ms", inputs: 0 }, "meta": { kind: "fn", function: "meta", inputs: 1 }, "with-meta": { kind: "fn", function: "with-meta", inputs: 2 }, "seq": { kind: "fn", function: "seq", inputs: 1 }, "conj": { kind: "fn", function: "conj", inputs: -3 } }; def vec2list(obj): if obj.kind == "list" then obj.value | map(vec2list(.)) | wrap("list") else if obj.kind == "vector" then obj.value | map(vec2list(.)) | wrap("list") else if obj.kind == "hashmap" then obj.value | map_values(.value |= vec2list(.)) | wrap("hashmap") else obj end end end; def make_sequence: . as $dot | if .value|length == 0 then null | wrap("nil") else ( select(.kind == "string") | .value | split("") | map(wrap("string")) ) // ( select(.kind == "list" or .kind == "vector") | .value ) // jqmal_error("cannot make sequence from \(.kind)") | wrap("list") end; def core_interp(arguments; env): ( select(.function == "number_add") | arguments | map(.value) | .[0] + .[1] | wrap("number") ) // ( select(.function == "number_sub") | arguments | map(.value) | .[0] - .[1] | wrap("number") ) // ( select(.function == "number_mul") | arguments | map(.value) | .[0] * .[1] | wrap("number") ) // ( select(.function == "number_div") | arguments | map(.value) | .[0] / .[1] | wrap("number") ) // ( select(.function == "env") | env | tojson | wrap("string") ) // ( select(.function == "prn") | arguments | map(pr_str(env; {readable: true})) | join(" ") | _display | null | wrap("nil") ) // ( select(.function == "pr-str") | arguments | map(pr_str(env; {readable: true})) | join(" ") | wrap("string") ) // ( select(.function == "str") | arguments | map(pr_str(env; {readable: false})) | join("") | wrap("string") ) // ( select(.function == "println") | arguments | map(pr_str(env; {readable: false})) | join(" ") | _display | null | wrap("nil") ) // ( select(.function == "list") | arguments | wrap("list") ) // ( select(.function == "list?") | null | wrap(arguments | first.kind == "list" | tostring) ) // ( select(.function == "empty?") | null | wrap(arguments|first.value | length == 0 | tostring) ) // ( select(.function == "count") | arguments|first.value | length | wrap("number") ) // ( select(.function == "=") | null | wrap(vec2list(arguments[0]) == vec2list(arguments[1]) | tostring) ) // ( select(.function == "<") | null | wrap(arguments[0].value < arguments[1].value | tostring) ) // ( select(.function == "<=") | null | wrap(arguments[0].value <= arguments[1].value | tostring) ) // ( select(.function == ">") | null | wrap(arguments[0].value > arguments[1].value | tostring) ) // ( select(.function == ">=") | null | wrap(arguments[0].value >= arguments[1].value | tostring) ) // ( select(.function == "slurp") | arguments[0].value | slurp | wrap("string") ) // ( select(.function == "read-string") | arguments | first.value | read_form ) // ( select(.function == "atom?") | null | wrap(arguments | first.kind == "atom" | tostring) ) // ( 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") | arguments[0].value as $lst | arguments[1].value as $idx | if ($lst|length < $idx) or ($idx < 0) then jqmal_error("index out of range") else $lst[$idx] end ) // ( select(.function == "first") | arguments[0].value | first // {kind:"nil"} ) // ( select(.function == "rest") | arguments[0]?.value?[1:]? // [] | wrap("list") ) // ( select(.function == "throw") | jqmal_error(arguments[0] | tojson) ) // ( select(.function == "nil?") | null | wrap((arguments[0].kind == "nil") | tostring) ) // ( select(.function == "true?") | null | wrap((arguments[0].kind == "true") | tostring) ) // ( select(.function == "false?") | null | wrap((arguments[0].kind == "false") | tostring) ) // ( select(.function == "symbol?") | null | wrap((arguments[0].kind == "symbol") | tostring) ) // ( select(.function == "symbol") | arguments[0].value | wrap("symbol") ) // ( select(.function == "keyword") | arguments[0].value | wrap("keyword") ) // ( select(.function == "keyword?") | null | wrap((arguments[0].kind == "keyword") | tostring) ) // ( select(.function == "vector") | arguments | wrap("vector") ) // ( select(.function == "vector?") | null | wrap((arguments[0].kind == "vector") | tostring) ) // ( select(.function == "sequential?") | null | wrap((arguments[0].kind == "vector" or arguments[0].kind == "list") | tostring) ) // ( select(.function == "hash-map") | if (arguments|length) % 2 == 1 then jqmal_error("Odd number of arguments to hash-map") else [ arguments | nwise(2) | try { key: (.[0] | extract_string), value: { kkind: .[0].kind, value: .[1] } } ] | from_entries | wrap("hashmap") end ) // ( select(.function == "map?") | null | wrap((arguments[0].kind == "hashmap") | tostring) ) // ( select(.function == "assoc") | if (arguments|length) % 2 == 0 then jqmal_error("Odd number of key-values to assoc") else arguments[0].value + ([ arguments[1:] | nwise(2) | try { key: (.[0] | extract_string), value: { kkind: .[0].kind, value: .[1] } } ] | from_entries) | wrap("hashmap") end ) // ( select(.function == "dissoc") | arguments[1:] | map(.value) as $keynames | arguments[0].value | with_entries(select(.key as $k | $keynames | contains([$k]) | not)) | wrap("hashmap") ) // ( select(.function == "get") | arguments[0].value[arguments[1].value].value // {kind:"nil"} ) // ( select(.function == "contains?") | null | wrap((arguments[0].value | has(arguments[1].value)) | tostring) ) // ( select(.function == "keys") | arguments[0].value | with_entries(.value as $v | .key as $k | {key: $k, value: {value: $k, kind: $v.kkind}}) | to_entries | map(.value) | wrap("list") ) // ( select(.function == "vals") | arguments[0].value | map(.value) | to_entries | map(.value) | wrap("list") ) // ( select(.function == "string?") | null | wrap((arguments[0].kind == "string") | tostring) ) // ( select(.function == "fn?") | null | wrap((arguments[0].kind == "fn" or (arguments[0].kind == "function" and (arguments[0].is_macro|not))) | tostring) ) // ( select(.function == "number?") | null | wrap((arguments[0].kind == "number") | tostring) ) // ( select(.function == "macro?") | null | wrap((arguments[0].is_macro == true) | tostring) ) // ( select(.function == "readline") | arguments[0].value | __readline | wrap("string") ) // ( select(.function == "time-ms") | now * 1000 | wrap("number") ) // ( select(.function == "meta") | arguments[0].meta // {kind:"nil"} ) // ( select(.function == "with-meta") | arguments[0] | .meta |= arguments[1] ) // ( select(.function == "seq") | arguments[0] | make_sequence ) // ( select(.function == "conj") | arguments[0] as $orig | arguments[1:] as $stuff | if $orig.kind == "list" then [ $stuff|reverse[], $orig.value[] ] | wrap("list") else [ $orig.value[], $stuff[] ] | wrap("vector") end ) // jqmal_error("Unknown native function \(.function)"); ================================================ FILE: impls/jq/docs/impl-notes.md ================================================ # General Implementation Notes This document contains notes on the jq implementation, describing the deviations from the MAL specification and implementation details where necessary. ## Main Deviations per Step ### Step 0 As jq lacks a way to input free-form data on-demand, the REPL is implemented using a wrapper around the jq interpreter, which intercepts requests from our implementation and feeds the result back to jq as JSON; see the `__readline` function in [utils.jq](../utils.jq), and its implementation in [the wrapper](../run). All further free-form I/O primitives are implemented in a similar way. ### Step 1 There is not much deviation from the MAL process in this step, MAL data are implemented as JSON objects with two fields: `kind` and `value` (see [reader.jq](../reader.jq)). ### Step 2 jq cannot store functions as values, and so we are forced to represent them using their names and a large switch-case structure (`select()` in jq). The environment is simply modelled as a JSON object, and functions are represented as `{ "kind": "fn", "inputs": n, "function": name }` where `n` is the number of arguments the function takes and `name` is the name of the function to be handled by the switch-case structure (in `interpret()` at this stage). ### Step 3 The second of three environment implementations is introduced here, where an environment is an optional parent environment (which corresponds to the `outer` environment concept in the guide), and the environment from the previous step. Two convenience functions are introduced to handle the environment operations: `env-get` and `env-set`. The forms `let*` and `def!` are implemented mostly as described in the guide, with `let*` utilizing a left-associative fold (`reduce` in jq) to build the intermediate environment up; which is discarded after the fold is done. ### Step 4 In this step, environments grow yet another field `fallback`, which is used to add a second environment chain to non-top-level environments. This is used to implement functions that refer to unbound symbols in their body (this could be the function itself, or any other symbol defined later in the parent environment) - this is necessary as there are no variable references or mutable variables in jq (and thus we cannot modify an environment in-place). Due to this limitation, the `fn*` form is implemented by: - Recording the "free" symbols in the function body (which are not defined in the function's environment) - And storing a copy of the current environment in the function itself (for closures) The `interpret` function also gets an `_eval` callback parameter, which is used to evaluate the function body after a new environment is created with the correct bindings. Everything else is largely the same as in the guide. ### Step 5 Tail-calls are implemented as a (fairly complex) fixpoint iteration in the `EVAL` function; this "loop" takes an object of the form `{ast, env, ret_env, finish, cont}` and "iteratively" performs an evaluation step with `.ast` and `.env` (which is updated on every "iteration") until `.cont` is `false` (which is driven by the `finish` "flag"). Upon completion, the resulting environment is pulled from `ret_env` and the fixpoint is returned as the evaluation result. This is largely due to the lack of "actual" loops in jq, a computation of this form can also be expressed as a reduction over an infinite generator, but the fixpoint iteration is more straightforward to implement (as jq has a built-in `recurse` function). ### Step 6 This step deviates from the guide _significantly_, in the implementation of atoms; since jq does not have mutable variables (_or_ global variables), we cannot implement atoms in any simple way. First, let's go over atom identity and creation; this implementation "stamps" atoms with their creation timestamp (the result of `now | tostring`), which is used as a unique identifier for the atom. The fixpoint calculation of `EVAL` (and `TCOWrap` in particular) is adjusted to handle atoms "leaking" into the global environment (as they are not bound to any environment in reality, which differs from our implementation where atoms are bound to the active environment they were created in). The `interpret` function is also moved to a separate [interp.jq](../interp.jq) file, as it can be shared between steps going forward, and will also grow in complexity due to the introduction of atoms. ### Step 7 This step does not deviate from the guide. ### Step 8 This step does not deviate from the guide. ### Step 9 This step uses the native jq exception handling mechanism `try ... catch ...`, and follows the guide closely (and so no significant deviations are present). ### Step A This step does not deviate from the guide. ================================================ FILE: impls/jq/env.jq ================================================ include "utils"; def childEnv(binds; exprs): { parent: ., fallback: null, environment: [binds, exprs] | transpose | ( . as $dot | reduce .[] as $item ( { value: [], seen: false, name: null, idx: 0 }; if $item[1] != null then if .seen then { value: (.value[1:-1] + (.value|last[1].value += [$item[1]])), seen: true, name: .name } else if $item[0] == "&" then $dot[.idx+1][0] as $name | { value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]), seen: true, name: $name } else { value: (.value + [$item]), seen: false, name: null } end end | (.idx |= .idx + 1) else if $item[0] == "&" then $dot[.idx+1][0] as $name | { value: (.value + [[$name, {kind:"list", value: []}]]), seen: true, name: $name } else . end end ) ) | .value | map({(.[0]): .[1]}) | add }; def env_multiset(fn): .environment += (reduce fn.names[] as $key(.environment; .[$key] |= fn)); def env_set($key; $value): (if $value.kind == "function" or $value.kind == "atom" then # inform the function/atom of its names ($value | if $value.kind == "atom" then # check if the one we have is newer ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else # update modification timestamp $value | .last_modified |= now end else . end) | .names += [$key] | .names |= unique else $value end) as $value | # merge together, as .environment[$key] |= value does not work .environment += (.environment | .[$key] |= $value); def env_dump_keys: def _dump1: .environment // {} | keys; if . == null then [] else if .parent == null then ( _dump1 + (.fallback | env_dump_keys) ) else ( _dump1 + (.parent | env_dump_keys) + (.fallback | env_dump_keys) ) end | unique end; # Helper for env_get. def env_find(env): if env.environment[.] == null then if env.parent then env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end else null end else env end; def env_get(env): # key -> value or null . as $key | env_find(env).environment[$key] | if . != null and .kind == "atom" then ($key | env_find(env.parent).environment[$key]) as $possibly_newer | if $possibly_newer.identity == .identity and $possibly_newer.last_modified > .last_modified then $possibly_newer end end; def env_set(env; $key; $value): (if $value.kind == "function" then # inform the function/atom of its names $value | (.names += [$key]) | (.names |= unique) else $value end) as $value | { parent: env.parent, environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work fallback: env.fallback }; def wrapEnv(atoms): { replEnv: ., currentEnv: ., atoms: atoms, isReplEnv: true }; def wrapEnv(replEnv; atoms): { replEnv: replEnv, currentEnv: ., atoms: atoms, # id -> value isReplEnv: (replEnv == .) # should we allow separate copies? }; def unwrapReplEnv: .replEnv; def unwrapCurrentEnv: .currentEnv; def env_set_(env; key; value): if env.currentEnv != null then # Moving the common env_set before the if breaks something. ? if env.isReplEnv then env_set(env.currentEnv; key; value) | wrapEnv(env.atoms) else env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv; env.atoms) end else env_set(env; key; value) end; def addToEnv(name): # { expr, env } -> { same expr, new env } .expr as $value | .env |= ( . as $rawEnv | if .isReplEnv then env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.atoms) else env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms) end); def _env_remove_references(refs): if . != null then if .environment == null then debug("This one broke the rules, officer: \(.)") else { environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), parent: (.parent | _env_remove_references(refs)), fallback: (.fallback | _env_remove_references(refs)) } end else . end; def env_remove_references(refs): . as $env | if (refs|length == 0) then # optimisation: most functions are purely lexical $env else if has("replEnv") then .currentEnv |= _env_remove_references(refs) else _env_remove_references(refs) end end; ================================================ FILE: impls/jq/interp.jq ================================================ include "utils"; include "core"; include "env"; include "printer"; def arg_check(args): if .inputs < 0 then if (abs(.inputs) - 1) > (args | length) then jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") else . end else if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end end; def extractReplEnv(env): env | .replEnv // .; def extractEnv(env): env | .currentEnv // .; def updateReplEnv(renv): def findpath: if .env.parent then .path += ["parent"] | .env |= .parent | findpath else .path end; ({ env: ., path: [] } | findpath) as $path | setpath($path; renv); def extractCurrentReplEnv(env): def findpath: if .env.parent then .path += ["parent"] | .env |= .parent | findpath else .path end; if env.currentEnv != null then ({ env: env.currentEnv, path: [] } | findpath) as $path | env.currentEnv | getpath($path) else env end; def extractAtoms(env): env.atoms // {}; def addFrees(newEnv; frees): . as $env | reduce frees[] as $free ( $env; . as $dot | extractEnv(newEnv) as $env | ($free | env_get($env)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else . end) | . as $env | $env; def interpret(arguments; env; _eval): extractReplEnv(env) as $replEnv | extractAtoms(env) as $envAtoms | (if $DEBUG then debug("INTERP: \(pr_str(env))") end) | (select(.kind == "fn") | arg_check(arguments) | (select(.function == "eval") | # special function { expr: arguments[0], env: $replEnv|wrapEnv($replEnv; $envAtoms) } | _eval | .env as $xenv | extractReplEnv($xenv) as $xreplenv | setpath( ["env", "currentEnv"]; extractEnv(env) | updateReplEnv($xreplenv)) ) // (select(.function == "reset!") | # env modifying function arguments[0].identity as $id | ($envAtoms | setpath([$id]; arguments[1])) as $envAtoms | arguments[1] | {expr:., env: (env | setpath(["atoms"]; $envAtoms))} ) // (select(.function == "swap!") | # env modifying function arguments[0].identity as $id | $envAtoms[$id] as $initValue | arguments[1] as $function | ([$initValue] + arguments[2:]) as $args | ($function | interpret($args; env; _eval)) as $newEnvValue | ($envAtoms | setpath([$id]; $newEnvValue.expr)) as $envAtoms | $newEnvValue.expr | {expr:., env:(env | setpath(["atoms"]; $envAtoms))} ) // (select(.function == "atom") | (now|tostring) as $id | {kind: "atom", identity: $id} as $value | ($envAtoms | setpath([$id]; arguments[0])) as $envAtoms | $value | {expr:., env:(env | setpath(["atoms"]; $envAtoms))} ) // (select(.function == "deref") | $envAtoms[arguments[0].identity] | {expr:., env:env} ) // (select(.function == "apply") | # (apply F ...T A) -> (F ...T ...A) arguments as $args | ($args|first) as $F | ($args|last.value) as $A | $args[1:-1] as $T | $F | interpret([$T[], $A[]]; env; _eval) ) // (select(.function == "map") | arguments | first as $F | last.value as $L | (reduce $L[] as $elem ( {env: env, val: []}; . as $dot | ($F | interpret([$elem]; $dot.env; _eval)) as $val | { val: (.val + [$val.expr]), env: (.env | setpath(["atoms"]; $val.env.atoms)) } )) as $ex | $ex.val | wrap("list") | {expr:., env:$ex.env} ) // (core_interp(arguments; env) | {expr:., env:env}) ) // (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | # _debug("INTERP " + $src) | # _debug("FREES " + ($fn.free_referencess | tostring)) | extractEnv(.env | addFrees(env; $fn.free_referencess)) | .fallback |= extractEnv(env) | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; . as $env | try env_set_( .; $name; $name | env_get(env) // jqmal_error("'\(.)' not found ") | . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else $xvalue end ) catch $env)) | # tell it about itself env_multiset($fn) | wrapEnv($replEnv; $envAtoms) | { env: ., expr: $fn.body } | . as $dot # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | (extractReplEnv($envexp.env)) as $xreplenv | { expr: .expr, env: extractEnv(env) | updateReplEnv($xreplenv) | wrapEnv($xreplenv; $envexp.env.atoms) } # | . as $dot # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); ================================================ FILE: impls/jq/printer.jq ================================================ # {key: string, value: {kkind: kind, value: value}} -> [{kind: value.kkind, value: key}, value.value] def _reconstruct_hash: map([{ kind: .value.kkind, value: .key }, .value.value]); def pr_str(env; opt): (select(.kind == "symbol") | .value) // (select(.kind == "string") | .value | if opt.readable then tojson else . end) // (select(.kind == "keyword") | ":\(.value)") // (select(.kind == "number") | .value | tostring) // (select(.kind == "list") | .value | map(pr_str(env; opt)) | join(" ") | "(\(.))") // (select(.kind == "vector") | .value | map(pr_str(env; opt)) | join(" ") | "[\(.)]") // (select(.kind == "hashmap") | .value | to_entries | _reconstruct_hash | add // [] | map(pr_str(env; opt)) | join(" ") | "{\(.)}") // (select(.kind == "nil") | "nil") // (select(.kind == "true") | "true") // (select(.kind == "false") | "false") // (select(.kind == "fn") | "#") // (select(.kind == "function")| "#") // (select(.kind == "atom") | "(atom \(env.atoms[.identity] | pr_str(env; opt)))") // "#"; def pr_str(env): pr_str(env; {readable: true}); def pr_str: pr_str(null); # for stepX where X<6 ================================================ FILE: impls/jq/reader.jq ================================================ include "utils"; def tokenize: [ . | scan("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") | select(.|length > 0)[0] | select(.[0:1] != ";") ]; def read_str: tokenize; def escape_control: (select(. == "\u0000") | "\\u0000") // (select(. == "\u0001") | "\\u0001") // (select(. == "\u0002") | "\\u0002") // (select(. == "\u0003") | "\\u0003") // (select(. == "\u0004") | "\\u0004") // (select(. == "\u0005") | "\\u0005") // (select(. == "\u0006") | "\\u0006") // (select(. == "\u0007") | "\\u0007") // (select(. == "\u0008") | "\\u0008") // (select(. == "\u0009") | "\\u0009") // (select(. == "\u0010") | "\\u0010") // (select(. == "\u0011") | "\\u0011") // (select(. == "\u0012") | "\\u0012") // (select(. == "\u0013") | "\\u0013") // (select(. == "\u0014") | "\\u0014") // (select(. == "\u0015") | "\\u0015") // (select(. == "\u0016") | "\\u0016") // (select(. == "\u0017") | "\\u0017") // (select(. == "\u0018") | "\\u0018") // (select(. == "\u0019") | "\\u0019") // (select(. == "\u0020") | "\\u0020") // (select(. == "\u0021") | "\\u0021") // (select(. == "\u0022") | "\\u0022") // (select(. == "\u0023") | "\\u0023") // (select(. == "\u0024") | "\\u0024") // (select(. == "\u0025") | "\\u0025") // (select(. == "\u0026") | "\\u0026") // (select(. == "\u0027") | "\\u0027") // (select(. == "\u0028") | "\\u0028") // (select(. == "\u0029") | "\\u0029") // (select(. == "\u0030") | "\\u0030") // (select(. == "\u0031") | "\\u0031") // (select(. == "\n") | "\\n") // .; def read_string: gsub("(?[\u0000-\u001f])"; "\(.z | escape_control)") | fromjson; def extract_string: . as $val | if ["keyword", "symbol", "string"] | contains([$val.kind]) then $val.value else jqmal_error("assoc called with non-string key of type \($val.kind)") end; # stuff comes in as {tokens: [...], } def read_atom: (.tokens | first) as $lookahead | . | ( if $lookahead == "nil" then { tokens: .tokens[1:], value: { kind: "nil" } } else if $lookahead == "true" then { tokens: .tokens[1:], value: { kind: "true" } } else if $lookahead == "false" then { tokens: .tokens[1:], value: { kind: "false" } } else if $lookahead | test("^\"") then if $lookahead | test("^\"(?:\\\\.|[^\\\\\"])*\"$") then { tokens: .tokens[1:], value: { kind: "string", value: $lookahead | read_string } } else jqmal_error("EOF while reading string") end else if $lookahead | test("^:") then { tokens: .tokens[1:], value: { kind: "keyword", value: $lookahead[1:] } } else if $lookahead | test("^-?[0-9]+(?:\\.[0-9]+)?$") then { tokens: .tokens[1:], value: { kind: "number", value: $lookahead | tonumber } } else if [")", "]", "}"] | contains([$lookahead]) then # this isn't our business empty else { tokens: .tokens[1:], value: { kind: "symbol", value: $lookahead } } end end end end end end end ); def read_form_(depth): (.tokens | first) as $lookahead | . | ( if $lookahead == null then null # read_list else if $lookahead | test("^\\(") then [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; if try (.tokens | first | test("^\\)")) catch true then .finish |= true else . as $orig | read_form_(depth+1) as $res | { tokens: $res.tokens, value: ($orig.value + [$res.value]), finish: $orig.finish } end)) ] | map(select(.tokens)) | last as $result | if $result.tokens | first != ")" then jqmal_error("unbalanced parentheses in \($result.tokens)") else { tokens: $result.tokens[1:], value: { kind: "list", value: $result.value }, } end # read_list '[' else if $lookahead | test("^\\[") then [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; if try (.tokens | first | test("^\\]")) catch true then .finish |= true else . as $orig | read_form_(depth+1) as $res | { tokens: $res.tokens, value: ($orig.value + [$res.value]), finish: $orig.finish } end)) ] | map(select(.tokens)) | last as $result | if $result.tokens | first != "]" then jqmal_error("unbalanced brackets in \($result.tokens)") else { tokens: $result.tokens[1:], value: { kind: "vector", value: $result.value }, } end # read_list '{' else if $lookahead | test("^\\{") then [ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish; if try (.tokens | first | test("^\\}")) catch true then .finish |= true else . as $orig | read_form_(depth+1) as $res | { tokens: $res.tokens, value: ($orig.value + [$res.value]), finish: $orig.finish } end)) ] | map(select(.tokens)) | last as $result | if $result.tokens | first != "}" then jqmal_error("unbalanced braces in \($result.tokens)") else if $result.value | length % 2 == 1 then # odd number of elements not allowed jqmal_error("Odd number of parameters to assoc") else { tokens: $result.tokens[1:], value: { kind: "hashmap", value: [ $result.value | nwise(2) | try { key: (.[0] | extract_string), value: { kkind: .[0].kind, value: .[1] } } ] | from_entries } } end end # quote else if $lookahead == "'" then (.tokens |= .[1:]) | read_form_(depth+1) | ( { tokens: .tokens, value: { kind: "list", value: [ { kind: "symbol", value: "quote" }, .value ] } }) # quasiquote else if $lookahead == "`" then (.tokens |= .[1:]) | read_form_(depth+1) | ( { tokens: .tokens, value: { kind: "list", value: [ { kind: "symbol", value: "quasiquote" }, .value ] } }) # unquote else if $lookahead == "~" then (.tokens |= .[1:]) | read_form_(depth+1) | ( { tokens: .tokens, value: { kind: "list", value: [ { kind: "symbol", value: "unquote" }, .value ] } }) # split-unquote else if $lookahead == "~@" then (.tokens |= .[1:]) | read_form_(depth+1) | ( { tokens: .tokens, value: { kind: "list", value: [ { kind: "symbol", value: "splice-unquote" }, .value ] } }) # deref else if $lookahead == "@" then (.tokens |= .[1:]) | read_form_(depth+1) | ( { tokens: .tokens, value: { kind: "list", value: [ { kind: "symbol", value: "deref" }, .value ] } }) # with-meta else if $lookahead == "^" then (.tokens |= .[1:]) | read_form_(depth+1) as $meta | $meta | read_form_(depth+1) as $value | ( { tokens: $value.tokens, value: { kind: "list", value: [ { kind: "symbol", value: "with-meta" }, $value.value, $meta.value ] } }) else . as $prev | read_atom end end end end end end end end end end); def read_form: ({tokens: read_str} | read_form_(0).value) // {kind: "nil"}; ================================================ FILE: impls/jq/run ================================================ #!/usr/bin/python3 """Spawn a jq subprocess and wrap some IO interactions for it. jq seems unable to - open an arbitrary file (slurp) - emit a string on stdout without new line (readline) """ from json import JSONDecodeError, dumps, loads from os import environ from os.path import dirname, join, realpath from subprocess import PIPE, Popen from sys import argv rundir = dirname(realpath(__file__)) with Popen(args=['/usr/bin/jq', '--argjson', 'DEBUG', 'false', '-nrM', # --null-input --raw-output --monochrome-output '-L', rundir, '-f', join(rundir, environ.get('STEP', 'stepA_mal') + '.jq'), '--args'] + argv[1:], stdin=PIPE, stderr=PIPE, encoding='utf-8', ) as proc: assert proc.stderr is not None # for mypy for received in proc.stderr: try: as_json = loads(received) except JSONDecodeError: print(f'JQ STDERR: {received}', end=None) else: match as_json: case ['DEBUG:', ['display', str(message)]]: # While at it, provide a way to immediately print to # stdin for DEBUG-EVAL, println and prn (jq is able to # output to stderr, but *we* are already piping it). print(message) # Jq waits for this signal to go on, so that its own # output is not mixed with our one. print('null', file=proc.stdin, flush=True) case ['DEBUG:', ['readline', str(prompt)]]: try: data = input(prompt) except EOFError: break # Expected end of this script print(dumps(data), file=proc.stdin, flush=True) case ['DEBUG:', ['slurp', str(fname)]]: with open(fname, 'r', encoding='utf-8') as file_handler: data = file_handler.read() print(dumps(data), file=proc.stdin, flush=True) case _: # Allow normal debugging information for other purposes. print(f'JQ STDERR: {received}', end=None) print() ================================================ FILE: impls/jq/step0_repl.jq ================================================ include "utils"; def READ: .; def EVAL: .; def PRINT: .; def repl: # Infinite generator, interrupted by ./run. "user> " | __readline | READ | EVAL | PRINT, repl; repl ================================================ FILE: impls/jq/step1_read_print.jq ================================================ include "reader"; include "printer"; include "utils"; def READ: read_form; def EVAL: .; def PRINT: pr_str; def repl: # Infinite generator, interrupted by an exception or ./run. "user> " | __readline | try ( READ | EVAL | PRINT, repl ) catch if is_jqmal_error then ., repl else halt_error end; repl ================================================ FILE: impls/jq/step2_eval.jq ================================================ include "reader"; include "printer"; include "utils"; def READ: read_form; def arg_check(args): if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end; def interpret(arguments; env): (select(.kind == "fn") | arg_check(arguments) | ( select(.function == "number_add") | arguments | map(.value) | .[0] + .[1] | wrap("number") ) // ( select(.function == "number_sub") | arguments | map(.value) | .[0] - .[1] | wrap("number") ) // ( select(.function == "number_mul") | arguments | map(.value) | .[0] * .[1] | wrap("number") ) // ( select(.function == "number_div") | arguments | map(.value) | .[0] / .[1] | wrap("number") ) ) // jqmal_error("Unsupported native function kind \(.kind)"); def EVAL(env): # ("EVAL: \(pr_str(env))" | _display | empty), (select(.kind == "list") | .value | select(length != 0) as $value | map(EVAL(env)) | .[1:] as $args | first | interpret($args; env) ) // ( select(.kind == "vector") | { kind: "vector", value: .value|map(EVAL(env)) } ) // ( select(.kind == "hashmap") | { kind: "hashmap", value: .value|map_values(.value |= EVAL(env)) } ) // ( select(.kind == "symbol") | env[.value] // jqmal_error("'\(.)' not found") ) // .; def PRINT: pr_str; def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | PRINT, ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; # The main program starts here. { "+": { kind: "fn", # native function inputs: 2, function: "number_add" }, "-": { kind: "fn", # native function inputs: 2, function: "number_sub" }, "*": { kind: "fn", # native function inputs: 2, function: "number_mul" }, "/": { kind: "fn", # native function inputs: 2, function: "number_div" }, } | repl ================================================ FILE: impls/jq/step3_env.jq ================================================ include "reader"; include "printer"; include "utils"; include "env"; def READ: read_form; # Environment Functions def env_set(env; $key; $value): { parent: env.parent, environment: (env.environment + (env.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work }; def arg_check(args): if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end; def interpret(arguments; env): (select(.kind == "fn") | arg_check(arguments) | ( select(.function == "number_add") | arguments | map(.value) | .[0] + .[1] | wrap("number") ) // ( select(.function == "number_sub") | arguments | map(.value) | .[0] - .[1] | wrap("number") ) // ( select(.function == "number_mul") | arguments | map(.value) | .[0] * .[1] | wrap("number") ) // ( select(.function == "number_div") | arguments | map(.value) | .[0] / .[1] | wrap("number") ) | {expr:., env:env} ) // jqmal_error("Unsupported native function kind \(.kind)"); def EVAL(env): if "DEBUG-EVAL" | env_get(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) | ( select(.[0].value == "def!") | .[1].value as $key | .[2] | EVAL(env) | .expr as $value | .env |= env_set(.; $key; $value) ) // ( select(.[0].value == "let*") | (reduce (.[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:env, environment:{}, fallback:null}; # Loop body . as $env | $xvalue[1] | EVAL($env) | env_set(.env; $xvalue[0].value; .expr) )) as $env | .[2] | {expr:EVAL($env).expr, env:env} ) // ( reduce .[] as $elem ( []; . as $dot | $elem | EVAL(env) as $eval_env | ($dot + [$eval_env.expr]) ) | { expr: ., env: env } as $ev | $ev.expr | first | interpret($ev.expr[1:]; $ev.env) ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:env}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .expr |= {kind:"vector", value:.} ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:env}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .expr |= {kind:"hashmap", value:from_entries} ) // ( select(.kind == "symbol") | .value | env_get(env) // jqmal_error("'\(.)' not found") | {expr:., env:env} ) // {expr:., env:env}; def PRINT: pr_str; def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | (.expr | PRINT), (.env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; # The main program starts here. { parent: null, environment: { "+": { kind: "fn", # native function inputs: 2, function: "number_add" }, "-": { kind: "fn", # native function inputs: 2, function: "number_sub" }, "*": { kind: "fn", # native function inputs: 2, function: "number_mul" }, "/": { kind: "fn", # native function inputs: 2, function: "number_div" }, } } | repl ================================================ FILE: impls/jq/step4_if_fn_do.jq ================================================ include "reader"; include "printer"; include "utils"; include "env"; include "core"; def READ: read_form; # Environment Functions def env_set(env; $key; $value): (if $value.kind == "function" or $value.kind == "atom" then # inform the function/atom of its names $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else # update modification timestamp $value | .last_modified |= now end else . end else $value end) as $value | { parent: env.parent, environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work fallback: env.fallback }; def _env_remove_references(refs): if . != null then { environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), parent: (.parent | _env_remove_references(refs)), fallback: (.fallback | _env_remove_references(refs)) } else . end; def env_remove_references(refs): . as $env | if has("replEnv") then .currentEnv |= _env_remove_references(refs) else _env_remove_references(refs) end; # Evaluation def arg_check(args): if .inputs < 0 then if (abs(.inputs) - 1) > (args | length) then jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") else . end else if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end end; def addFrees(newEnv; frees): . as $env | reduce frees[] as $free ( $env; . as $dot | ($free | env_get(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else . end) | . as $env | $env; def interpret(arguments; env; _eval): (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | (select(.kind == "fn") | arg_check(arguments) | core_interp(arguments; env) | {expr:., env:env} ) // (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | # debug("INTERP " + $src) | # debug("FREES " + ($fn.free_referencess | tostring)) | .env | addFrees(env; $fn.free_referencess) | .fallback |= env | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; . as $env | try env_set( .; $name; $name | env_get(env) // jqmal_error("'\(.)' not found") | . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else $xvalue end ) catch $env)) | # tell it about itself env_multiset($fn) | { env: ., expr: $fn.body } | . as $dot # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | { expr: .expr, env: env } # | . as $dot # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); # EVAL starts here. if "DEBUG-EVAL" | env_get(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | .[1].value as $key | .[2] | EVAL(env) | if .env.replEnv != null then addToEnv($key) else .expr as $def_value | .env |= env_set_(.; $key; $def_value) end ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:env, environment:{}, fallback:null}; # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | { expr: EVAL($env).expr, env: env } ) // ( select(.[0].value == "do") | (reduce ($value[1:][]) as $xvalue ( { env: env, expr: {kind:"nil"} }; .env as $env | $xvalue | EVAL($env) )) ) // ( select(.[0].value == "if") | $value[1] | EVAL(env) as $condenv | if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) | EVAL($condenv.env) else $value[2] | EVAL($condenv.env) end ) // ( select(.[0].value == "fn*") | # we can't do what the guide says, so we'll skip over this # and ues the later implementation # (fn* args body) $value[1].value | map(.value) as $binds | { kind: "function", binds: $binds, env: env, body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $value[2] | find_free_references(env | env_dump_keys + $binds) # for dynamically scoped variables } | {expr: ., env:env} ) // ( reduce .[] as $elem ( []; . as $dot | $elem | EVAL(env) as $eval_env | ($dot + [$eval_env.expr]) ) | { expr: ., env: env } as $ev | $ev.expr | first | interpret($ev.expr[1:]; $ev.env; _eval_here) ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:env}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .expr |= {kind:"vector", value:.} ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:env}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .expr |= {kind:"hashmap", value:from_entries} ) // ( select(.kind == "symbol") | .value | env_get(env) // jqmal_error("'\(.)' not found") | {expr:., env:env} ) // {expr:., env:env}; def PRINT: pr_str; def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | (.expr | PRINT), (.env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | eval_ign("(def! not (fn* (a) (if a false true)))") | repl ================================================ FILE: impls/jq/step5_tco.jq ================================================ include "reader"; include "printer"; include "utils"; include "env"; include "core"; def READ: read_form; # Environment Functions def env_set(env; $key; $value): (if $value.kind == "function" or $value.kind == "atom" then # inform the function/atom of its names $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else # update modification timestamp $value | .last_modified |= now end else . end else $value end) as $value | { parent: env.parent, environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work fallback: env.fallback }; def _env_remove_references(refs): if . != null then { environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), parent: (.parent | _env_remove_references(refs)), fallback: (.fallback | _env_remove_references(refs)) } else . end; def env_remove_references(refs): . as $env | if has("replEnv") then .currentEnv |= _env_remove_references(refs) else _env_remove_references(refs) end; # Evaluation def arg_check(args): if .inputs < 0 then if (abs(.inputs) - 1) > (args | length) then jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") else . end else if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end end; def addFrees(newEnv; frees): . as $env | reduce frees[] as $free ( $env; . as $dot | ($free | env_get(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else . end) | . as $env | $env; def interpret(arguments; env; _eval): (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | (select(.kind == "fn") | arg_check(arguments) | core_interp(arguments; env) | {expr:., env:env} ) // (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | # debug("INTERP " + $src) | # debug("FREES " + ($fn.free_referencess | tostring)) | .env | addFrees(env; $fn.free_referencess) | .fallback |= env | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; . as $env | try env_set( .; $name; $name | env_get(env) // jqmal_error("'\(.)' not found") | . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else $xvalue end ) catch $env)) | # tell it about itself env_multiset($fn) | { env: ., expr: $fn.body } | . as $dot # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | { expr: .expr, env: env } # | . as $dot # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: retenv, finish: (continue | not), cont: true # set inside }; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | if "DEBUG-EVAL" | env_get($_menv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | ( if .env.replEnv != null then addToEnv($value[1].value) else .expr as $def_value | .env |= env_set_(.; $value[1].value; $def_value) end ) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$_menv, environment:{}, fallback:null}; # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | $value[1] | EVAL(env) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | { kind: "function", binds: $binds, env: $_menv, body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $value[2] | find_free_references($_menv | env_dump_keys + $binds) # for dynamically scoped variables } | TCOWrap($_menv; $_orig_retenv; false) ) // ( reduce .[] as $elem ( []; . as $dot | $elem | EVAL($_menv) as $eval_env | ($dot + [$eval_env.expr]) ) | . as $expr | first | interpret($expr[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:env}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($_menv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT: pr_str; def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | (.expr | PRINT), (.env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | eval_ign("(def! not (fn* (a) (if a false true)))") | repl ================================================ FILE: impls/jq/step6_file.jq ================================================ include "reader"; include "printer"; include "utils"; include "interp"; include "env"; include "core"; def READ: read_form; def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), finish: (continue | not), cont: true # set inside }; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | . as $init | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init | if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$currentEnv, environment:{}, fallback:null} | wrapEnv($replEnv; $_menv.atoms); # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { kind: "function", binds: $binds, env: ($_menv | env_remove_references($free_referencess)), body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $free_referencess, # for dynamically scoped variables } | TCOWrap($_menv; $_orig_retenv; false) ) // ( ( .[0] | EVAL($_menv) | (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | .expr ) as $fn | $value[1:] | (reduce .[] as $elem ( {env: $_menv, val: []}; # debug(".val: \(.val) elem=\($elem)") | . as $dot | $elem | EVAL($dot.env) as $eval_env | ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | {env: $_menv, val: ($dot.val + [$eval_env.expr])} # | debug(".val: \(.val)") )) as $expr | # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($currentEnv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | .env as $env | (.expr | PRINT($env)), ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | wrapEnv({}) | eval_ign("(def! not (fn* (a) (if a false true)))") | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) | if $ARGS.positional|length > 0 then eval_ign("(load-file \($ARGS.positional[0] | tojson))") | empty else repl end ================================================ FILE: impls/jq/step7_quote.jq ================================================ include "reader"; include "printer"; include "utils"; include "interp"; include "env"; include "core"; def READ: read_form; def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), finish: (continue | not), cont: true # set inside }; def quasiquote: # If input is ('name, arg), return arg, else nothing. def _starts_with(name): select(.kind == "list") | .value | select(length == 2) | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): (_starts_with("splice-unquote") | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # 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: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | . as $init | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init | if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$currentEnv, environment:{}, fallback:null} | wrapEnv($replEnv; $_menv.atoms); # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { kind: "function", binds: $binds, env: ($_menv | env_remove_references($free_referencess)), body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $free_referencess, # for dynamically scoped variables } | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quasiquote") | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) ) // ( ( .[0] | EVAL($_menv) | (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | .expr ) as $fn | $value[1:] | (reduce .[] as $elem ( {env: $_menv, val: []}; # debug(".val: \(.val) elem=\($elem)") | . as $dot | $elem | EVAL($dot.env) as $eval_env | ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | {env: $_menv, val: ($dot.val + [$eval_env.expr])} # | debug(".val: \(.val)") )) as $expr | # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($currentEnv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | .env as $env | (.expr | PRINT($env)), ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | wrapEnv({}) | eval_ign("(def! not (fn* (a) (if a false true)))") | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) | if $ARGS.positional|length > 0 then eval_ign("(load-file \($ARGS.positional[0] | tojson))") | empty else repl end ================================================ FILE: impls/jq/step8_macros.jq ================================================ include "reader"; include "printer"; include "utils"; include "interp"; include "env"; include "core"; def READ: read_form; def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), finish: (continue | not), cont: true # set inside }; def quasiquote: # If input is ('name, arg), return arg, else nothing. def _starts_with(name): select(.kind == "list") | .value | select(length == 2) | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): (_starts_with("splice-unquote") | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # 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: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: if .kind != "function" then jqmal_error("expected a function to be defined by defmacro!") else .is_macro |= true end; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | . as $init | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init | if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | $value[2] | EVAL($_menv) | .expr |= set_macro_function | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$currentEnv, environment:{}, fallback:null} | wrapEnv($replEnv; $_menv.atoms); # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { kind: "function", binds: $binds, env: ($_menv | env_remove_references($free_referencess)), body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $free_referencess, # for dynamically scoped variables is_macro: false } | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quasiquote") | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) ) // ( ( .[0] | EVAL($_menv) | (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | .expr ) as $fn | if $fn.kind == "function" and $fn.is_macro then $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) else $value[1:] | (reduce .[] as $elem ( {env: $_menv, val: []}; # debug(".val: \(.val) elem=\($elem)") | . as $dot | $elem | EVAL($dot.env) as $eval_env | ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | {env: $_menv, val: ($dot.val + [$eval_env.expr])} # | debug(".val: \(.val)") )) as $expr | # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($currentEnv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | .env as $env | (.expr | PRINT($env)), ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | wrapEnv({}) | eval_ign("(def! not (fn* (a) (if a false true)))") | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") | eval_ign("(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)))))))") | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) | if $ARGS.positional|length > 0 then eval_ign("(load-file \($ARGS.positional[0] | tojson))") | empty else repl end ================================================ FILE: impls/jq/step9_try.jq ================================================ include "reader"; include "printer"; include "utils"; include "interp"; include "env"; include "core"; def READ: read_form; def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), finish: (continue | not), cont: true # set inside }; def quasiquote: # If input is ('name, arg), return arg, else nothing. def _starts_with(name): select(.kind == "list") | .value | select(length == 2) | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): (_starts_with("splice-unquote") | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # 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: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: if .kind != "function" then jqmal_error("expected a function to be defined by defmacro!") else .is_macro |= true end; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | . as $init | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init | if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | $value[2] | EVAL($_menv) | .expr |= set_macro_function | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$currentEnv, environment:{}, fallback:null} | wrapEnv($replEnv; $_menv.atoms); # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "try*") | if $value[2] and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") then try ( $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) ) catch ( . as $exc | (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( $ex | fromjson ) catch ( $ex | wrap("string") ) else $exc|wrap("string") end) as $exc | $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex | $ex.expr | TCOWrap($ex.env; $_retenv; false) ) else $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) end ) // ( select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { kind: "function", binds: $binds, env: ($_menv | env_remove_references($free_referencess)), body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $free_referencess, # for dynamically scoped variables is_macro: false } | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quasiquote") | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) ) // ( ( .[0] | EVAL($_menv) | (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | .expr ) as $fn | if $fn.kind == "function" and $fn.is_macro then $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) else $value[1:] | (reduce .[] as $elem ( {env: $_menv, val: []}; # debug(".val: \(.val) elem=\($elem)") | . as $dot | $elem | EVAL($dot.env) as $eval_env | ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | {env: $_menv, val: ($dot.val + [$eval_env.expr])} # | debug(".val: \(.val)") )) as $expr | # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($currentEnv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | .env as $env | (.expr | PRINT($env)), ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | wrapEnv({}) | eval_ign("(def! not (fn* (a) (if a false true)))") | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") | eval_ign("(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)))))))") | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) | if $ARGS.positional|length > 0 then eval_ign("(load-file \($ARGS.positional[0] | tojson))") | empty else repl end ================================================ FILE: impls/jq/stepA_mal.jq ================================================ include "reader"; include "printer"; include "utils"; include "interp"; include "env"; include "core"; def READ: read_form; def recurseflip(x; y): recurse(y; x); def TCOWrap(env; retenv; continue): { ast: ., env: env, ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end), finish: (continue | not), cont: true # set inside }; def quasiquote: # If input is ('name, arg), return arg, else nothing. def _starts_with(name): select(.kind == "list") | .value | select(length == 2) | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): (_starts_with("splice-unquote") | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # 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: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: if .kind != "function" then jqmal_error("expected a function to be defined by defmacro!") else .is_macro |= true end; def EVAL(env): def _eval_here: .env as $env | .expr | EVAL($env); . as $ast | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | (if $DEBUG then debug("EVAL: \($ast | pr_str($_menv))") else . end) | (if $DEBUG then debug("ATOMS: \($_menv.atoms)") else . end) | if .finish then .cont |= false else (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | . as $init | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init | if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | .value | select(length != 0) as $value | ( select(.[0].value == "atoms??") | $_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "def!") | $value[2] | EVAL($_menv) | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | $value[2] | EVAL($_menv) | .expr |= set_macro_function | addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "let*") | (reduce ($value[1].value | nwise(2)) as $xvalue ( # Initial accumulator {parent:$currentEnv, environment:{}, fallback:null} | wrapEnv($replEnv; $_menv.atoms); # Loop body . as $env | $xvalue[1] | EVAL($env) as $expenv | env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env | $value[2] | TCOWrap($env; $_retenv; true) ) // ( select(.[0].value == "do") | (reduce $value[1:-1][] as $xvalue ( $_menv; . as $env | $xvalue | EVAL($env) | .env )) as $env | $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "try*") | if $value[2] and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") then try ( $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) ) catch ( . as $exc | (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( $ex | fromjson ) catch ( $ex | wrap("string") ) else $exc|wrap("string") end) as $exc | $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex | $ex.expr | TCOWrap($ex.env; $_retenv; false) ) else $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) end ) // ( select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) else $value[2] end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { kind: "function", binds: $binds, env: ($_menv | env_remove_references($free_referencess)), body: $value[2], names: [], # we can't do that circular reference thing free_referencess: $free_referencess, # for dynamically scoped variables is_macro: false } | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( select(.[0].value == "quasiquote") | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) ) // ( ( .[0] | EVAL($_menv) | (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | .expr ) as $fn | if $fn.kind == "function" and $fn.is_macro then $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) else $value[1:] | (reduce .[] as $elem ( {env: $_menv, val: []}; # debug(".val: \(.val) elem=\($elem)") | . as $dot | $elem | EVAL($dot.env) as $eval_env | ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv | {env: $_menv, val: ($dot.val + [$eval_env.expr])} # | debug(".val: \(.val)") )) as $expr | # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) ) // ( select(.kind == "vector") | .value | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] ) | .env as $e | {kind:"vector", value:.expr} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | .value | to_entries | reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x.value.value | EVAL($acc.env) | .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) ) | .env as $e | {kind:"hashmap", value:.expr|from_entries} | TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // ( select(.kind == "symbol") | .value | env_get($currentEnv) // jqmal_error("'\(.)' not found") | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end | (if $DEBUG then debug("POSTEVAL: \($ast | pr_str($_menv)) = \(.ast | pr_str($_menv))") else . end) ) ] | last | {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | try ( READ | EVAL($env) | .env as $env | (.expr | PRINT($env)), ($env | repl) ) catch if is_jqmal_error then ., ($env | repl) else halt_error end; def eval_ign(expr): . as $env | expr | READ | EVAL($env) | .env; # The main program starts here. { parent: null, environment: core_identify, fallback: null } | wrapEnv({}) | eval_ign("(def! *host-language* \"jq\")") | eval_ign("(def! not (fn* (a) (if a false true)))") | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") | eval_ign("(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)))))))") | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) | if $ARGS.positional|length > 0 then eval_ign("(load-file \($ARGS.positional[0] | tojson))") | empty else eval_ign("(println (str \"Mal [\" *host-language* \"]\"))") | repl end ================================================ FILE: impls/jq/utils.jq ================================================ def nwise(n): def _nwise: if length <= n then . else .[0:n], (.[n:] | _nwise) end; _nwise; def abs(x): if x < 0 then 0 - x else x end; def jqmal_error(e): error("JqMAL Exception :: " + e); def is_jqmal_error: startswith("JqMAL Exception :: "); def wrap(kind): { kind: kind, value: . }; def find_free_references(keys): def _refs: if . == null then [] else . as $dot | if .kind == "symbol" then if keys | contains([$dot.value]) then [] else [$dot.value] end else if "list" == $dot.kind then if $dot.value|length == 0 then [] else # if - scan args # def! - scan body # let* - add keys sequentially, scan body # fn* - add keys, scan body # quote - [] # quasiquote - ??? $dot.value[0] as $head | if $head.kind == "symbol" then ( select($head.value == "if") | $dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x) ) // ( select($head.value == "def!") | $dot.value[2] | _refs ) // ( select($head.value == "let*") | $dot.value[2] | find_free_references(($dot.value[1].value as $value | ([ range(0; $value|length; 2) ] | map(select(. % 2 == 0) | $value[.].value))) + keys) ) // ( select($head.value == "fn*") | $dot.value[2] | find_free_references(($dot.value[1].value | map(.value)) + keys) ) // ( select($head.value == "quote") | [] ) // ( select($head.value == "quasiquote") | [] ) // ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x)) else [ $dot.values[1:][] | _refs ] end end else if "vector" == $dot.kind then ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x)) else if "hashmap" == $dot.kind then ([$dot.value | to_entries[] | ({kind: .value.kkind, value: .key}, .value.value) ] | map(_refs) | reduce .[] as $x ([]; . + $x)) else [] end end end end end; _refs | unique; # The following IO actions are implemented in rts.py. def __readline: ["readline", .] | debug | input; # The output is not very interesting. # 'input' here only ensures that the python process has printed the # message before any further output by the jq process. def _display: ["display", .] | debug | input; def slurp: ["slurp", .] | debug | input; ================================================ FILE: impls/js/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm ENV NPM_CONFIG_CACHE /mal/.npm ================================================ FILE: impls/js/Makefile ================================================ TESTS = tests/types.js tests/reader.js SOURCES_BASE = node_readline.js types.js reader.js printer.js interop.js SOURCES_LISP = env.js core.js stepA_mal.js SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) WEB_SOURCES = $(SOURCES:node_readline.js=jq_readline.js) STEPS = step0_repl.js step1_read_print.js step2_eval.js step3_env.js \ step4_if_fn_do.js step5_tco.js step6_file.js \ step7_quote.js step8_macros.js step9_try.js stepA_mal.js all: node_modules dist: mal.js mal web/mal.js node_modules: npm install $(STEPS): node_modules mal.js: $(SOURCES) cat $+ | grep -v "= *require('./" >> $@ mal: mal.js echo "#!/usr/bin/env node" > $@ cat $< >> $@ chmod +x $@ web/mal.js: $(WEB_SOURCES) cat $+ | grep -v "= *require('./" > $@ clean: rm -f mal.js web/mal.js rm -rf node_modules .PHONY: tests $(TESTS) tests: $(TESTS) $(TESTS): @echo "Running $@"; \ node $@ || exit 1; \ ================================================ FILE: impls/js/core.js ================================================ // Node vs browser behavior var core = {}; if (typeof module === 'undefined') { var exports = core; } else { var types = require('./types'), readline = require('./node_readline'), reader = require('./reader'), printer = require('./printer'), interop = require('./interop'); } // Errors/Exceptions function mal_throw(exc) { throw exc; } // String functions function pr_str() { return Array.prototype.map.call(arguments,function(exp) { return printer._pr_str(exp, true); }).join(" "); } function str() { return Array.prototype.map.call(arguments,function(exp) { return printer._pr_str(exp, false); }).join(""); } function prn() { printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { return printer._pr_str(exp, true); })); } function println() { printer.println.apply({}, Array.prototype.map.call(arguments,function(exp) { return printer._pr_str(exp, false); })); } function slurp(f) { if (typeof require !== 'undefined') { return require('fs').readFileSync(f, 'utf-8'); } else { var req = new XMLHttpRequest(); req.open("GET", f, false); req.send(); if (req.status == 200) { return req.responseText; } else { throw new Error("Failed to slurp file: " + f); } } } // Number functions function time_ms() { return new Date().getTime(); } // Hash Map functions function assoc(src_hm) { var hm = types._clone(src_hm); var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); return types._assoc_BANG.apply(null, args); } function dissoc(src_hm) { var hm = types._clone(src_hm); var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); return types._dissoc_BANG.apply(null, args); } function get(hm, key) { if (hm != null && key in hm) { return hm[key]; } else { return null; } } function contains_Q(hm, key) { if (key in hm) { return true; } else { return false; } } function keys(hm) { return Object.keys(hm); } function vals(hm) { return Object.keys(hm).map(function(k) { return hm[k]; }); } // Sequence functions function cons(a, b) { return [a].concat(b); } 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]; } else { throw new Error("nth: index out of range"); } } function first(lst) { return (lst === null) ? null : lst[0]; } function rest(lst) { return (lst == null) ? [] : lst.slice(1); } function empty_Q(lst) { return lst.length === 0; } function count(s) { if (Array.isArray(s)) { return s.length; } else if (s === null) { return 0; } else { return Object.keys(s).length; } } function conj(lst) { if (types._list_Q(lst)) { return Array.prototype.slice.call(arguments, 1).reverse().concat(lst); } else { var v = lst.concat(Array.prototype.slice.call(arguments, 1)); v.__isvector__ = true; return v; } } function seq(obj) { if (types._list_Q(obj)) { return obj.length > 0 ? obj : null; } else if (types._vector_Q(obj)) { return obj.length > 0 ? Array.prototype.slice.call(obj, 0): null; } else if (types._string_Q(obj)) { return obj.length > 0 ? obj.split('') : null; } else if (obj === null) { return null; } else { throw new Error("seq: called on non-sequence"); } } function apply(f) { var args = Array.prototype.slice.call(arguments, 1); return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); } function map(f, lst) { return lst.map(function(el){ return f(el); }); } // Metadata functions function with_meta(obj, m) { var new_obj = types._clone(obj); new_obj.__meta__ = m; return new_obj; } function meta(obj) { // TODO: support symbols and atoms if ((!types._sequential_Q(obj)) && (!(types._hash_map_Q(obj))) && (!(types._function_Q(obj)))) { throw new Error("attempt to get metadata from: " + types._obj_type(obj)); } return obj.__meta__; } // Atom functions function deref(atm) { return atm.val; } function reset_BANG(atm, val) { return atm.val = val; } function swap_BANG(atm, f) { var args = [atm.val].concat(Array.prototype.slice.call(arguments, 2)); atm.val = f.apply(f, args); return atm.val; } function js_eval(str) { return interop.js_to_mal(eval(str.toString())); } function js_method_call(object_method_str) { var args = Array.prototype.slice.call(arguments, 1), r = interop.resolve_js(object_method_str), obj = r[0], f = r[1]; var res = f.apply(obj, args); return interop.js_to_mal(res); } // types.ns is namespace of type functions var ns = {'type': types._obj_type, '=': types._equal_Q, 'throw': mal_throw, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, 'number?': types._number_Q, 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, 'fn?': types._fn_Q, 'macro?': types._macro_Q, 'pr-str': pr_str, 'str': str, 'prn': prn, 'println': println, 'readline': readline.readline, 'read-string': reader.read_str, 'slurp': slurp, '<' : function(a,b){return a' : function(a,b){return a>b;}, '>=' : function(a,b){return a>=b;}, '+' : function(a,b){return a+b;}, '-' : function(a,b){return a-b;}, '*' : function(a,b){return a*b;}, '/' : function(a,b){return a/b;}, "time-ms": time_ms, 'list': types._list, 'list?': types._list_Q, 'vector': types._vector, 'vector?': types._vector_Q, 'hash-map': types._hash_map, 'map?': types._hash_map_Q, 'assoc': assoc, 'dissoc': dissoc, 'get': get, 'contains?': contains_Q, 'keys': keys, 'vals': vals, 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, 'vec': vec, 'nth': nth, 'first': first, 'rest': rest, 'empty?': empty_Q, 'count': count, 'apply': apply, 'map': map, 'conj': conj, 'seq': seq, 'with-meta': with_meta, 'meta': meta, 'atom': types._atom, 'atom?': types._atom_Q, "deref": deref, "reset!": reset_BANG, "swap!": swap_BANG, 'js-eval': js_eval, '.': js_method_call }; exports.ns = core.ns = ns; ================================================ FILE: impls/js/env.js ================================================ // Node vs browser behavior var env = {}; if (typeof module === 'undefined') { var exports = env; } // Env implementation function Env(outer, binds, exprs) { this.data = {}; this.outer = outer || null; if (binds && exprs) { // Returns a new Env with symbols in binds bound to // corresponding values in exprs // TODO: check types of binds and exprs and compare lengths for (var i=0; i max_history_length) { lines = lines.slice(lines.length-max_history_length); } jq.SetHistory(lines); } } function jq_save_history(jq) { var lines = jq.GetHistory(); localStorage['mal_history'] = JSON.stringify(lines); } var readline = { 'readline': function(prompt_str) { return prompt(prompt_str); }}; ================================================ FILE: impls/js/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL //var RL_LIB = "libedit.so.2"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context const koffi = require('koffi'); const fs = require('fs'); let rllib; try { rllib = koffi.load(RL_LIB); } catch (e) { console.error('ERROR loading RL_LIB:', RL_LIB, e); throw e; } const readlineFunc = rllib.func('char *readline(char *)'); const addHistoryFunc = rllib.func('int add_history(char *)'); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i "); if (line === null) { break; } if (line) { printer.println(rep(line)); } } } ================================================ FILE: impls/js/step1_read_print.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); } // read function READ(str) { return reader.read_str(str); } // eval function EVAL(ast, env) { return ast; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var re = function(str) { return EVAL(READ(str), {}); }; var rep = function(str) { return PRINT(EVAL(READ(str), {})); }; // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step2_eval.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); } // read function READ(str) { return reader.read_str(str); } // eval function _EVAL(ast, env) { // printer.println("EVAL:", printer._pr_str(ast, true)); // Non-list types. if (types._symbol_Q(ast)) { if (ast.value in env) { return env[ast.value]; } else { throw new Error("'" + ast.value + "' not found"); } } else if (types._list_Q(ast)) { // Exit this switch. } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[k] = EVAL(ast[k], env); } return new_hm; } else { return ast; } if (ast.length === 0) { return ast; } // apply list var f = EVAL(ast[0], env); var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); return f.apply(f, args); } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl repl_env = {}; var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; repl_env['+'] = function(a,b){return a+b;}; repl_env['-'] = function(a,b){return a-b;}; repl_env['*'] = function(a,b){return a*b;}; repl_env['/'] = function(a,b){return a/b;}; // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step3_env.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; } // read function READ(str) { return reader.read_str(str); } // eval function _EVAL(ast, env) { // Show a trace if DEBUG-EVAL is enabled. var dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv !== null) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval !== false) printer.println("EVAL:", printer._pr_str(ast, true)); } // Non-list types. if (types._symbol_Q(ast)) { return env.get(ast.value); } else if (types._list_Q(ast)) { // Exit this switch. } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[k] = EVAL(ast[k], env); } return new_hm; } else { return ast; } if (ast.length === 0) { return ast; } // apply list var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; switch (a0.value) { case "def!": var res = EVAL(a2, env); if (!a1.constructor || a1.constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } return env.set(a1.value, res); case "let*": var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } return EVAL(a2, let_env); default: var f = EVAL(a0, env); var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); return f.apply(f, args); } } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; repl_env.set('+', function(a,b){return a+b;}); repl_env.set('-', function(a,b){return a-b;}); repl_env.set('*', function(a,b){return a*b;}); repl_env.set('/', function(a,b){return a/b;}); // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step4_if_fn_do.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval function _EVAL(ast, env) { // Show a trace if DEBUG-EVAL is enabled. var dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv !== null) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval !== false) printer.println("EVAL:", printer._pr_str(ast, true)); } // Non-list types. if (types._symbol_Q(ast)) { return env.get(ast.value); } else if (types._list_Q(ast)) { // Exit this switch. } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[k] = EVAL(ast[k], env); } return new_hm; } else { return ast; } if (ast.length === 0) { return ast; } // apply list var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; switch (a0.value) { case "def!": var res = EVAL(a2, env); if (!a1.constructor || a1.constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } return env.set(a1.value, res); case "let*": var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } return EVAL(a2, let_env); case "do": for (var i=1; i < ast.length - 1; i++) { EVAL(ast[i], env); } return EVAL(ast[ast.length-1], env); case "if": var cond = EVAL(a1, env); if (cond === null || cond === false) { return typeof a3 !== "undefined" ? EVAL(a3, env) : null; } else { return EVAL(a2, env); } case "fn*": return function() { return EVAL(a2, new Env(env, a1, arguments)); }; default: var f = EVAL(a0, env); var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); return f.apply(f, args); } } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; // core.js: defined using javascript for (var n in core.ns) { repl_env.set(n, core.ns[n]); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step5_tco.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval function _EVAL(ast, env) { while (true) { // Show a trace if DEBUG-EVAL is enabled. var dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv !== null) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval !== false) printer.println("EVAL:", printer._pr_str(ast, true)); } // Non-list types. if (types._symbol_Q(ast)) { return env.get(ast.value); } else if (types._list_Q(ast)) { // Exit this switch. } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[k] = EVAL(ast[k], env); } return new_hm; } else { return ast; } if (ast.length === 0) { return ast; } // apply list var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; switch (a0.value) { case "def!": var res = EVAL(a2, env); if (!a1.constructor || a1.constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } return env.set(a1.value, res); case "let*": var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } ast = a2; env = let_env; break; case "do": for (var i=1; i < ast.length - 1; i++) { EVAL(ast[i], env); } ast = ast[ast.length-1]; break; case "if": var cond = EVAL(a1, env); if (cond === null || cond === false) { ast = (typeof a3 !== "undefined") ? a3 : null; } else { ast = a2; } break; case "fn*": return types._function(EVAL, Env, a2, env, a1); default: var f = EVAL(a0, env); var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); if (f.__ast__) { ast = f.__ast__; env = f.__gen_env__(args); } else { return f.apply(f, args); } } } } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; // core.js: defined using javascript for (var n in core.ns) { repl_env.set(n, core.ns[n]); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step6_file.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval function _EVAL(ast, env) { while (true) { // Show a trace if DEBUG-EVAL is enabled. var dbgevalenv = env.find("DEBUG-EVAL"); if (dbgevalenv !== null) { var dbgeval = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval !== false) printer.println("EVAL:", printer._pr_str(ast, true)); } // Non-list types. if (types._symbol_Q(ast)) { return env.get(ast.value); } else if (types._list_Q(ast)) { // Exit this switch. } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[k] = EVAL(ast[k], env); } return new_hm; } else { return ast; } if (ast.length === 0) { return ast; } // apply list var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; switch (a0.value) { case "def!": var res = EVAL(a2, env); if (!a1.constructor || a1.constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } return env.set(a1.value, res); case "let*": var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { if (!a1[i].constructor || a1[i].constructor.name !== 'Symbol') { throw new Error("env.get key must be a symbol") } let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } ast = a2; env = let_env; break; case "do": for (var i=1; i < ast.length - 1; i++) { EVAL(ast[i], env); } ast = ast[ast.length-1]; break; case "if": var cond = EVAL(a1, env); if (cond === null || cond === false) { ast = (typeof a3 !== "undefined") ? a3 : null; } else { ast = a2; } break; case "fn*": return types._function(EVAL, Env, a2, env, a1); default: var f = EVAL(a0, env); var args = ast.slice(1).map(function(a) { return EVAL(a, env); }); if (f.__ast__) { ast = f.__ast__; env = f.__gen_env__(args); } else { return f.apply(f, args); } } } } function EVAL(ast, env) { var result = _EVAL(ast, env); return (typeof result !== "undefined") ? result : null; } // print function PRINT(exp) { return printer._pr_str(exp, true); } // repl var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; // core.js: defined using javascript for (var n in core.ns) { repl_env.set(n, core.ns[n]); } repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); }); repl_env.set('*ARGV*', []); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step7_quote.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval 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 (elt), acc]; } } function quasiquote(ast) { if (types._list_Q(ast) && 0 2) { repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step8_macros.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval 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 (elt), acc]; } } function quasiquote(ast) { if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/step9_try.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval 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 (elt), acc]; } } function quasiquote(ast) { if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { repl_env.set(types._symbol('*ARGV*'), process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/stepA_mal.js ================================================ if (typeof module !== 'undefined') { var types = require('./types'); var readline = require('./node_readline'); var reader = require('./reader'); var printer = require('./printer'); var Env = require('./env').Env; var core = require('./core'); } // read function READ(str) { return reader.read_str(str); } // eval 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 (elt), acc]; } } function quasiquote(ast) { if (types._list_Q(ast) && 0 (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (typeof process !== 'undefined' && process.argv.length > 2) { repl_env.set('*ARGV*', process.argv.slice(3)); rep('(load-file "' + process.argv[2] + '")'); process.exit(0); } // repl loop if (typeof require !== 'undefined' && require.main === module) { // Synchronous node.js commandline mode rep("(println (str \"Mal [\" *host-language* \"]\"))"); while (true) { var line = readline.readline("user> "); if (line === null) { break; } try { if (line) { printer.println(rep(line)); } } catch (exc) { if (exc instanceof reader.BlankException) { continue } if (exc instanceof Error) { console.warn(exc.stack) } else { console.warn("Error: " + printer._pr_str(exc, true)) } } } } ================================================ FILE: impls/js/tests/common.js ================================================ fs = require('fs'); assert = require('assert'); function assert_eq(a, b) { GLOBAL.assert.deepEqual(a, b, a + " !== " + b); } function load(file) { console.log(process.cwd()); //process.chdir('../'); eval(fs.readFileSync(file,'utf8')); } exports.assert_eq = assert_eq; exports.load = load; ================================================ FILE: impls/js/tests/reader.js ================================================ common = require('./common.js'); types = require('../types'); reader = require('../reader'); core = require('../core'); var assert_eq = common.assert_eq, read_str = reader.read_str, nth = core.ns.nth; console.log("Testing read of constants/strings"); assert_eq(2,read_str('2')); assert_eq(12345,read_str('12345')); assert_eq(12345,read_str('12345 "abc"')); assert_eq('abc',read_str('"abc"')); assert_eq('a string (with parens)',read_str('"a string (with parens)"')); console.log("Testing read of symbols"); assert(types._symbol_Q(read_str('abc'))); assert_eq('abc',read_str('abc').value); assert_eq('.',read_str('.').value); console.log("Testing READ_STR of strings"); assert_eq('a string',read_str('"a string"')); assert_eq('a string (with parens)',read_str('"a string (with parens)"')); assert_eq('a string',read_str('"a string"()')); assert_eq('a string',read_str('"a string"123')); assert_eq('a string',read_str('"a string"abc')); assert_eq('',read_str('""')); assert_eq('abc ',read_str('"abc "')); assert_eq(' abc',read_str('" abc"')); assert_eq('$abc',read_str('"$abc"')); assert_eq('abc$()',read_str('"abc$()"')); assert_eq('"xyz"',read_str('"\\"xyz\\""')); console.log("Testing READ_STR of lists"); assert_eq(2,core.ns.count(read_str('(2 3)'))); assert_eq(2,core.ns.first(read_str('(2 3)'))); assert_eq(3,core.ns.first(core.ns.rest(read_str('(2 3)')))); L = read_str('(+ 1 2 "str1" "string (with parens) and \'single quotes\'")'); assert_eq(5,core.ns.count(L)); assert_eq('str1',nth(L,3)); assert_eq('string (with parens) and \'single quotes\'',nth(L,4)); assert_eq([2,3],read_str('(2 3)')); assert_eq([2,3, 'string (with parens)'],read_str('(2 3 "string (with parens)")')); console.log("Testing READ_STR of quote/quasiquote"); assert_eq('quote',nth(read_str('\'1'),0).value); assert_eq(1,nth(read_str('\'1'),1)); assert_eq('quote',nth(read_str('\'(1 2 3)'),0).value); assert_eq(3,nth(nth(read_str('\'(1 2 3)'),1),2)); assert_eq('quasiquote',nth(read_str('`1'),0).value); assert_eq(1,nth(read_str('`1'),1)); assert_eq('quasiquote',nth(read_str('`(1 2 3)'),0).value); assert_eq(3,nth(nth(read_str('`(1 2 3)'),1),2)); assert_eq('unquote',nth(read_str('~1'),0).value); assert_eq(1,nth(read_str('~1'),1)); assert_eq('unquote',nth(read_str('~(1 2 3)'),0).value); assert_eq(3,nth(nth(read_str('~(1 2 3)'),1),2)); assert_eq('splice-unquote',nth(read_str('~@1'),0).value); assert_eq(1,nth(read_str('~@1'),1)); assert_eq('splice-unquote',nth(read_str('~@(1 2 3)'),0).value); assert_eq(3,nth(nth(read_str('~@(1 2 3)'),1),2)); console.log("All tests completed"); ================================================ FILE: impls/js/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/js/tests/stepA_mal.mal ================================================ ;; Testing basic bash interop (js-eval "7") ;=>7 (js-eval "'7'") ;=>"7" (js-eval "[7,8,9]") ;=>(7 8 9) (js-eval "console.log('hello');") ;/hello ;=>nil (js-eval "foo=8;") (js-eval "foo;") ;=>8 (js-eval "['a','b','c'].map(function(x){return 'X'+x+'Y'}).join(' ')") ;=>"XaY XbY XcY" (js-eval "[1,2,3].map(function(x){return 1+x})") ;=>(2 3 4) (js-eval (str "3 * " (* 4 5))) ;=>60 (. "console.log" "abc" 123 '(4 5 6) {"kk" "vv"} (= 1 1) nil) ;/abc 123 \[ 4, 5, 6 \] \{ kk: 'vv' \} true null ;=>nil (js-eval "myobj = { v: 10, myfunc: function(a,b,c) { return a * b * c * this.v; } }") (. "myobj.myfunc" 2 3 4) ;=>240 (js-eval "myarray = [1,2,3,4,5]") (. "myarray.join" "#") ;=>"1#2#3#4#5" ================================================ FILE: impls/js/tests/types.js ================================================ common = require('./common.js'); var assert_eq = common.assert_eq; var types = require('../types.js'); var core = require('../core.js'); var env = require('../env.js'); var symbol = types._symbol, hash_map = core.ns['hash-map'], hash_map_Q = core.ns['map?'], assoc = core.ns['assoc'], dissoc = core.ns['dissoc'], get = core.ns['get'], contains_Q = core.ns['contains?'], count = core.ns['count'], equal_Q = core.ns['=']; console.log("Testing hash_maps"); X = hash_map(); assert_eq(true, hash_map_Q(X)); assert_eq(null, get(X,'a')); assert_eq(false, contains_Q(X, 'a')); X1 = assoc(X, 'a', "value of X a"); assert_eq(null, get(X,'a')); assert_eq(false, contains_Q(X, 'a')); assert_eq("value of X a", get(X1, 'a')); assert_eq(true, contains_Q(X1, 'a')); Y = hash_map(); assert_eq(0, count(Y)); Y1 = assoc(Y, 'a', "value of Y a"); assert_eq(1, count(Y1)); Y2 = assoc(Y1, 'b', "value of Y b"); assert_eq(2, count(Y2)); assert_eq("value of Y a", get(Y2, 'a')); assert_eq("value of Y b", get(Y2, 'b')); X2 = assoc(X1, 'b', Y2); assert_eq(2, count(Y2)); assert_eq(true, hash_map_Q(get(X2,'b'))); assert_eq('value of Y a', get(get(X2,'b'),'a')); assert_eq('value of Y b', get(get(X2,'b'),'b')); Y3 = dissoc(Y2, 'a'); assert_eq(2, count(Y2)); assert_eq(1, count(Y3)); assert_eq(null, get(Y3, 'a')); Y4 = dissoc(Y3, 'b'); assert_eq(0, count(Y4)); assert_eq(null, get(Y4, 'b')); console.log("Testing equal? function"); assert_eq(true, equal_Q(2,2)); assert_eq(false, equal_Q(2,3)); assert_eq(false, equal_Q(2,3)); assert_eq(true, equal_Q("abc","abc")); assert_eq(false, equal_Q("abc","abz")); assert_eq(false, equal_Q("zbc","abc")); assert_eq(true, equal_Q(symbol("abc"),symbol("abc"))); assert_eq(false, equal_Q(symbol("abc"),symbol("abz"))); assert_eq(false, equal_Q(symbol("zbc"),symbol("abc"))); L6 = [1, 2, 3]; L7 = [1, 2, 3]; L8 = [1, 2, "Z"]; L9 = ["Z", 2, 3]; L10 = [1, 2]; assert_eq(true, equal_Q(L6, L7)); assert_eq(false, equal_Q(L6, L8)); assert_eq(false, equal_Q(L6, L9)); assert_eq(false, equal_Q(L6, L10)); assert_eq(false, equal_Q(L10, L6)); console.log("Testing ENV (1 level)") env1 = new env.Env(); assert_eq('val_a',env1.set('a','val_a')); assert_eq('val_b',env1.set('b','val_b')); assert_eq('val_eq',env1.set('=','val_eq')); assert_eq('val_a',env1.get('a')); assert_eq('val_b',env1.get('b')); assert_eq('val_eq',env1.get('=')); console.log("Testing ENV (2 levels)"); env2 = new env.Env(env1); assert_eq('val_b2',env2.set('b','val_b2')); assert_eq('val_c',env2.set('c','val_c')); assert_eq(env1,env2.find('a')); assert_eq(env2,env2.find('b')); assert_eq(env2,env2.find('c')); assert_eq('val_a', env2.get('a')); assert_eq('val_b2',env2.get('b')); assert_eq('val_c', env2.get('c')); ================================================ FILE: impls/js/types.js ================================================ // Node vs browser behavior var types = {}; if (typeof module === 'undefined') { var exports = types; } // General functions function _obj_type(obj) { if (_symbol_Q(obj)) { return 'symbol'; } else if (_list_Q(obj)) { return 'list'; } else if (_vector_Q(obj)) { return 'vector'; } else if (_hash_map_Q(obj)) { return 'hash-map'; } else if (_nil_Q(obj)) { return 'nil'; } else if (_true_Q(obj)) { return 'true'; } else if (_false_Q(obj)) { return 'false'; } else if (_atom_Q(obj)) { return 'atom'; } else { switch (typeof(obj)) { case 'number': return 'number'; case 'function': return 'function'; case 'string': return obj[0] == '\u029e' ? 'keyword' : 'string'; default: throw new Error("Unknown type '" + typeof(obj) + "'"); } } } function _sequential_Q(lst) { return _list_Q(lst) || _vector_Q(lst); } function _equal_Q (a, b) { var ota = _obj_type(a), otb = _obj_type(b); if (!(ota === otb || (_sequential_Q(a) && _sequential_Q(b)))) { return false; } switch (ota) { case 'symbol': return a.value === b.value; case 'list': case 'vector': if (a.length !== b.length) { return false; } for (var i=0; i ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Julia RUN apt-get -y install software-properties-common RUN apt-add-repository -y ppa:staticfloat/juliareleases RUN apt-get update -y RUN apt-get -y install julia ================================================ FILE: impls/julia/Makefile ================================================ all: clean: ================================================ FILE: impls/julia/core.jl ================================================ module core import types import reader using printer import readline_mod export ns function string_Q(obj) isa(obj,AbstractString) && (length(obj) == 0 || obj[1] != '\u029e') end function keyword_Q(obj) isa(obj,AbstractString) && (length(obj) > 0 && obj[1] == '\u029e') end function concat(args...) res = [] for a=args res = [res; Any[a...]] end res end function do_apply(f, all_args...) fn = isa(f,types.MalFunc) ? f.fn : f args = concat(all_args[1:end-1], all_args[end]) fn(args...) end function do_map(a,b) # map and convert to array/list if isa(a,types.MalFunc) collect(map(a.fn,b)) else collect(map(a,b)) end end function conj(seq, args...) if isa(seq,Array) concat(reverse(args), seq) else tuple(concat(seq, args)...) end end function do_seq(obj) if isa(obj,Array) length(obj) > 0 ? obj : nothing elseif isa(obj,Tuple) length(obj) > 0 ? Any[obj...] : nothing elseif isa(obj,AbstractString) length(obj) > 0 ? [string(c) for c=obj] : nothing elseif obj == nothing nothing else error("seq: called on non-sequence") end end function with_meta(obj, meta) new_obj = types.copy(obj) new_obj.meta = meta new_obj end ns = Dict{Any,Any}( symbol("=") => (a,b) -> types.equal_Q(a, b), :throw => (a) -> throw(types.MalException(a)), symbol("nil?") => (a) -> a === nothing, symbol("true?") => (a) -> a === true, symbol("false?") => (a) -> a === false, symbol("string?") => string_Q, symbol("symbol") => (a) -> symbol(a), symbol("symbol?") => (a) -> typeof(a) === Symbol, symbol("keyword") => (a) -> a[1] == '\u029e' ? a : "\u029e$(a)", symbol("keyword?") => keyword_Q, symbol("number?") => (a) -> isa(a, AbstractFloat) || isa(a, Int64), symbol("fn?") => (a) -> isa(a, Function) || (isa(a, types.MalFunc) && !a.ismacro), symbol("macro?") => (a) -> isa(a, types.MalFunc) && a.ismacro, symbol("pr-str") => (a...) -> join(map((e)->pr_str(e, true),a)," "), :str => (a...) -> join(map((e)->pr_str(e, false),a),""), :prn => (a...) -> println(join(map((e)->pr_str(e, true),a)," ")), :println => (a...) -> println(join(map((e)->pr_str(e, false),a)," ")), symbol("read-string") => (a) -> reader.read_str(a), :readline => readline_mod.do_readline, :slurp => (a) -> readall(open(a)), :< => <, :<= => <=, :> => >, :>= => >=, :+ => +, :- => -, symbol("*") => *, :/ => div, symbol("time-ms") => () -> round(Int, time()*1000), :list => (a...) -> Any[a...], symbol("list?") => (a) -> isa(a, Array), :vector => (a...) -> tuple(a...), symbol("vector?") => (a) -> isa(a, Tuple), symbol("hash-map") => types.hash_map, symbol("map?") => (a) -> isa(a, Dict), :assoc => (a, b...) -> merge(a, types.hash_map(b...)), :dissoc => (a, b...) -> foldl((x,y) -> delete!(x,y),copy(a), b), :get => (a,b) -> a === nothing ? nothing : get(a,b,nothing), symbol("contains?") => haskey, :keys => (a) -> [keys(a)...], :vals => (a) -> [values(a)...], symbol("sequential?") => 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]...], symbol("empty?") => isempty, :count => (a) -> a == nothing ? 0 : length(a), :apply => do_apply, :map => do_map, :conj => conj, :seq => do_seq, :meta => (a) -> isa(a,types.MalFunc) ? a.meta : nothing, symbol("with-meta") => with_meta, :atom => (a) -> types.Atom(a), symbol("atom?") => (a) -> isa(a,types.Atom), :deref => (a) -> a.val, :reset! => (a,b) -> a.val = b, :swap! => (a,b,c...) -> a.val = do_apply(b, a.val, c), ) end ================================================ FILE: impls/julia/env.jl ================================================ module env export Env, env_set, env_find, env_get type Env outer::Any data::Dict{Symbol,Any} end function Env() Env(nothing, Dict()) end function Env(outer) Env(outer, Dict()) end function Env(outer, binds, exprs) e = Env(outer, Dict()) for i=1:length(binds) if binds[i] == :& e.data[binds[i+1]] = exprs[i:end] break else e.data[binds[i]] = exprs[i] end end e end function env_set(env::Env, k::Symbol, v) env.data[k] = v end function env_find(env::Env, k::Symbol) if haskey(env.data, k) env elseif env.outer != nothing env_find(env.outer, k) else nothing end end function env_get(env::Env, k::Symbol) e = env_find(env, k) if e != nothing e.data[k] else error("'$(string(k))' not found") end end end ================================================ FILE: impls/julia/printer.jl ================================================ module printer import types export pr_str function pr_str(obj, print_readably=true) _r = print_readably if isa(obj, Array) "($(join([pr_str(o, _r) for o=obj], " ")))" elseif isa(obj, Tuple) "[$(join([pr_str(o, _r) for o=obj], " "))]" elseif isa(obj, Dict) "{$(join(["$(pr_str(o[1],_r)) $(pr_str(o[2],_r))" for o=obj], " "))}" elseif isa(obj, AbstractString) if length(obj) > 0 && obj[1] == '\u029e' ":$(obj[3:end])" elseif _r str = replace(replace(replace(obj, "\\", "\\\\"), "\"", "\\\""), "\n", "\\n") "\"$(str)\"" else obj end elseif obj == nothing "nil" elseif typeof(obj) == types.MalFunc "(fn* $(pr_str(obj.params,true)) $(pr_str(obj.ast,true)))" elseif typeof(obj) == types.Atom "(atom $(pr_str(obj.val,true)))" elseif typeof(obj) == Function "#" else string(obj) end end end ================================================ FILE: impls/julia/reader.jl ================================================ module reader export read_str import types type Reader tokens position::Int64 end function next(rdr::Reader) if rdr.position > length(rdr.tokens) return nothing end rdr.position += 1 rdr.tokens[rdr.position-1] end function peek(rdr::Reader) if rdr.position > length(rdr.tokens) return nothing end rdr.tokens[rdr.position] end function tokenize(str) re = r"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;.*|[^\s\[\]{}('\"`,;)]*)" tokens = map((m) -> m.captures[1], eachmatch(re, str)) filter((t) -> t != "" && t[1] != ';', tokens) end function read_atom(rdr) token = next(rdr) if ismatch(r"^-?[0-9]+$", token) parse(Int,token) elseif ismatch(r"^-?[0-9][0-9.]*$", token) float(token) elseif ismatch(r"^\"(?:\\.|[^\\\"])*\"$", token) replace(token[2:end-1], r"\\.", (r) -> get(Dict("\\n"=>"\n", "\\\""=>"\"", "\\\\"=>"\\"), r, r)) elseif ismatch(r"^\".*$", token) error("expected '\"', got EOF") elseif token[1] == ':' "\u029e$(token[2:end])" elseif token == "nil" nothing elseif token == "true" true elseif token == "false" false else symbol(token) end end function read_list(rdr, start="(", last=")") ast = Any[] token = next(rdr) if (token != start) error("expected '$(start)'") end while ((token = peek(rdr)) != last) if token == nothing error("expected '$(last)', got EOF") end push!(ast, read_form(rdr)) end next(rdr) ast end function read_vector(rdr) lst = read_list(rdr, "[", "]") tuple(lst...) end function read_hash_map(rdr) lst = read_list(rdr, "{", "}") types.hash_map(lst...) end function read_form(rdr) token = peek(rdr) if token == "'" next(rdr) [[:quote]; Any[read_form(rdr)]] elseif token == "`" next(rdr) [[:quasiquote]; Any[read_form(rdr)]] elseif token == "~" next(rdr) [[:unquote]; Any[read_form(rdr)]] elseif token == "~@" next(rdr) [[symbol("splice-unquote")]; Any[read_form(rdr)]] elseif token == "^" next(rdr) meta = read_form(rdr) [[symbol("with-meta")]; Any[read_form(rdr)]; Any[meta]] elseif token == "@" next(rdr) [[symbol("deref")]; Any[read_form(rdr)]] elseif token == ")" error("unexpected ')'") elseif token == "(" read_list(rdr) elseif token == "]" error("unexpected ']'") elseif token == "[" read_vector(rdr) elseif token == "}" error("unexpected '}'") elseif token == "{" read_hash_map(rdr) else read_atom(rdr) end end function read_str(str) tokens = tokenize(str) if length(tokens) == 0 return nothing end read_form(Reader(tokens, 1)) end end ================================================ FILE: impls/julia/readline_mod.jl ================================================ module readline_mod export do_readline function do_readline(prompt) print(prompt) flush(STDOUT) line = readline(STDIN) if line == "" return nothing end chomp(line) end end ================================================ FILE: impls/julia/run ================================================ #!/usr/bin/env bash exec julia $(dirname $0)/${STEP:-stepA_mal}.jl "${@}" ================================================ FILE: impls/julia/step0_repl.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod # READ function READ(str) str end # EVAL function EVAL(ast, env) ast end # PRINT function PRINT(exp) exp end # REPL function REP(str) return PRINT(EVAL(READ(str), [])) end while true line = readline_mod.do_readline("user> ") if line === nothing break end println(REP(line)) end ================================================ FILE: impls/julia/step1_read_print.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) ast end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL function REP(str) return PRINT(EVAL(READ(str), [])) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end bt = catch_backtrace() Base.show_backtrace(STDERR, bt) println() end end ================================================ FILE: impls/julia/step2_eval.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) # println("EVAL: $(printer.pr_str(ast,true))") if typeof(ast) == Symbol return env[ast] elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = Dict{Any,Any}(:+ => +, :- => -, :* => *, :/ => div) function REP(str) return PRINT(EVAL(READ(str), repl_env)) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end bt = catch_backtrace() Base.show_backtrace(STDERR, bt) println() end end ================================================ FILE: impls/julia/step3_env.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply if :def! == ast[1] env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end EVAL(ast[3], let_env) else el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = Env(nothing, Dict{Any,Any}(:+ => +, :- => -, :* => *, :/ => div)) function REP(str) return PRINT(EVAL(READ(str), repl_env)) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end bt = catch_backtrace() Base.show_backtrace(STDERR, bt) println() end end ================================================ FILE: impls/julia/step4_if_fn_do.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply if :def! == ast[1] env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end EVAL(ast[3], let_env) elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end])[end] elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 EVAL(ast[4], env) else nothing end else EVAL(ast[3], env) end elseif symbol("fn*") == ast[1] (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])) else el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/step5_tco.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/step6_file.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") exit(0) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/step7_quote.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL 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 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 ast end end function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end if isempty(ast) return ast end # apply if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :quote == ast[1] return ast[2] elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") exit(0) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/step8_macros.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL 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 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 ast end end function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end # apply if isempty(ast) return ast end if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :quote == ast[1] return ast[2] elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop elseif :defmacro! == ast[1] func = EVAL(ast[3], env) func.ismacro = true return env_set(env, ast[2], func) elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else f = EVAL(ast[1], env) args = ast[2:end] if isa(f, MalFunc) && f.ismacro ast = f.fn(args...) continue # TCO loop end args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") exit(0) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/step9_try.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL 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 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 ast end end function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end # apply if isempty(ast) return ast end if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :quote == ast[1] return ast[2] elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop elseif :defmacro! == ast[1] func = EVAL(ast[3], env) func.ismacro = true return env_set(env, ast[2], func) elseif symbol("try*") == ast[1] try return EVAL(ast[2], env) catch exc e = string(exc) if isa(exc, MalException) e = exc.malval elseif isa(exc, ErrorException) e = exc.msg else e = string(e) end if length(ast) > 2 && ast[3][1] == symbol("catch*") return EVAL(ast[3][3], Env(env, Any[ast[3][2]], Any[e])) else rethrow(exc) end end elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else f = EVAL(ast[1], env) args = ast[2:end] if isa(f, MalFunc) && f.ismacro ast = f.fn(args...) continue # TCO loop end args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") exit(0) end while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/stepA_mal.jl ================================================ #!/usr/bin/env julia push!(LOAD_PATH, pwd(), "/usr/share/julia/base") import readline_mod import reader import printer using env import core using types # READ function READ(str) reader.read_str(str) end # EVAL 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 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 ast end end function EVAL(ast, env) while true dbgenv = env_find(env, Symbol("DEBUG-EVAL")) if dbgenv != nothing dbgeval = env_get(dbgenv, Symbol("DEBUG-EVAL")) if dbgeval !== nothing && dbgeval !== false println("EVAL: $(printer.pr_str(ast,true))") end end if typeof(ast) == Symbol return env_get(env,ast) elseif isa(ast, Tuple) return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) return [x[1] => EVAL(x[2], env) for x=ast] elseif !isa(ast, Array) return ast end # apply if isempty(ast) return ast end if :def! == ast[1] return env_set(env, ast[2], EVAL(ast[3], env)) elseif symbol("let*") == ast[1] let_env = Env(env) for i = 1:2:length(ast[2]) env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env)) end env = let_env ast = ast[3] # TCO loop elseif :quote == ast[1] return ast[2] elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop elseif :defmacro! == ast[1] func = EVAL(ast[3], env) func.ismacro = true return env_set(env, ast[2], func) elseif symbol("try*") == ast[1] try return EVAL(ast[2], env) catch exc e = string(exc) if isa(exc, MalException) e = exc.malval elseif isa(exc, ErrorException) e = exc.msg else e = string(e) end if length(ast) > 2 && ast[3][1] == symbol("catch*") return EVAL(ast[3][3], Env(env, Any[ast[3][2]], Any[e])) else rethrow(exc) end end elseif :do == ast[1] map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false if length(ast) >= 4 ast = ast[4] # TCO loop else return nothing end else ast = ast[3] # TCO loop end elseif symbol("fn*") == ast[1] return MalFunc( (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else f = EVAL(ast[1], env) args = ast[2:end] if isa(f, MalFunc) && f.ismacro ast = f.fn(args...) continue # TCO loop end args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) # TCO loop else return f(args...) end end end end # PRINT function PRINT(exp) printer.pr_str(exp) end # REPL repl_env = nothing function REP(str) return PRINT(EVAL(READ(str), repl_env)) end # core.jl: defined using Julia repl_env = Env(nothing, core.ns) env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env)) env_set(repl_env, symbol("*ARGV*"), ARGS[2:end]) # core.mal: defined using the language itself REP("(def! *host-language* \"julia\")") REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if length(ARGS) > 0 REP("(load-file \"$(ARGS[1])\")") exit(0) end REP("(println (str \"Mal [\" *host-language* \"]\"))") while true line = readline_mod.do_readline("user> ") if line === nothing break end try println(REP(line)) catch e if isa(e, ErrorException) println("Error: $(e.msg)") else println("Error: $(string(e))") end # TODO: show at least part of stack if !isa(e, StackOverflowError) bt = catch_backtrace() Base.show_backtrace(STDERR, bt) end println() end end ================================================ FILE: impls/julia/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 100000)) res1 ;=>nil ================================================ FILE: impls/julia/types.jl ================================================ module types export MalException, MalFunc, sequential_Q, equal_Q, hash_map, Atom import Base.copy type MalException <: Exception malval end type MalFunc fn::Function ast env params ismacro meta end # ismacro default to false function MalFunc(fn, ast, env, params) MalFunc(fn, ast, env, params, false, nothing) end function copy(f::MalFunc) MalFunc(f.fn, f.ast, f.env, f.params, f.ismacro, f.meta) end function sequential_Q(obj) isa(obj, Array) || isa(obj, Tuple) end function equal_Q(a, b) ota = typeof(a) otb = typeof(b) if !(ota === otb || (sequential_Q(a) && sequential_Q(b))) return false end if sequential_Q(a) if length(a) !== length(b) return false end for (x, y) in zip(a,b) if !equal_Q(x, y) return false end end return true elseif isa(a,AbstractString) a == b elseif isa(a,Dict) if length(a) !== length(b) return false end for (k,v) in a if !equal_Q(v,b[k]) return false end end return true else a === b end end function hash_map(lst...) hm = Dict() for i = 1:2:length(lst) hm[lst[i]] = lst[i+1] end hm end type Atom val end end ================================================ FILE: impls/kotlin/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Java and Zip RUN apt-get -y install openjdk-8-jdk RUN apt-get -y install unzip RUN curl -O -J -L https://github.com/JetBrains/kotlin/releases/download/v1.0.6/kotlin-compiler-1.0.6.zip RUN mkdir -p /kotlin-compiler RUN unzip kotlin-compiler-1.0.6.zip -d /kotlin-compiler ENV KOTLIN_HOME /kotlin-compiler/kotlinc ENV PATH $KOTLIN_HOME/bin:$PATH ================================================ FILE: impls/kotlin/Makefile ================================================ SOURCES_BASE = reader.kt printer.kt types.kt env.kt core.kt readline.kt SOURCES_LISP = step0_repl.kt step1_read_print.kt step2_eval.kt step3_env.kt step4_if_fn_do.kt \ step5_tco.kt step6_file.kt step7_quote.kt step8_macros.kt step9_try.kt stepA_mal.kt JARS = $(SOURCES_LISP:%.kt=%.jar) all: $(JARS) dist: mal.jar mal mal.jar: stepA_mal.jar cp $< $@ SHELL := bash mal: mal.jar cat <(echo -e '#!/bin/sh\nexec java -jar "$$0" "$$@"') mal.jar > $@ chmod +x mal clean: rm -vf $(JARS) mal.jar mal $(JARS): %.jar: src/mal/%.kt $(SOURCES_BASE:%.kt=src/mal/%.kt) kotlinc src/mal/$(@:%.jar=%.kt) $(SOURCES_BASE:%.kt=src/mal/%.kt) -include-runtime -d $@ ================================================ FILE: impls/kotlin/run ================================================ #!/usr/bin/env bash exec java -jar $(dirname $0)/${STEP:-stepA_mal}.jar "${@}" ================================================ FILE: impls/kotlin/src/mal/core.kt ================================================ package mal import java.io.File import java.util.* val ns = hashMapOf( envPair("+", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) }), envPair("-", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) }), envPair("*", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) }), envPair("/", { a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) }), envPair("list", { a: ISeq -> MalList(a) }), envPair("list?", { a: ISeq -> if (a.first() is MalList) TRUE else FALSE }), envPair("empty?", { a: ISeq -> if (a.first() !is ISeq || !(a.first() as ISeq).seq().any()) TRUE else FALSE }), envPair("count", { a: ISeq -> if (a.first() is ISeq) MalInteger((a.first() as ISeq).count().toLong()) else MalInteger(0) }), envPair("=", { a: ISeq -> pairwiseEquals(a) }), envPair("<", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value < y.value }) }), envPair("<=", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value <= y.value }) }), envPair(">", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value > y.value }) }), envPair(">=", { a: ISeq -> pairwiseCompare(a, { x, y -> x.value >= y.value }) }), envPair("pr-str", { a: ISeq -> MalString(a.seq().map({ it -> pr_str(it, print_readably = true) }).joinToString(" ")) }), envPair("str", { a: ISeq -> MalString(a.seq().map({ it -> pr_str(it, print_readably = false) }).joinToString("")) }), envPair("prn", { a: ISeq -> println(a.seq().map({ it -> pr_str(it, print_readably = true) }).joinToString(" ")) NIL }), envPair("println", { a: ISeq -> println(a.seq().map({ it -> pr_str(it, print_readably = false) }).joinToString(" ")) NIL }), envPair("read-string", { a: ISeq -> val string = a.first() as? MalString ?: throw MalException("slurp requires a string parameter") read_str(string.value) }), envPair("slurp", { a: ISeq -> val name = a.first() as? MalString ?: throw MalException("slurp requires a filename parameter") val text = File(name.value).readText() MalString(text) }), envPair("cons", { a: ISeq -> val list = a.nth(1) as? ISeq ?: throw MalException("cons requires a list as its second parameter") val mutableList = list.seq().toCollection(LinkedList()) mutableList.addFirst(a.nth(0)) 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") if (index.value >= list.count()) throw MalException("index out of bounds") list.nth(index.value.toInt()) }), envPair("first", { a: ISeq -> if (a.nth(0) == NIL) NIL else { val list = a.nth(0) as? ISeq ?: throw MalException("first requires a list parameter") if (list.seq().any()) list.first() else NIL } }), envPair("rest", { a: ISeq -> if (a.nth(0) == NIL) MalList() else { val list = a.nth(0) as? ISeq ?: throw MalException("rest requires a list parameter") MalList(list.rest()) } }), envPair("throw", { a: ISeq -> val throwable = a.nth(0) throw MalCoreException(pr_str(throwable), throwable) }), envPair("apply", { a: ISeq -> val function = a.nth(0) as MalFunction val params = MalList() a.seq().drop(1).forEach({ it -> if (it is ISeq) { it.seq().forEach({ x -> params.conj_BANG(x) }) } else { params.conj_BANG(it) } }) function.apply(params) }), envPair("map", { a: ISeq -> val function = a.nth(0) as MalFunction MalList((a.nth(1) as ISeq).seq().map({ it -> val params = MalList() params.conj_BANG(it) function.apply(params) }).toCollection(LinkedList())) }), envPair("nil?", { a: ISeq -> if (a.nth(0) == NIL) TRUE else FALSE }), envPair("true?", { a: ISeq -> if (a.nth(0) == TRUE) TRUE else FALSE }), envPair("false?", { a: ISeq -> if (a.nth(0) == FALSE) TRUE else FALSE }), envPair("string?", { a: ISeq -> if (a.nth(0) is MalString && !(a.nth(0) is MalKeyword)) TRUE else FALSE }), envPair("symbol?", { a: ISeq -> if (a.nth(0) is MalSymbol) TRUE else FALSE }), envPair("symbol", { a: ISeq -> MalSymbol((a.nth(0) as MalString).value) }), envPair("keyword", { a: ISeq -> val param = a.nth(0) if (param is MalKeyword) param else MalKeyword((a.nth(0) as MalString).value) }), envPair("keyword?", { a: ISeq -> if (a.nth(0) is MalKeyword) TRUE else FALSE }), envPair("number?", { a: ISeq -> if (a.nth(0) is MalInteger) TRUE else FALSE }), envPair("fn?", { a: ISeq -> if ((a.nth(0) as? MalFunction)?.is_macro ?: true) FALSE else TRUE }), envPair("macro?", { a: ISeq -> if ((a.nth(0) as? MalFunction)?.is_macro ?: false) TRUE else FALSE }), envPair("vector", { a: ISeq -> MalVector(a) }), envPair("vector?", { a: ISeq -> if (a.nth(0) is MalVector) TRUE else FALSE }), envPair("hash-map", { a: ISeq -> val map = MalHashMap() pairwise(a).forEach({ it -> map.assoc_BANG(it.first as MalString, it.second) }) map }), envPair("map?", { a: ISeq -> if (a.nth(0) is MalHashMap) TRUE else FALSE }), envPair("assoc", { a: ISeq -> val map = MalHashMap(a.first() as MalHashMap) pairwise(a.rest()).forEach({ it -> map.assoc_BANG(it.first as MalString, it.second) }) map }), envPair("dissoc", { a: ISeq -> val map = MalHashMap(a.first() as MalHashMap) a.rest().seq().forEach({ it -> map.dissoc_BANG(it as MalString) }) map }), envPair("get", { a: ISeq -> val map = a.nth(0) as? MalHashMap val key = a.nth(1) as MalString map?.elements?.get(key) ?: NIL }), envPair("contains?", { a: ISeq -> val map = a.nth(0) as? MalHashMap val key = a.nth(1) as MalString if (map?.elements?.get(key) != null) TRUE else FALSE }), envPair("keys", { a: ISeq -> val map = a.nth(0) as MalHashMap MalList(map.elements.keys.toCollection(LinkedList())) }), envPair("vals", { a: ISeq -> val map = a.nth(0) as MalHashMap MalList(map.elements.values.toCollection(LinkedList())) }), envPair("count", { a: ISeq -> val seq = a.nth(0) as? ISeq if (seq != null) MalInteger(seq.count().toLong()) else ZERO }), envPair("sequential?", { a: ISeq -> if (a.nth(0) is ISeq) TRUE else FALSE }), envPair("with-meta", { a: ISeq -> val obj = a.nth(0) val metadata = a.nth(1) obj.with_meta(metadata) }), envPair("meta", { a: ISeq -> a.first().metadata }), envPair("conj", { a: ISeq -> (a.first() as ISeq).conj(a.rest()) }), envPair("seq", { a: ISeq -> val obj = a.nth(0) if (obj is ISeq) { if (obj.count() == 0) NIL else MalList(obj.seq().toCollection(LinkedList())) } else if (obj is MalString && !(obj is MalKeyword)) { if (obj.value.length == 0) NIL else { var strs = obj.value.map({ c -> MalString(c.toString()) }) MalList(strs.toCollection(LinkedList())) } } else { NIL } }), envPair("atom", { a: ISeq -> MalAtom(a.first()) }), envPair("atom?", { a: ISeq -> if (a.first() is MalAtom) TRUE else FALSE }), envPair("deref", { a: ISeq -> (a.first() as MalAtom).value }), envPair("reset!", { a: ISeq -> val atom = a.nth(0) as MalAtom val value = a.nth(1) atom.value = value value }), envPair("swap!", { a: ISeq -> val atom = a.nth(0) as MalAtom val function = a.nth(1) as MalFunction val params = MalList() params.conj_BANG(atom.value) a.seq().drop(2).forEach({ it -> params.conj_BANG(it) }) val value = function.apply(params) atom.value = value value }), envPair("readline", { a: ISeq -> val prompt = a.first() as MalString try { MalString(readline(prompt.value)) } catch (e: java.io.IOException) { throw MalException(e.message) } catch (e: EofException) { NIL } }), envPair("time-ms", { a: ISeq -> MalInteger(System.currentTimeMillis()) }) ) private fun envPair(k: String, v: (ISeq) -> MalType): Pair = Pair(MalSymbol(k), MalFunction(v)) private fun pairwise(s: ISeq): List> { val (keys, vals) = s.seq().withIndex().partition({ it -> it.index % 2 == 0 }) return keys.map({ it -> it.value }).zip(vals.map({ it -> it.value })) } private fun pairwiseCompare(s: ISeq, pred: (MalInteger, MalInteger) -> Boolean): MalConstant = if (pairwise(s).all({ it -> pred(it.first as MalInteger, it.second as MalInteger) })) TRUE else FALSE private fun pairwiseEquals(s: ISeq): MalConstant = if (pairwise(s).all({ it -> it.first == it.second })) TRUE else FALSE ================================================ FILE: impls/kotlin/src/mal/env.kt ================================================ package mal import java.util.* class Env(val outer: Env?, binds: Sequence?, exprs: Sequence?) { val data = HashMap() init { if (binds != null && exprs != null) { val itb = binds.iterator() val ite = exprs.iterator() while (itb.hasNext()) { val b = itb.next() if (b.value != "&") { set(b, if (ite.hasNext()) ite.next() else NIL) } else { if (!itb.hasNext()) throw MalException("expected a symbol name for varargs") set(itb.next(), MalList(ite.asSequence().toCollection(LinkedList()))) break } } } } constructor() : this(null, null, null) constructor(outer: Env?) : this(outer, null, null) fun set(key: MalSymbol, value: MalType): MalType { data.put(key.value, value) return value } fun get(key: String): MalType? = data[key] ?: outer?.get(key) } ================================================ FILE: impls/kotlin/src/mal/printer.kt ================================================ package mal fun pr_str(malType: MalType, print_readably: Boolean = false): String = when (malType) { is MalInteger -> malType.value.toString() is MalKeyword -> ":" + malType.value.substring(1) is MalString -> if (print_readably) { "\"" + malType.value.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") + "\"" } else malType.value is MalConstant -> malType.value is MalSymbol -> malType.value is MalFunction -> "#" + malType is MalCoreException -> pr_str(malType.value, print_readably) is MalException -> "\"" + (malType.message ?: "exception") + "\"" is MalList -> pr_str(malType.elements, "(", ")", print_readably) is MalVector -> pr_str(malType.elements, "[", "]", print_readably) is MalHashMap -> malType.elements.map({ it -> pr_str(it, print_readably) }).joinToString(" ", "{", "}") is MalAtom -> "(atom " + pr_str(malType.value, print_readably) + ")" else -> throw MalPrinterException("Unrecognized MalType: " + malType) } private fun pr_str(coll: Collection, start: String, end: String, print_readably: Boolean = false): String = coll.map({ it -> pr_str(it, print_readably) }).joinToString(" ", start, end) private fun pr_str(mapEntry: Map.Entry, print_readably: Boolean = false): String = pr_str(mapEntry.key, print_readably) + " " + pr_str(mapEntry.value, print_readably) ================================================ FILE: impls/kotlin/src/mal/reader.kt ================================================ package mal import kotlin.text.Regex val TOKEN_REGEX = Regex("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") val ATOM_REGEX = Regex("(^-?[0-9]+$)|(^nil$)|(^true$)|(^false$)|^\"((?:\\\\.|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)") class Reader(sequence: Sequence) { val tokens = sequence.iterator() var current = advance() fun next(): String? { var result = current current = advance() return result } fun peek(): String? = current private fun advance(): String? = if (tokens.hasNext()) tokens.next() else null } fun read_str(input: String?): MalType { val tokens = tokenizer(input) ?: return NIL return read_form(Reader(tokens)) } fun tokenizer(input: String?): Sequence? { if (input == null) return null return TOKEN_REGEX.findAll(input) .map({ it -> it.groups[1]?.value as String }) .filter({ it != "" && !it.startsWith(";")}) } fun read_form(reader: Reader): MalType = when (reader.peek()) { null -> throw MalContinue() "(" -> read_list(reader) ")" -> throw MalReaderException("expected form, got ')'") "[" -> read_vector(reader) "]" -> throw MalReaderException("expected form, got ']'") "{" -> read_hashmap(reader) "}" -> throw MalReaderException("expected form, got '}'") "'" -> read_shorthand(reader, "quote") "`" -> read_shorthand(reader, "quasiquote") "~" -> read_shorthand(reader, "unquote") "~@" -> read_shorthand(reader, "splice-unquote") "^" -> read_with_meta(reader) "@" -> read_shorthand(reader, "deref") else -> read_atom(reader) } fun read_list(reader: Reader): MalType = read_sequence(reader, MalList(), ")") fun read_vector(reader: Reader): MalType = read_sequence(reader, MalVector(), "]") private fun read_sequence(reader: Reader, sequence: IMutableSeq, end: String): MalType { reader.next() do { val form = when (reader.peek()) { null -> throw MalReaderException("expected '$end', got EOF") end -> { reader.next(); null } else -> read_form(reader) } if (form != null) { sequence.conj_BANG(form) } } while (form != null) return sequence } fun read_hashmap(reader: Reader): MalType { reader.next() val hashMap = MalHashMap() do { var value : MalType? = null; val key = when (reader.peek()) { null -> throw MalReaderException("expected '}', got EOF") "}" -> { reader.next(); null } else -> { var key = read_form(reader) if (key !is MalString) { throw MalReaderException("hash-map keys must be strings or keywords") } value = when (reader.peek()) { null -> throw MalReaderException("expected form, got EOF") else -> read_form(reader) } key } } if (key != null) { hashMap.assoc_BANG(key, value as MalType) } } while (key != null) return hashMap } fun read_shorthand(reader: Reader, symbol: String): MalType { reader.next() val list = MalList() list.conj_BANG(MalSymbol(symbol)) list.conj_BANG(read_form(reader)) return list } fun read_with_meta(reader: Reader): MalType { reader.next() val meta = read_form(reader) val obj = read_form(reader) val list = MalList() list.conj_BANG(MalSymbol("with-meta")) list.conj_BANG(obj) list.conj_BANG(meta) return list } fun read_atom(reader: Reader): MalType { val next = reader.next() ?: throw MalReaderException("Unexpected null token") val groups = ATOM_REGEX.find(next)?.groups ?: throw MalReaderException("Unrecognized token: " + next) return if (groups[1]?.value != null) { MalInteger(groups[1]?.value?.toLong() ?: throw MalReaderException("Error parsing number: " + next)) } else if (groups[2]?.value != null) { NIL } else if (groups[3]?.value != null) { TRUE } else if (groups[4]?.value != null) { FALSE } else if (groups[5]?.value != null) { MalString((groups[5]?.value as String).replace(Regex("""\\(.)""")) { m: MatchResult -> if (m.groups[1]?.value == "n") "\n" else m.groups[1]?.value.toString() }) } else if (groups[6]?.value != null) { throw MalReaderException("expected '\"', got EOF") } else if (groups[7]?.value != null) { MalKeyword(groups[7]?.value as String) } else if (groups[8]?.value != null) { MalSymbol(groups[8]?.value as String) } else { throw MalReaderException("Unrecognized token: " + next) } } ================================================ FILE: impls/kotlin/src/mal/readline.kt ================================================ package mal class EofException : Exception("EOF") fun readline(prompt: String): String { print(prompt) return readLine() ?: throw EofException() } ================================================ FILE: impls/kotlin/src/mal/step0_repl.kt ================================================ package mal fun main(args: Array) { fun read(input: String?): String? = input fun eval(expression: String?): String? = expression fun print(result: String?): String? = result while (true) { val input = readline("user> ") try { println(print(eval(read(input)))) } catch (e: EofException) { break } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) } } } ================================================ FILE: impls/kotlin/src/mal/step1_read_print.kt ================================================ package mal fun main(args: Array) { fun read(input: String?): MalType = read_str(input) fun eval(expression: MalType): MalType = expression fun print(result: MalType) = pr_str(result, print_readably = true) while (true) { val input = readline("user> ") try { println(print(eval(read(input)))) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) } } } ================================================ FILE: impls/kotlin/src/mal/step2_eval.kt ================================================ package mal fun read(input: String?): MalType = read_str(input) fun eval(ast: MalType, env: Map): MalType { // println ("EVAL: ${print(ast)}") when (ast) { is MalList -> { if (ast.count() == 0) return ast val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") return (evaluated.first() as MalFunction).apply(evaluated.rest()) } is MalSymbol -> return env[ast.value] ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } fun print(result: MalType) = pr_str(result, print_readably = true) fun main(args: Array) { val env = hashMapOf( Pair("+", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) })), Pair("-", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) })), Pair("*", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) })), Pair("/", MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) })) ) while (true) { val input = readline("user> ") try { println(print(eval(read(input), env))) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) } } } ================================================ FILE: impls/kotlin/src/mal/step3_env.kt ================================================ package mal fun read(input: String?): MalType = read_str(input) fun eval(ast: MalType, env: Env): MalType { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast val first = ast.first() if (first is MalSymbol && first.value == "def!") { return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) } else if (first is MalSymbol && first.value == "let*") { val child = Env(env) val bindings = ast.nth(1) if (bindings !is ISeq) throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") val value = eval(it.next(), child) child.set(key as MalSymbol, value) } return eval(ast.nth(2), child) } else { val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") return (evaluated.first() as MalFunction).apply(evaluated.rest()) } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } fun print(result: MalType) = pr_str(result, print_readably = true) fun main(args: Array) { val env = Env() env.set(MalSymbol("+"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger + y as MalInteger }) })) env.set(MalSymbol("-"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger - y as MalInteger }) })) env.set(MalSymbol("*"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger * y as MalInteger }) })) env.set(MalSymbol("/"), MalFunction({ a: ISeq -> a.seq().reduce({ x, y -> x as MalInteger / y as MalInteger }) })) while (true) { val input = readline("user> ") try { println(print(eval(read(input), env))) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) } } } ================================================ FILE: impls/kotlin/src/mal/step4_if_fn_do.kt ================================================ package mal fun read(input: String?): MalType = read_str(input) fun eval(ast: MalType, env: Env): MalType { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast val first = ast.first() if (first is MalSymbol) { when (first.value) { "def!" -> return eval_def_BANG(ast, env) "let*" -> return eval_let_STAR(ast, env) "fn*" -> return eval_fn_STAR(ast, env) "do" -> return eval_do(ast, env) "if" -> return eval_if(ast, env) } } return eval_function_call(ast, env) } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } private fun eval_def_BANG(ast: ISeq, env: Env): MalType = env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) private fun eval_let_STAR(ast: ISeq, env: Env): MalType { val child = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") val value = eval(it.next(), child) child.set(key as MalSymbol, value) } return eval(ast.nth(2), child) } private fun eval_fn_STAR(ast: ISeq, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val symbols = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFunction({ s: ISeq -> eval(body, Env(env, symbols, s.seq())) }) } private fun eval_do(ast: ISeq, env: Env): MalType { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } return eval(ast.seq().last(), env) } private fun eval_if(ast: ISeq, env: Env): MalType { val check = eval(ast.nth(1), env) return if (check != NIL && check != FALSE) { eval(ast.nth(2), env) } else if (ast.count() > 3) { eval(ast.nth(3), env) } else NIL } private fun eval_function_call(ast: MalList, env: Env): MalType { val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val first = evaluated.first() as? MalFunction ?: throw MalException("cannot execute non-function") return first.apply(evaluated.rest()) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) rep("(def! not (fn* (a) (if a false true)))", repl_env) while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/step5_tco.kt ================================================ package mal fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } else -> { val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val firstEval = evaluated.first() when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) } is MalFunction -> return firstEval.apply(evaluated.rest()) else -> throw MalException("cannot execute non-function") } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) rep("(def! not (fn* (a) (if a false true)))", repl_env) while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/step6_file.kt ================================================ package mal import java.util.* fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } else -> { val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val firstEval = evaluated.first() when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) } is MalFunction -> return firstEval.apply(evaluated.rest()) else -> throw MalException("cannot execute non-function") } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) rep("(def! not (fn* (a) (if a false true)))", repl_env) rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if (args.any()) { rep("(load-file \"${args[0]}\")", repl_env) return } while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/step7_quote.kt ================================================ package mal import java.util.* fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } "quote" -> return ast.nth(1) "quasiquote" -> ast = quasiquote(ast.nth(1)) else -> { val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val firstEval = evaluated.first() when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) } is MalFunction -> return firstEval.apply(evaluated.rest()) else -> throw MalException("cannot execute non-function") } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } private fun quasiquote(ast: MalType): MalType { 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 } } 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)) } result.conj_BANG(acc) return result } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) rep("(def! not (fn* (a) (if a false true)))", repl_env) rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if (args.any()) { rep("(load-file \"${args[0]}\")", repl_env) return } while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/step8_macros.kt ================================================ package mal import java.util.* fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } "quote" -> return ast.nth(1) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) else -> { val firstEval = eval(ast.first(), env) if (firstEval is MalFunction && firstEval.is_macro) { ast = firstEval.apply(ast.rest()) } else { val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, args.seq()) } is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } private fun quasiquote(ast: MalType): MalType { 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 } } 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)) } result.conj_BANG(acc) return result } private fun defmacro(ast: MalList, env: Env): MalType { val macro = eval(ast.nth(2), env) as MalFunction macro.is_macro = true return env.set(ast.nth(1) as MalSymbol, macro) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) rep("(def! not (fn* (a) (if a false true)))", repl_env) rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (args.any()) { rep("(load-file \"${args[0]}\")", repl_env) return } while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/step9_try.kt ================================================ package mal import java.util.* fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } "quote" -> return ast.nth(1) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) "try*" -> return try_catch(ast, env) else -> { val firstEval = eval(ast.first(), env) if (firstEval is MalFunction && firstEval.is_macro) { ast = firstEval.apply(ast.rest()) } else { val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, args.seq()) } is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } private fun quasiquote(ast: MalType): MalType { 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 } } 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)) } result.conj_BANG(acc) return result } private fun defmacro(ast: MalList, env: Env): MalType { val macro = eval(ast.nth(2), env) as MalFunction macro.is_macro = true return env.set(ast.nth(1) as MalSymbol, macro) } private fun try_catch(ast: MalList, env: Env): MalType = try { eval(ast.nth(1), env) } catch (e: Exception) { if (ast.count() < 3) { throw e } val thrown = if (e is MalException) e else MalException(e.message) val symbol = (ast.nth(2) as MalList).nth(1) as MalSymbol val catchBody = (ast.nth(2) as MalList).nth(2) val catchEnv = Env(env) catchEnv.set(symbol, thrown) eval(catchBody, catchEnv) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) rep("(def! not (fn* (a) (if a false true)))", repl_env) rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (args.any()) { rep("(load-file \"${args[0]}\")", repl_env) return } while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/stepA_mal.kt ================================================ package mal import java.util.* fun read(input: String?): MalType = read_str(input) fun eval(_ast: MalType, _env: Env): MalType { var ast = _ast var env = _env while (true) { val dbgeval = env.get("DEBUG-EVAL") if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { println ("EVAL: ${print(ast)}") } when (ast) { is MalList -> { if (ast.count() == 0) return ast when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) val bindings = ast.nth(1) as? ISeq ?: throw MalException("expected sequence as the first parameter to let*") val it = bindings.seq().iterator() while (it.hasNext()) { val key = it.next() if (!it.hasNext()) throw MalException("odd number of binding elements in let*") childEnv.set(key as MalSymbol, eval(it.next(), childEnv)) } env = childEnv ast = ast.nth(2) } "fn*" -> return fn_STAR(ast, env) "do" -> { for (i in 1..ast.count() - 2) { eval(ast.nth(i), env) } ast = ast.seq().last() } "if" -> { val check = eval(ast.nth(1), env) if (check !== NIL && check !== FALSE) { ast = ast.nth(2) } else if (ast.count() > 3) { ast = ast.nth(3) } else return NIL } "quote" -> return ast.nth(1) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) "try*" -> return try_catch(ast, env) else -> { val firstEval = eval(ast.first(), env) if (firstEval is MalFunction && firstEval.is_macro) { ast = firstEval.apply(ast.rest()) } else { val args = ast.elements.drop(1).fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) when (firstEval) { is MalFnFunction -> { ast = firstEval.ast env = Env(firstEval.env, firstEval.params, args.seq()) } is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } } } } } is MalSymbol -> return env.get(ast.value) ?: throw MalException("'${ast.value}' not found") is MalVector -> return ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> return ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> return ast } } } private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") val params = binds.seq().filterIsInstance() val body = ast.nth(2) return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } private fun quasiquote(ast: MalType): MalType { 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 } } 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)) } result.conj_BANG(acc) return result } private fun defmacro(ast: MalList, env: Env): MalType { val f = eval(ast.nth(2), env) as MalFunction val macro = MalFunction(f.lambda) macro.is_macro = true return env.set(ast.nth(1) as MalSymbol, macro) } private fun try_catch(ast: MalList, env: Env): MalType = try { eval(ast.nth(1), env) } catch (e: Exception) { if (ast.count() < 3) { throw e } val thrown = if (e is MalException) e else MalException(e.message) val symbol = (ast.nth(2) as MalList).nth(1) as MalSymbol val catchBody = (ast.nth(2) as MalList).nth(2) val catchEnv = Env(env) catchEnv.set(symbol, thrown) eval(catchBody, catchEnv) } fun print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = print(eval(read(input), env)) fun main(args: Array) { val repl_env = Env() ns.forEach({ it -> repl_env.set(it.key, it.value) }) repl_env.set(MalSymbol("*host-language*"), MalString("kotlin")) repl_env.set(MalSymbol("*ARGV*"), MalList(args.drop(1).map({ it -> MalString(it) }).toCollection(LinkedList()))) repl_env.set(MalSymbol("eval"), MalFunction({ a: ISeq -> eval(a.first(), repl_env) })) rep("(def! not (fn* (a) (if a false true)))", repl_env) rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if (args.any()) { rep("(load-file \"${args[0]}\")", repl_env) return } rep("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) while (true) { val input = readline("user> ") try { println(rep(input, repl_env)) } catch (e: EofException) { break } catch (e: MalContinue) { } catch (e: MalException) { println("Error: " + e.message) } catch (t: Throwable) { println("Uncaught " + t + ": " + t.message) t.printStackTrace() } } } ================================================ FILE: impls/kotlin/src/mal/types.kt ================================================ package mal import java.util.* open class MalException(message: String?) : Exception(message), MalType { override var metadata: MalType = NIL override fun with_meta(meta: MalType): MalType { val exception = MalException(message) exception.metadata = meta return exception } } class MalContinue() : MalException("continue") class MalReaderException(message: String) : MalException(message) class MalPrinterException(message: String) : MalException(message) class MalCoreException(message: String, val value: MalType) : MalException(message) { override fun with_meta(meta: MalType): MalType { val exception = MalCoreException(message as String, value) exception.metadata = meta return exception } } interface MalType { var metadata: MalType fun with_meta(meta: MalType): MalType } open class MalConstant(val value: String) : MalType { override var metadata: MalType = NIL override fun equals(other: Any?): Boolean = other is MalConstant && value.equals(other.value) override fun hashCode(): Int = value.hashCode() override fun with_meta(meta: MalType): MalType { val obj = MalConstant(value) obj.metadata = meta return obj } } class MalInteger(val value: Long) : MalType { override var metadata: MalType = NIL operator fun plus(a: MalInteger): MalInteger = MalInteger(value + a.value) operator fun minus(a: MalInteger): MalInteger = MalInteger(value - a.value) operator fun times(a: MalInteger): MalInteger = MalInteger(value * a.value) operator fun div(a: MalInteger): MalInteger = MalInteger(value / a.value) operator fun compareTo(a: MalInteger): Int = value.compareTo(a.value) override fun equals(other: Any?): Boolean = other is MalInteger && value.equals(other.value) override fun with_meta(meta: MalType): MalType { val obj = MalInteger(value) obj.metadata = meta return obj } } class MalSymbol(val value: String) : MalType { override var metadata: MalType = NIL override fun equals(other: Any?): Boolean = other is MalSymbol && value.equals(other.value) override fun with_meta(meta: MalType): MalType { val obj = MalSymbol(value) obj.metadata = meta return obj } } open class MalString(value: String) : MalConstant(value) { override fun with_meta(meta: MalType): MalType { val obj = MalString(value) obj.metadata = meta return obj } } class MalKeyword(value: String) : MalString("\u029E" + value) { override fun with_meta(meta: MalType): MalType { val obj = MalKeyword(value) obj.metadata = meta return obj } } interface ILambda : MalType { fun apply(seq: ISeq): MalType } open class MalFunction(val lambda: (ISeq) -> MalType) : MalType, ILambda { var is_macro: Boolean = false override var metadata: MalType = NIL override fun apply(seq: ISeq): MalType = lambda(seq) override fun with_meta(meta: MalType): MalType { val obj = MalFunction(lambda) obj.metadata = meta return obj } } class MalFnFunction(val ast: MalType, val params: Sequence, val env: Env, lambda: (ISeq) -> MalType) : MalFunction(lambda) { override fun with_meta(meta: MalType): MalType { val obj = MalFnFunction(ast, params, env, lambda) obj.metadata = meta return obj } } interface ISeq : MalType { fun seq(): Sequence fun first(): MalType fun rest(): ISeq fun nth(n: Int): MalType fun count(): Int fun slice(fromIndex: Int, toIndex: Int): ISeq fun conj(s: ISeq): ISeq } interface IMutableSeq : ISeq { fun conj_BANG(form: MalType) } abstract class MalSequence(val elements: MutableList) : MalType, IMutableSeq { override var metadata: MalType = NIL override fun seq(): Sequence = elements.asSequence() override fun first(): MalType = elements.first() override fun nth(n: Int): MalType = elements.elementAt(n) override fun count(): Int = elements.count() override fun conj_BANG(form: MalType) { elements.add(form) } override fun equals(other: Any?): Boolean = (other is ISeq) && elements.size == other.count() && elements.asSequence().zip(other.seq()).all({ it -> it.first == it.second }) } class MalList(elements: MutableList) : MalSequence(elements) { constructor() : this(LinkedList()) constructor(s: ISeq) : this(s.seq().toCollection(LinkedList())) override fun rest(): ISeq = MalList(elements.drop(1).toCollection(LinkedList())) override fun slice(fromIndex: Int, toIndex: Int): MalList = MalList(elements.subList(fromIndex, toIndex)) override fun conj(s: ISeq): ISeq { val list = LinkedList(elements) s.seq().forEach({ it -> list.addFirst(it) }) return MalList(list) } override fun with_meta(meta: MalType): MalType { val obj = MalList(elements) obj.metadata = meta return obj } } class MalVector(elements: MutableList) : MalSequence(elements) { override var metadata: MalType = NIL constructor() : this(ArrayList()) constructor(s: ISeq) : this(s.seq().toCollection(ArrayList())) override fun rest(): ISeq = MalVector(elements.drop(1).toCollection(ArrayList())) override fun slice(fromIndex: Int, toIndex: Int): MalVector = MalVector(elements.subList(fromIndex, toIndex)) override fun conj(s: ISeq): ISeq = MalVector(elements.plus(s.seq()).toCollection(ArrayList())) override fun with_meta(meta: MalType): MalType { val obj = MalVector(elements) obj.metadata = meta return obj } } class MalHashMap() : MalType { override var metadata: MalType = NIL val elements = HashMap() constructor(other: MalHashMap) : this() { other.elements.forEach({ it -> assoc_BANG(it.key, it.value) }) } fun assoc_BANG(key: MalString, value: MalType) = elements.put(key, value) fun dissoc_BANG(key: MalString) { elements.remove(key) } override fun with_meta(meta: MalType): MalType { val obj = MalHashMap(this) obj.metadata = meta return obj } override fun equals(other: Any?): Boolean = (other is MalHashMap) && elements.equals(other.elements) } class MalAtom(var value: MalType) : MalType { override var metadata: MalType = NIL override fun with_meta(meta: MalType): MalType = throw UnsupportedOperationException() } val NIL = MalConstant("nil") val TRUE = MalConstant("true") val FALSE = MalConstant("false") val ZERO = MalInteger(0) ================================================ FILE: impls/kotlin/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/latex3/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install texlive-latex-base ================================================ FILE: impls/latex3/Makefile ================================================ all: clean: rm -f *~ *.aux *.dvi *.log argv ================================================ FILE: impls/latex3/core.sty ================================================ \ProvidesExplPackage {core} {2023/01/01} {0.0.1} {MAL~core~functions} \RequirePackage{types} \RequirePackage{printer} \RequirePackage{reader} \cs_new:Nn \mal_def_builtin:nN { \prop_put:Nxn \l_mal_repl_env_prop { y \tl_to_str:n { #1 } } { b n #2 } } \cs_generate_variant:Nn \mal_def_builtin:nN { nc } \cs_new:Nn \mal_def_builtin:nnn { \cs_new:cn { mal_ #2 :n } { #3 } \mal_def_builtin:nc { #1 } { mal_ #2 :n } } % Integer operations \cs_new:Nn \mal_int_op:nnN { % \iow_term:n {int_op~left=#1~right=#2~operator=#3} \tl_set:Nx \l_tmpa_tl { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } } \mal_def_builtin:nnn { + } { add } { \mal_int_op:nnN #1 + } \mal_def_builtin:nnn { - } { sub } { \mal_int_op:nnN #1 - } \mal_def_builtin:nnn { * } { mul } { \mal_int_op:nnN #1 * } \mal_def_builtin:nnn { / } { div } { \mal_int_op:nnN #1 / } % Integer comparisons \cs_new:Nn \mal_int_comp:nnNnn { \tl_set:Nx \l_tmpa_tl { \int_compare:oNoTF { \use_none:n #1 } #3 { \use_none:n #2 } #4 #5 } } \mal_def_builtin:nnn { < } { lt} { \mal_int_comp:nnNnn #1 < { t } { f } } \mal_def_builtin:nnn { > } { gt} { \mal_int_comp:nnNnn #1 > { t } { f } } \mal_def_builtin:nnn { <= } { le} { \mal_int_comp:nnNnn #1 > { f } { t } } \mal_def_builtin:nnn { >= } { ge} { \mal_int_comp:nnNnn #1 < { f } { t } } % Type tests \cs_new:Nn \mal_type_p:nN { \tl_set:Nx \l_tmpa_tl { \tl_if_head_eq_charcode:nNTF {#1} #2 { t } { f } } } \mal_def_builtin:nnn { list? } { list_p } { \mal_type_p:nN #1 l } \mal_def_builtin:nnn { atom? } { atom_p } { \mal_type_p:nN #1 a } \mal_def_builtin:nnn { nil? } { nil_p } { \mal_type_p:nN #1 n } \mal_def_builtin:nnn { true? } { true_p } { \mal_type_p:nN #1 t } \mal_def_builtin:nnn { false? } { false_p } { \mal_type_p:nN #1 f } \mal_def_builtin:nnn { symbol? } { symbol_p } { \mal_type_p:nN #1 y } \mal_def_builtin:nnn { keyword? } { keyword_p } { \mal_type_p:nN #1 k } \mal_def_builtin:nnn { vector? } { vector_p } { \mal_type_p:nN #1 v } \mal_def_builtin:nnn { map? } { map_p } { \mal_type_p:nN #1 m } \mal_def_builtin:nnn { string? } { string_p } { \mal_type_p:nN #1 s } \mal_def_builtin:nnn { number? } { number_p } { \mal_type_p:nN #1 i } \mal_def_builtin:nnn { macro? } { macro_p } { \mal_type_p:nN #1 c } \mal_def_builtin:nnn { fn? } { fn_p } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN #1 b } { \tl_if_head_eq_charcode_p:nN #1 u } { \tl_set:Nn \l_tmpa_tl { t } } { \tl_set:Nn \l_tmpa_tl { f } } } \mal_def_builtin:nnn { sequential? } { sequential_p } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN #1 l } { \tl_if_head_eq_charcode_p:nN #1 v } { \tl_set:Nn \l_tmpa_tl { t } } { \tl_set:Nn \l_tmpa_tl { f } } } % Other functions, in the order of the process guide. \mal_def_builtin:nnn { prn } { prn } { \iow_term:x { \mal_printer_tl:nVN {#1} \c_space_tl \c_true_bool } \tl_set:Nn \l_tmpa_tl { n } } \mal_def_builtin:nnn { list } { list } { \tl_set:Nn \l_tmpa_tl { l n #1 } } \cs_new:Nn \mal_empty_p_aux:n { \tl_set:Nx \l_tmpa_tl { \tl_if_empty:oTF { \use_none:nn #1 } { t } { f } } } \mal_def_builtin:nnn { empty? } { empty_p } { \mal_empty_p_aux:n #1 } \cs_new:Nn \mal_equal_token_lists:nn { % \iow_term:n {equal_token_lists~#1~#2} \tl_if_empty:nTF {#1} { \tl_if_empty:nTF {#2} { \tl_set:Nn \l_tmpa_tl { t } } { \tl_set:Nn \l_tmpa_tl { f } } } { \tl_if_empty:nTF {#2} { \tl_set:Nn \l_tmpa_tl { f } } { \mal_equal_form:xx { \tl_head:n {#1} } { \tl_head:n {#2} } \tl_if_head_eq_charcode:VNT \l_tmpa_tl t { \mal_equal_token_lists:oo { \use_none:n #1 } { \use_none:n #2 } } % nothing to do if already false } } } \cs_generate_variant:Nn \mal_equal_token_lists:nn { oo } \cs_new:Nn \mal_equal_map:nn { \prop_set_eq:Nc \l_tmpa_prop { #1 } \prop_set_eq:Nc \l_tmpb_prop { #2 } \prop_remove:Nn \l_tmpa_prop { __meta__ } \prop_remove:Nn \l_tmpb_prop { __meta__ } \tl_if_eq:xxTF { \prop_count:N \l_tmpa_prop } { \prop_count:N \l_tmpb_prop } { \prop_if_empty:NTF \l_tmpa_prop { \tl_set:Nn \l_tmpa_tl { t } } { \prop_map_inline:Nn \l_tmpa_prop { \prop_get:NnNTF \l_tmpb_prop {##1} \l_tmpb_tl { \mal_equal_form:Vn \l_tmpb_tl {##2} \tl_if_head_eq_charcode:VNT \l_tmpa_tl f { \prop_map_break: } } { \tl_set:Nn \l_tmpa_tl { f } \prop_map_break: } } % Finish with true if not interrupted } } { \tl_set:Nn \l_tmpa_tl { f } } } \cs_new:Nn \mal_equal_form:nn { % \iow_term:n {equal_form~#1~#2} \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN {#1} l } { \tl_if_head_eq_charcode_p:nN {#1} v } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN {#2} l } { \tl_if_head_eq_charcode_p:nN {#2} v } { \mal_equal_token_lists:oo { \use_none:nn #1 } { \use_none:nn #2 } } { \tl_set:Nn \l_tmpa_tl { f } } } { % \iow_term:n {not~a~sequence} \tl_if_head_eq_charcode:nNTF {#1} m { \tl_if_head_eq_charcode:nNTF {#2} m { \mal_equal_map:nn { #1 } { #2 } } { \tl_set:Nn \l_tmpa_tl { f } } } { % \iow_term:n {neither~a~sequence~nor~a~map} \str_if_eq:nnTF {#1} {#2} { \tl_set:Nn \l_tmpa_tl { t } } { \tl_set:Nn \l_tmpa_tl { f } } } } } \cs_generate_variant:Nn \mal_equal_form:nn { Vn, xx } \mal_def_builtin:nnn { = } { equal_p } { \mal_equal_form:nn #1 } \mal_def_builtin:nnn { count } { count } { \tl_if_head_eq_charcode:nNTF #1 n { \tl_set:Nn \l_tmpa_tl { i 0 } } { \tl_set:Nx \l_tmpa_tl { i \int_eval:n { \tl_count:n #1 - 2 } } } } \mal_def_builtin:nnn { pr-str } { pr_str } { % \iow_term:n {pr_str~#1} \tl_set:Nx \l_tmpa_tl { s \mal_printer_tl:nVN { #1 } \c_space_tl \c_true_bool } } \mal_def_builtin:nnn { str } { str } { \tl_set:Nx \l_tmpa_tl { s \mal_printer_tl:nnN { #1 } { } \c_false_bool } } \mal_def_builtin:nnn { println } { println } { \iow_term:x { \mal_printer_tl:nVN {#1} \c_space_tl \c_false_bool } \tl_set:Nn \l_tmpa_tl n } \cs_new:Nn \mal_read_string_aux:n { \tl_set:No \l_tmpa_str { \use_none:n #1 } \mal_read_str: } \mal_def_builtin:nnn { read-string } { read_string } { \mal_read_string_aux:n #1 } \cs_new:Nn \mal_slurp_aux:n { \tl_set:Nn \l_tmpa_tl { s } \ior_open:Nx \g_tmpa_ior { \use_none:n #1 } \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { ##1 } \tl_put_right:NV \l_tmpa_tl \c_new_line_str } \ior_close:N \g_tmpa_ior } \mal_def_builtin:nnn { slurp } { slurp } { \mal_slurp_aux:n #1 } \mal_def_builtin:nnn { atom } { atom } { % \iow_term:n {atom~#1} \int_incr:N \l_mal_object_counter_int \tl_set:Nx \l_tmpa_tl { atom_ \int_use:N \l_mal_object_counter_int } \tl_new:c \l_tmpa_tl \tl_set:cn \l_tmpa_tl #1 } \mal_def_builtin:nnn { deref } { deref } { \tl_set_eq:Nc \l_tmpa_tl #1 } \cs_new:Nn \mal_reset_aux:Nn { \tl_set:Nn #1 { #2 } \tl_set:Nn \l_tmpa_tl { #2 } } \cs_generate_variant:Nn \mal_reset_aux:Nn { cn } \mal_def_builtin:nnn { reset! } { reset } { \mal_reset_aux:cn #1 } \mal_def_builtin:nnn { swap! } { swap } { % \iow_term:n {swap~#1} \mal_fn_apply:xx { \tl_item:nn { #1 }{ 2 } } { { \exp_not:v { \tl_head:n { #1 } } } \exp_not:o { \use_none:nn #1 } } \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set_eq:cN { \tl_head:n { #1 } } \l_tmpa_tl } } \cs_new:Nn \mal_cons_aux:nn { % \iow_term:n {cons~#1~#2} \tl_set:No \l_tmpa_tl { \use_none:nn #2 } \tl_put_left:Nn \l_tmpa_tl { l n {#1} } } \mal_def_builtin:nnn { cons } { cons } { \mal_cons_aux:nn #1 } \cs_new:Nn \mal_concat_fn:n { \use_none:nn #1 } \mal_def_builtin:nnn { concat } { concat } { \tl_set:Nx \l_tmpa_tl { l n \tl_map_function:nN {#1} \mal_concat_fn:n } } \cs_new:Nn \mal_vec_aux:n { % \iow_term:n {vec~#1} \tl_set:No \l_tmpa_tl { \use_none:nn #1 } \tl_put_left:Nn \l_tmpa_tl { v n } } \mal_def_builtin:nnn { vec } { vec } { \mal_vec_aux:n #1 } \cs_new:Nn \mal_nth_aux:nn { % \iow_term:n {nth~#1~#2} \int_set:Nn \l_tmpa_int { 3 + \use_none:n #2 } \tl_set:Nx \l_tmpa_tl { \tl_item:nV {#1} \l_tmpa_int } \tl_if_empty:VT \l_tmpa_tl { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n {nth:~index~out~of~range} } } } \mal_def_builtin:nnn { nth } { nth } { \mal_nth_aux:nn #1 } \mal_def_builtin:nnn { first } { first } { % \iow_term:n {first~#1} \tl_set:Nx \l_tmpa_tl { \tl_item:nn #1 {3} } \tl_if_empty:NT \l_tmpa_tl { \tl_set:Nn \l_tmpa_tl {n} } } % This returns () for nil (unlike \use_none:nnn). \mal_def_builtin:nnn { rest } { rest } { \tl_set:Nx \l_tmpa_tl { l n \tl_range:nnn #1 4 {-1} } } \mal_def_builtin:nnn { throw } { throw } { % \iow_term:n {throw~#1} \tl_set:Nn \l_tmpa_tl #1 \tl_put_left:Nn \l_tmpa_tl {e} } \mal_def_builtin:nnn { apply } { apply } { % \iow_term:n {apply~#1} \tl_set:Nx \l_tmpb_tl { \tl_item:nn { #1 } { -1 } } % mal sequence \mal_fn_apply:xx { \tl_head:n { #1 } } { \tl_range:nnn { #1 } { 2 } { -2 } \tl_range:Vnn \l_tmpb_tl { 3 } { -1 } % the same as a tl } } \cs_new:Nn \mal_map_rec:nnn { % \iow_term:n {map~acc=#1~forms=#2~func=#3} \tl_if_empty:nTF {#2} { \tl_set:Nn \l_tmpa_tl {#1} } { \mal_fn_apply:nx { #3 } { { \tl_head:n {#2} } } \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_map_rec:xon { \exp_not:n {#1} { \exp_not:V \l_tmpa_tl } } { \use_none:n #2 } { #3 } } } } \cs_generate_variant:Nn \mal_map_rec:nnn { non, xon } \cs_new:Nn \mal_map_aux:nn { \mal_map_rec:non { l n } { \use_none:nn #2 } { #1 } } \mal_def_builtin:nnn { map } { map } { \mal_map_aux:nn #1 } \cs_new:Nn \mal_symbol_aux:n { \tl_set:Nx \l_tmpa_tl { y \use_none:n #1 } } \mal_def_builtin:nnn { symbol } { symbol } { \mal_symbol_aux:n #1 } \cs_new:Nn \mal_keyword_aux:n { \tl_set:Nx \l_tmpa_tl { k \use_none:n #1 } } \mal_def_builtin:nnn { keyword } { keyword } { \mal_keyword_aux:n #1 } \mal_def_builtin:nnn { vector } { vector } { \tl_set:Nn \l_tmpa_tl { v n #1 } } \mal_def_builtin:nN { hash-map } \mal_hash_map:n \mal_def_builtin:nnn { assoc } { assoc } { % \iow_term:n {assoc~#1} \mal_map_new: \prop_set_eq:cc \l_tmpa_tl { \tl_head:n { #1 } } \mal_assoc_internal:o { \use_none:n #1 } } \mal_def_builtin:nnn { dissoc } { dissoc } { % \iow_term:n {dissoc~prop=#1~keys=#2} \mal_map_new: \prop_set_eq:cc \l_tmpa_tl { \tl_head:n { #1 } } \tl_map_inline:on { \use_none:n #1 } { \prop_remove:cn \l_tmpa_tl { ##1 } } } \cs_new:Nn \mal_get_aux:nn { % \iow_term:n {get~#1~#2} \tl_if_head_eq_charcode:nNTF { #1 } n { \tl_set:Nn \l_tmpa_tl { n } } { \prop_get:cnNF { #1 } { #2 } \l_tmpa_tl { \tl_set:Nn \l_tmpa_tl { n } } } } \mal_def_builtin:nnn { get } { get } { \mal_get_aux:nn #1 } \mal_def_builtin:nnn { contains? } { contains } { % \iow_term:n {contains?~#1~#2} \prop_if_in:cnTF #1 { \tl_set:Nn \l_tmpa_tl { t } } { \tl_set:Nn \l_tmpa_tl { f } } } \cs_new:Nn \mal_keys_fn:nn { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #1 } } } } \mal_def_builtin:nnn { keys } { keys } { \tl_set:Nx \l_tmpa_tl { l n \prop_map_function:cN #1 \mal_keys_fn:nn } } \cs_new:Nn \mal_vals_fn:nn { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #2 } } } } \mal_def_builtin:nnn { vals } { vals } { \tl_set:Nx \l_tmpa_tl { l n \prop_map_function:cN #1 \mal_vals_fn:nn } } \mal_def_builtin:nnn { readline } { readline } { % \iow_term:n {readline:~|#1|} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \str_set:Nx \l_tmpa_str { \str_tail:V \l_tmpa_tl } \iow_term:V \l_tmpa_str \ior_str_get_term:nN {} \l_tmpa_str \tl_set:Nx \l_tmpa_tl { s \l_tmpa_str } } % Seconds since the UNIX epoch * on first call to time-ms *. \int_gzero_new:N \g_mal_first_epoch_int \mal_def_builtin:nnn { time-ms } { time_ms } { % Seconds are not accurate enough for MAL tests, so use %s%N. % The raw nanosecond count overflows LaTeX integers. % Even the millisecond count since 2024 overflows. \iow_term:n {MAL_LATEX3_STRIP_ON} \sys_get_shell:xnN { date ~ + \c_percent_str s \c_percent_str N} {} \l_tmpa_str \iow_term:n {MAL_LATEX3_STRIP_OFF} % Extract the digits representing seconds. \int_set:Nx \l_tmpa_int { \tl_range:Vnn \l_tmpa_str 1 { -10 } } % If this is the first time this function is called, \int_if_zero:VTF \g_mal_first_epoch_int { % then store the seconds since the epoch for later use \int_gset_eq:NN \g_mal_first_epoch_int \l_tmpa_int % and return 0 seconds \int_zero:N \l_tmpa_int } { % else return the duration in seconds since first call \int_set:Nn \l_tmpa_int { \l_tmpa_int - \g_mal_first_epoch_int } } % ... in both cases, append the three digits for millisecond. \tl_set:Nx \l_tmpa_tl { i \int_to_arabic:V \l_tmpa_int \tl_range:Vnn \l_tmpa_str { -9 } { -7 } } } \mal_def_builtin:nnn { meta } { meta } { % \iow_term:n {meta~#1} \tl_if_head_eq_charcode:nNTF #1 m { \prop_get:cnNF #1 { __meta__ } \l_tmpa_tl { \tl_set:Nx \l_tmpa_tl { n } } } { \tl_set:Nx \l_tmpa_tl { \tl_item:nn #1 { 2 } } } } \cs_new:Nn \mal_with_meta_aux:nn { % \iow_term:n {with-meta~#1~#2} \tl_if_head_eq_charcode:nNTF { #1 } m { \mal_map_new: \prop_set_eq:cc \l_tmpa_tl { #1 } \prop_put:cnn \l_tmpa_tl { __meta__ } { #2 } } { \tl_set:Nx \l_tmpa_tl { \tl_head:n { #1 } \exp_not:n { { #2 } } \exp_not:o { \use_none:nn #1 } } } } \mal_def_builtin:nnn { with-meta } { with_meta } { \mal_with_meta_aux:nn #1 } \cs_new:Nn \mal_seq_fn:N { { s #1 } } \cs_new:Nn \mal_seq_aux:n { % \iow_term:n {seq:~#1} \exp_args:Nx \token_case_charcode:Nn { \tl_head:n {#1} } { n { \tl_clear:N \l_tmpa_tl } l { \tl_set:No \l_tmpa_tl { \use_none:nn #1 } } v { \tl_set:No \l_tmpa_tl { \use_none:nn #1 } } s { \tl_set:Nx \l_tmpa_tl { \str_map_function:oN { \use_none:n #1 } \mal_seq_fn:N } } } \tl_if_empty:NTF \l_tmpa_tl { \tl_set:Nn \l_tmpa_tl n } { \tl_put_left:Nn \l_tmpa_tl { l n } } } \mal_def_builtin:nnn { seq } { seq } { \mal_seq_aux:n #1 } \mal_def_builtin:nnn { conj } { conj } { % \iow_term:n {conj~#1} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \tl_set:Nx \l_tmpb_tl { \tl_tail:n {#1} } \tl_if_head_eq_charcode:VNTF \l_tmpa_tl v { \tl_set:Nx \l_tmpa_tl { v n \tl_range:Vnn \l_tmpa_tl 3 {-1} \exp_not:V \l_tmpb_tl } } { \tl_set:Nx \l_tmpa_tl { l n \tl_reverse:V \l_tmpb_tl \tl_range:Vnn \l_tmpa_tl 3 {-1} } } } ================================================ FILE: impls/latex3/env.sty ================================================ \ProvidesExplPackage {env} {2023/01/01} {0.0.1} {MAL~environments} \RequirePackage{types} \prop_new:N \l_mal_repl_env_prop % Scratch variable containing the name of an enviromnent as a token % list, intended to be used with :c expansion. \tl_new:N \l_mal_tmp_env_prop % Note that __outer__ is not a valid key. % The new environment is returned in \l_mal_tmp_env_prop. \cs_new:Nn \mal_env_new:N { % \iow_term:n {env_new:~outer=#1} \int_incr:N \l_mal_object_counter_int \tl_set:Nx \l_mal_tmp_env_prop { env_ \int_use:N \l_mal_object_counter_int } \prop_new:c \l_mal_tmp_env_prop \prop_put:cnn \l_mal_tmp_env_prop { __outer__ } { #1 } } % \prop_put:Nnn is OK for a single assignment. % Shortcut for repeated '\prop_put:cnn \l_mal_tmp_env_prop' assignments, % with special handling of & variable arguments. \tl_const:Nx \c_ampersand_symbol { y \tl_to_str:n { & } } \cs_new:Nn \mal_env_set_keys_values:nn { % \iow_term:n {apply_loop:~keys=#1~vals=#2} \tl_if_empty:nF { #1 } { \tl_set:Nx \l_tmpb_tl { \tl_head:n { #1 } } \tl_if_eq:NNTF \l_tmpb_tl \c_ampersand_symbol { \prop_put:cxn \l_mal_tmp_env_prop { \tl_item:nn { #1 } { 2 } } { l n #2 } } { \prop_put:cVx \l_mal_tmp_env_prop \l_tmpb_tl { \tl_head:n { #2 } } \mal_env_set_keys_values:oo { \use_none:n #1 } { \use_none:n #2 } } } } \cs_generate_variant:Nn \mal_env_set_keys_values:nn { on, oo } \cs_new:Nn \mal_env_get:NnTF { % \iow_term:n {env_get:~env=#1~key=#2} \prop_get:NnNTF #1 { #2 } \l_tmpa_tl { #3 } { \prop_get:NnNTF #1 { __outer__ } \l_tmpa_tl { \exp_args:NV \mal_env_get:NnTF \l_tmpa_tl { #2 } { #3 } { #4 } } { #4 } } } % This one is useful for macroexpand, but may disappear once it is removed. \cs_generate_variant:Nn \mal_env_get:NnTF { NxTF } \cs_new:Nn \mal_env_get:NnT { \mal_env_get:NnTF #1 { #2 } { #3 } { } } \cs_new:Nn \mal_env_get:NnF { \mal_env_get:NnTF #1 { #2 } { } { #3 } } \cs_generate_variant:Nn \mal_env_get:NnT { NVT } ================================================ FILE: impls/latex3/printer.sty ================================================ \ProvidesExplPackage {printer} {2023/01/01} {0.0.1} {MAL~printer} \RequirePackage{types} \str_const:Nx \c_new_line_str { \char_generate:nn {10} {12} } % \str_map_function:oN { \use_none:n #1 } skips space characters bug? % It does not in core.sty... why? % \str_map_inline does not, but is not expandable. \cs_new:Nn \mal_printer_string:n { \tl_if_empty:nF { #1 } { \tl_if_head_is_space:nTF { #1 } { \c_space_tl } { \exp_args:NnV \tl_if_head_eq_charcode:nNTF { #1 } \c_new_line_str { \c_backslash_str \tl_to_str:n { n } } { \bool_lazy_or:nnT { \tl_if_head_eq_charcode_p:nN { #1 } " } { \exp_args:NnV \tl_if_head_eq_charcode_p:nN { #1 } \c_backslash_str } { \c_backslash_str } \tl_head:n { #1 } } } \mal_printer_string:e { \str_tail:n { #1 } } } } \cs_generate_variant:Nn \mal_printer_string:n { e, o } \cs_new:Nn \mal_printer_pr_str_flip:Nn { \mal_printer_pr_str:nN { #2 } #1 } \cs_new:Nn \mal_printer_tl:nnN { % \iow_term:n {printer_tl~forms=#1~separator=#2~readably=#3} \tl_if_empty:nF {#1} { \mal_printer_pr_str:fN { \tl_head:n { #1 } } #3 \tl_map_tokens:on { \use_none:n #1 } { #2 \mal_printer_pr_str_flip:Nn #3 } } } \cs_generate_variant:Nn \mal_printer_tl:nnN { nVN, oVN, VVN, eVN } \cs_new:Nn \mal_printer_map_fn:nn { \str_if_eq:nnF { #1 } { __meta__ } { \exp_not:n { { #1 } { #2 } } } } \cs_new:Nn \mal_printer_pr_str:nN { \exp_args:Nf \token_case_charcode:NnF { \tl_head:n {#1} } { n { \tl_to_str:n { nil } } f { \tl_to_str:n { false } } t { \tl_to_str:n { true } } i { \int_to_arabic:o { \use_none:n #1 } } y { \use_none:n #1 } k { \c_colon_str \use_none:n #1 } s { \bool_if:NTF #2 { " \mal_printer_string:o { \use_none:n #1 } " } { \use_none:n #1 } } l { ( \mal_printer_tl:oVN { \use_none:nn #1 } \c_space_tl #2 ) } v { [ \mal_printer_tl:oVN { \use_none:nn #1 } \c_space_tl #2 ] } m { \c_left_brace_str \mal_printer_tl:eVN { \prop_map_function:cN { #1 } \mal_printer_map_fn:nn } \c_space_tl #2 \c_right_brace_str } b { \tl_to_str:n { } } u { \tl_to_str:n { } } c { \tl_to_str:n { } } a { \tl_to_str:n { (atom~ } \mal_printer_pr_str:vN { #1 } #2 ) } e { \tl_to_str:n { Error:~ } \mal_printer_pr_str:oN { \use_none:n #1 } #2 } } { \tl_to_str:n { Error:~invalid~print~argument~#1 } } } \cs_generate_variant:Nn \mal_printer_pr_str:nN { fN, oN, VN, vN } %% \mal_printer_pr_str:nN { n } \c_true_bool %% \mal_printer_pr_str:nN { i 23 } \c_true_bool %% \mal_printer_pr_str:oN { y \tl_to_str:n { symbol } } \c_true_bool %% \mal_printer_pr_str:oN { k \tl_to_str:n { keyword } } \c_true_bool %% \mal_printer_pr_str:nN { s } \c_false_bool %% \mal_printer_pr_str:oN { s \tl_to_str:n { unreadable"string } } \c_false_bool %% \mal_printer_pr_str:nN { l n } \c_true_bool %% \mal_printer_pr_str:nN { l n n t } \c_true_bool %% \mal_printer_pr_str:nN { l n { i 1 } { i 2 } } \c_true_bool %% \mal_printer_pr_str:nN { v n { i 1 } { i 2 } } \c_true_bool %% \mal_printer_pr_str:nN { l n { l n { i 1 } { i 2 } } t } \c_true_bool %% \mal_printer_pr_str:oN { s \tl_to_str:n { d " q } } \c_true_bool %% \mal_printer_pr_str:oN { s \tl_to_str:n { b } \c_backslash_str \tl_to_str:n { s } } \c_true_bool %% \mal_printer_pr_str:oN { s \tl_to_str:n { n } \c_new_line_str \tl_to_str:n { l } } \c_true_bool %% \tl_set:Nn \l_tmpa_tl { i 3 } %% \mal_printer_pr_str:nN { a \l_tmpa_tl } \c_true_bool %% \prop_clear:N \l_tmpa_prop %% \prop_put:Nxn \l_tmpa_prop { k \tl_to_str:n {a} } { i 12 } %% \prop_put:Nxn \l_tmpa_prop { s \tl_to_str:n {b} } { n } %% \mal_printer_pr_str:xN { m n \exp_not:V \l_tmpa_prop } \c_true_bool ================================================ FILE: impls/latex3/reader.sty ================================================ \ProvidesExplPackage {reader} {2023/01/01} {0.0.1} {MAL~reader} \RequirePackage{types} % It would be convenient to output the forms in a list directly, but % this would require a fully expandable read_str. \prop_set and % \regex_replace_once are too convenient. % \l_tmpa_str is used as a common buffer for the remaining input. % Compile the regular expressions once and for all. \regex_const:Nn \c_mal_space_regex { ^ (?: \s | , | ; \N* \n )* } \regex_const:Nn \c_mal_unescape_cr_regex { \\ n } \regex_const:Nn \c_mal_unescape_regex { \\ ([^n]) } \regex_const:Nn \c_mal_number_regex { ^ ( -? \d+ ) (.*) } \regex_const:Nn \c_mal_symbol_regex { ^ ( [^ " ' \( \) , ; @ \[ \] ^ ` \{ \} \~ \s ] + ) (.*) } \regex_const:Nn \c_mal_keyword_regex { ^ : ( [^ " ' \( \) , : ; @ \[ \] ^ ` \{ \} \~ \s ] + ) (.*) } \regex_const:Nn \c_mal_string_regex { ^ " ( (?: [^ \\ "] | \\ . )* ) " (.*) } \cs_new:Nn \mal_skip_spaces: { \regex_replace_once:NnN \c_mal_space_regex {} \l_tmpa_str } \cs_new:Nn \mal_skip_char: { \tl_set:Nx \l_tmpa_str { \tl_tail:V \l_tmpa_str } } % Read forms until a closing brace #1. % Return a tl of MAL forms or an error in \l_tmpa_tl. % accumulator closing brace \cs_new:Nn \mal_reader_seq_loop:nN { % \iow_term:n {reader_seq_loop~#1~#2} \mal_skip_spaces: \tl_if_head_eq_charcode:VNTF \l_tmpa_str #2 { \mal_skip_char: \tl_set:Nn \l_tmpa_tl { #1 } } { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_reader_seq_loop:xN { \exp_not:n {#1} { \exp_not:V \l_tmpa_tl } } #2 } } } \cs_generate_variant:Nn \mal_reader_seq_loop:nN { xN } % #1: a token list without leading y \cs_new:Nn \mal_reader_quote:n { % \iow_term:n {quote~#1} \mal_skip_char: \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:Nx \l_tmpa_tl { l n { y \tl_to_str:n { #1 } } { \exp_not:V \l_tmpa_tl } } } } % The only purpose of this macro is to store #1 during read_str. \cs_new:Nn \mal_reader_with_meta:n { % \iow_term:n {with_meta~#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:Nx \l_tmpa_tl { l n { y \tl_to_str:n { with-meta } } { \exp_not:V \l_tmpa_tl } \exp_not:n { { #1 } } } } } \cs_generate_variant:Nn \mal_reader_with_meta:n { V } % Input in \l_tmpa str (modified) % Write the MAL form to \l_tmpa_tl. \cs_new:Nn \mal_read_str: { % \iow_term:x {reader_read_str~\l_tmpa_str} \mal_skip_spaces: \str_case_e:nnF { \str_head:V \l_tmpa_str } { { ' } { \mal_reader_quote:n { quote } } { @ } { \mal_reader_quote:n { deref } } { ` } { \mal_reader_quote:n { quasiquote } } { ( } { \mal_skip_char: \mal_reader_seq_loop:nN { l n } ) } { [ } { \mal_skip_char: \mal_reader_seq_loop:nN { v n } ] } \c_left_brace_str { \mal_skip_char: \exp_args:NnV \mal_reader_seq_loop:nN { } \c_right_brace_str \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_hash_map:V \l_tmpa_tl } } \c_tilde_str { \str_if_eq:xnTF { \str_item:Vn \l_tmpa_str 2 } { @ } { \mal_skip_char: \mal_reader_quote:n { splice-unquote } } { \mal_reader_quote:n { unquote } } } { ^ } { \mal_skip_char: \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_reader_with_meta:V \l_tmpa_tl } } } { \regex_extract_once:NVNTF \c_mal_string_regex \l_tmpa_str \l_tmpa_seq { \seq_get_right:NN \l_tmpa_seq \l_tmpa_str \tl_set:Nx \l_tmpa_tl { s \seq_item:Nn \l_tmpa_seq 2 } \regex_replace_case_all:nN { \c_mal_unescape_cr_regex { \n } \c_mal_unescape_regex { \1 } } \l_tmpa_tl } { \regex_extract_once:NVNTF \c_mal_keyword_regex \l_tmpa_str \l_tmpa_seq { \seq_get_right:NN \l_tmpa_seq \l_tmpa_str \tl_set:Nx \l_tmpa_tl { k \seq_item:Nn \l_tmpa_seq 2 } } { \regex_extract_once:NVNTF \c_mal_number_regex \l_tmpa_str \l_tmpa_seq { \seq_get_right:NN \l_tmpa_seq \l_tmpa_str \tl_set:Nx \l_tmpa_tl { i \seq_item:Nn \l_tmpa_seq 2 } } { \regex_extract_once:NVNTF \c_mal_symbol_regex \l_tmpa_str \l_tmpa_seq { \seq_get_right:NN \l_tmpa_seq \l_tmpa_str \tl_set:Nx \l_tmpa_tl { \seq_item:Nn \l_tmpa_seq 2 } \str_case:NnF \l_tmpa_tl { { nil } { \tl_set:Nn \l_tmpa_tl { n } } { false } { \tl_set:Nn \l_tmpa_tl { f } } { true } { \tl_set:Nn \l_tmpa_tl { t } } } { \tl_put_left:Nn \l_tmpa_tl { y } } % catcode is already Ok } { \tl_set:Nn \l_tmpa_tl { e s unbalanced~expression } } } } } } % \iow_term:n {__ read_str~returns} % \iow_term:V \l_tmpa_tl } % \str_set:Nn \l_tmpa_str { ~, } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { ~12~a } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { -12 } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { ab } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { nil } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { :ab } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { "ab"w } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { (,) } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { (nil~:a) } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { (nil,[:a]) } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { 'a } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nn \l_tmpa_str { ^a~b } \mal_read_str: \iow_term:V \l_tmpa_tl % \str_set:Nx \l_tmpa_str { \c_left_brace_str "a"~1~:b~2 \c_right_brace_str } % \mal_read_str: % \iow_term:V \l_tmpa_tl % \str_set:Nx \l_tmpa_str % { % \c_left_brace_str % "a"~1 % ~:b~\c_left_brace_str % :c~3 % \c_right_brace_str % \c_right_brace_str % } % \mal_read_str: % \iow_term:V \l_tmpa_tl ================================================ FILE: impls/latex3/run ================================================ #!/bin/sh set -Cefu # LaTeX creates temporary files in the current directory. cd $(dirname $0) # There is no way to directly provide command line arguments to LaTeX, # use an intermediate file. for arg; do echo "$arg" done >| argv # max_print_line: prevent TeX from wrapping lines written to the # terminal (the default is around 80 columns). # Shell escapes are necessary for time-ms in core.sty. # time-ms also requires to strip the output caused by accessing a subshell. # Halt on error... should be the default. # Remove the normal TeX initial and final output. The > characters # confuse the test runner, especially in the *ARGV* test. # There is no way in latex3 to check if the terminal receives an # END_OF_FILE character, handle Emergency stop as a normal ending. # When debugging, set DEBUG=1 to see the actual output. max_print_line=1000 \ latex \ -shell-escape \ -halt-on-error \ ${STEP:-stepA_mal}.tex \ | { if [ -n "${DEBUG:-}" ]; then cat else sed ' 1,/^MAL_LATEX3_START_OF_OUTPUT$/ d /^MAL_LATEX3_END_OF_OUTPUT$/,$ d /^MAL_LATEX3_STRIP_ON/,/MAL_LATEX3_STRIP_OFF/ d /^! Emergency stop[.]$/,$ d ' fi } ================================================ FILE: impls/latex3/step0_repl.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \iow_term:V \l_tmpa_str } \repl_loop: } } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \repl_loop: \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step1_read_print.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \repl_loop: \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step2_eval.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \prop_get:NnNF #2 { #1 } \l_tmpa_tl { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { oN, VN, xN } % REPL \prop_new:N \l_mal_repl_env_prop \cs_new:Nn \mal_int_op:nnN { \tl_set:Nx \l_tmpa_tl { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } } \cs_new:Nn \mal_add:n { \mal_int_op:nnN #1 + } \cs_new:Nn \mal_sub:n { \mal_int_op:nnN #1 - } \cs_new:Nn \mal_mul:n { \mal_int_op:nnN #1 * } \cs_new:Nn \mal_div:n { \mal_int_op:nnN #1 / } \prop_put:Nnn \l_mal_repl_env_prop { y + } { b n \mal_add:n } \prop_put:Nnn \l_mal_repl_env_prop { y - } { b n \mal_sub:n } \prop_put:Nnn \l_mal_repl_env_prop { y * } { b n \mal_mul:n } \prop_put:Nnn \l_mal_repl_env_prop { y / } { b n \mal_div:n } \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \repl_loop: \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step3_env.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \mal_int_op:nnN { \tl_set:Nx \l_tmpa_tl { i \int_eval:n { \use_none:n #1 #3 \use_none:n #2 } } } \cs_new:Nn \mal_add:n { \mal_int_op:nnN #1 + } \cs_new:Nn \mal_sub:n { \mal_int_op:nnN #1 - } \cs_new:Nn \mal_mul:n { \mal_int_op:nnN #1 * } \cs_new:Nn \mal_div:n { \mal_int_op:nnN #1 / } \prop_put:Nnn \l_mal_repl_env_prop { y + } { b n \mal_add:n } \prop_put:Nnn \l_mal_repl_env_prop { y - } { b n \mal_sub:n } \prop_put:Nnn \l_mal_repl_env_prop { y * } { b n \mal_mul:n } \prop_put:Nnn \l_mal_repl_env_prop { y / } { b n \mal_div:n } \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \repl_loop: \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step4_if_fn_do.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \tl_if_head_eq_charcode:nNTF { #1 } u { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \repl_loop: \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step6_file.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \tl_if_head_eq_charcode:nNTF { #1 } u { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \cs_generate_variant:Nn \mal_re:n { x } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } \mal_re:x { (def!~load-file~(fn*~(f) ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) } \mal_def_builtin:nnn { eval } { eval_builtin } { \mal_eval:nN #1 \l_mal_repl_env_prop } \tl_clear:N \l_tmpa_tl \ior_open:Nn \g_tmpa_ior {argv} \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { { s #1 } } } \ior_close:N \g_tmpa_ior \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } { l n \tl_tail:V \l_tmpa_tl } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \tl_if_empty:NTF \l_tmpa_tl { \repl_loop: } { \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s } \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step7_quote.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % Step 7 \tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } \tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } \tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } \tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } \cs_new:Nn \mal_quasiquote_item:n { \bool_lazy_and:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } l } { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } } \cs_generate_variant:Nn \mal_quasiquote_item:n { e } \cs_new:Nn \mal_qq_loop:n { l n \tl_if_empty:nF {#1} { \mal_quasiquote_item:e { \tl_head:n { #1 } } { \mal_qq_loop:o { \use_none:n #1 } } } } \cs_generate_variant:Nn \mal_qq_loop:n { o } \cs_new:Nn \mal_quasiquote:n { \tl_if_head_eq_charcode:nNTF { #1 } l { \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol { \exp_not:o { \use_iv:nnnn #1 } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \tl_if_head_eq_charcode:nNTF { #1 } v { l n { y \tl_to_str:n { vec } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } m } { \tl_if_head_eq_charcode_p:nN { #1 } y } { l n { \c_quote_symbol } { \exp_not:n { #1 } } } { \exp_not:n { #1 } } } } } \cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \tl_if_head_eq_charcode:nNTF { #1 } u { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \cs_generate_variant:Nn \mal_re:n { x } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } \mal_re:x { (def!~load-file~(fn*~(f) ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) } \mal_def_builtin:nnn { eval } { eval_builtin } { \mal_eval:nN #1 \l_mal_repl_env_prop } \tl_clear:N \l_tmpa_tl \ior_open:Nn \g_tmpa_ior {argv} \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { { s #1 } } } \ior_close:N \g_tmpa_ior \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } { l n \tl_tail:V \l_tmpa_tl } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \tl_if_empty:NTF \l_tmpa_tl { \repl_loop: } { \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s } \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step8_macros.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % Step 7 \tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } \tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } \tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } \tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } \cs_new:Nn \mal_quasiquote_item:n { \bool_lazy_and:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } l } { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } } \cs_generate_variant:Nn \mal_quasiquote_item:n { e } \cs_new:Nn \mal_qq_loop:n { l n \tl_if_empty:nF {#1} { \mal_quasiquote_item:e { \tl_head:n { #1 } } { \mal_qq_loop:o { \use_none:n #1 } } } } \cs_generate_variant:Nn \mal_qq_loop:n { o } \cs_new:Nn \mal_quasiquote:n { \tl_if_head_eq_charcode:nNTF { #1 } l { \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol { \exp_not:o { \use_iv:nnnn #1 } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \tl_if_head_eq_charcode:nNTF { #1 } v { l n { y \tl_to_str:n { vec } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } m } { \tl_if_head_eq_charcode_p:nN { #1 } y } { l n { \c_quote_symbol } { \exp_not:n { #1 } } } { \exp_not:n { #1 } } } } } \cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } % Step 8 \tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } \cs_new:Nn \mal_eval_defmacro:nnnN { % \iow_term:n {defmacro~#2~#3~#4} \mal_eval:nN {#3} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } \prop_put:NnV #4 {#2} \l_tmpa_tl } % \iow_term:V \l_tmpa_tl } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } u } { \tl_if_head_eq_charcode_p:nN { #1 } c } { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } { \mal_eval_defmacro:nnnN #1 #2 } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c { \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl #2 } } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \cs_generate_variant:Nn \mal_re:n { x } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } \mal_re:x { (def!~load-file~(fn*~(f) ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) } \mal_re:n { (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))))))) } \mal_def_builtin:nnn { eval } { eval_builtin } { \mal_eval:nN #1 \l_mal_repl_env_prop } \tl_clear:N \l_tmpa_tl \ior_open:Nn \g_tmpa_ior {argv} \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { { s #1 } } } \ior_close:N \g_tmpa_ior \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } { l n \tl_tail:V \l_tmpa_tl } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \tl_if_empty:NTF \l_tmpa_tl { \repl_loop: } { \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s } \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/step9_try.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % Step 7 \tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } \tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } \tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } \tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } \cs_new:Nn \mal_quasiquote_item:n { \bool_lazy_and:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } l } { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } } \cs_generate_variant:Nn \mal_quasiquote_item:n { e } \cs_new:Nn \mal_qq_loop:n { l n \tl_if_empty:nF {#1} { \mal_quasiquote_item:e { \tl_head:n { #1 } } { \mal_qq_loop:o { \use_none:n #1 } } } } \cs_generate_variant:Nn \mal_qq_loop:n { o } \cs_new:Nn \mal_quasiquote:n { \tl_if_head_eq_charcode:nNTF { #1 } l { \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol { \exp_not:o { \use_iv:nnnn #1 } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \tl_if_head_eq_charcode:nNTF { #1 } v { l n { y \tl_to_str:n { vec } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } m } { \tl_if_head_eq_charcode_p:nN { #1 } y } { l n { \c_quote_symbol } { \exp_not:n { #1 } } } { \exp_not:n { #1 } } } } } \cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } % Step 8 \tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } \cs_new:Nn \mal_eval_defmacro:nnnN { % \iow_term:n {defmacro~#2~#3~#4} \mal_eval:nN {#3} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } \prop_put:NnV #4 {#2} \l_tmpa_tl } % \iow_term:V \l_tmpa_tl } % Step 9 \tl_const:Nx \c_try_symbol { y \tl_to_str:n { try* } } \cs_new:Nn \mal_eval_catch:nnnnnnN { % \iow_term:n {catch~exception=#1~l=#2~meta=#3~catch*=#4~symbol=#5~handler=#6~env=#7} \mal_env_new:N #7 \prop_put:cno \l_mal_tmp_env_prop { #5 } { \use_none:n #1 } \mal_eval:nc { #6 } \l_mal_tmp_env_prop } \cs_generate_variant:Nn \mal_eval_catch:nnnnnnN { VnnnnnN } \cs_new:Nn \mal_eval_try:nnnN { % \iow_term:n {try~try*=#1~tested=#2~catch_list=#3~env=#4} \mal_eval:nN { #2 } #4 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \mal_eval_catch:VnnnnnN \l_tmpa_tl #3 #4 } } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } u } { \tl_if_head_eq_charcode_p:nN { #1 } c } { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } { \mal_eval_defmacro:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_try_symbol } { \tl_if_empty:oTF { \use_none:nn #1 } { \mal_eval:oN { \use_ii:nn #1 } #2 } { \mal_eval_try:nnnN #1 #2 } } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c { \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl #2 } } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \cs_generate_variant:Nn \mal_re:n { x } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } \mal_re:x { (def!~load-file~(fn*~(f) ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) } \mal_re:n { (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))))))) } \mal_def_builtin:nnn { eval } { eval_builtin } { \mal_eval:nN #1 \l_mal_repl_env_prop } \tl_clear:N \l_tmpa_tl \ior_open:Nn \g_tmpa_ior {argv} \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { { s #1 } } } \ior_close:N \g_tmpa_ior \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } { l n \tl_tail:V \l_tmpa_tl } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \tl_if_empty:NTF \l_tmpa_tl { \repl_loop: } { \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s } \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/stepA_mal.tex ================================================ \documentclass{article} \usepackage % Uncomment this and \debug_on below when debugging. % [enable-debug] {expl3} \usepackage{types} \usepackage{printer} \usepackage{reader} \usepackage{env} \usepackage{core} \ExplSyntaxOn % Slow but quite useful. % \debug_on:n { all } % Step 2 \cs_new:Nn \mal_eval_map:nN { % \iow_term:n {eval_map~ast=#1~env=#2} \mal_map_new: \prop_map_inline:cn { #1 } { \str_if_eq:nnF { ##1 } { __meta__ } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##2 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \prop_map_break: } { \prop_put:cnV \l_tmpb_tl { ##1 } \l_tmpa_tl \tl_set_eq:NN \l_tmpa_tl \l_tmpb_tl } } } } \cs_new:Nn \mal_eval_iterate_tl:nN { % The evaluated elements are appended to \l_tmpa_tl. % \iow_term:n {eval_tl:~forms=#1~env=#2} \tl_map_inline:nn { #1 } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \mal_eval:nN { ##1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNTF \l_tmpa_tl e { \tl_map_break: } { \tl_set:Nx \l_tmpa_tl { \exp_not:V \l_tmpb_tl { \exp_not:V \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_iterate_tl:nN { oN } % Step 3 \tl_const:Nx \c_def_symbol { y \tl_to_str:n { def! } } \tl_const:Nx \c_let_symbol { y \tl_to_str:n { let* } } \tl_const:Nx \c_debug_eval_symbol { y \tl_to_str:n { DEBUG-EVAL } } \cs_new:Nn \mal_eval_let_loop:nNn { % \iow_term:n {mal_eval_let_loop~binds=#1~env=#2~form=#3} \tl_if_empty:nTF { #1 } { \mal_eval:nN { #3 } #2 } { \mal_eval:xN { \tl_item:nn { #1 } 2 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \prop_put:NxV #2 { \tl_head:n { #1 } } \l_tmpa_tl \mal_eval_let_loop:oNn { \use_none:nn #1 } #2 { #3 } } } } \cs_generate_variant:Nn \mal_eval_let_loop:nNn { ocn, oNn } \cs_new:Nn \mal_eval_let:nnnN { % \iow_term:n {mal_eval_let~let*=#1~binds=#2~form=#3~env=#4} \mal_env_new:N #4 \mal_eval_let_loop:ocn { \use_none:nn #2 } \l_mal_tmp_env_prop { #3 } } % Step 4 \tl_const:Nx \c_if_symbol { y \tl_to_str:n { if } } \tl_const:Nx \c_do_symbol { y \tl_to_str:n { do } } \tl_const:Nx \c_fn_symbol { y \tl_to_str:n { fn* } } \cs_new:Nn \mal_eval_if:nnnN { % \iow_term:n {if~test=#2~then=#3~env=#4} \mal_eval:nN {#2} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \tl_set:Nn \l_tmpa_tl { n } } { \mal_eval:nN {#3} #4 } } } \cs_new:Nn \mal_eval_if:nnnnN { % \iow_term:n {if~test=#2~then=#3~else=#4~env=#5} \mal_eval:nN {#2} #5 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \mal_eval:nN { #4 } #5 } { \mal_eval:nN { #3 } #5 } } } \cs_new:Nn \mal_fn:nnnN { % \iow_term:n {fn*~params=#2~implem=#3~env=#4} \tl_set:Nx \l_tmpa_tl { \exp_not:n { u n { #3 } #4 } \use_none:nn #2 } % \iow_term:V \l_tmpa_tl } % Step 7 \tl_const:Nx \c_quote_symbol { y \tl_to_str:n { quote } } \tl_const:Nx \c_quasiquote_symbol { y \tl_to_str:n { quasiquote } } \tl_const:Nx \c_splice_unquote_symbol { y \tl_to_str:n { splice-unquote } } \tl_const:Nx \c_unquote_symbol { y \tl_to_str:n { unquote } } \cs_new:Nn \mal_quasiquote_item:n { \bool_lazy_and:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } l } { \str_if_eq_p:eV { \tl_item:nn { #1 } { 3 } } \c_splice_unquote_symbol } { { y \tl_to_str:n { concat } } { \exp_not:o { \use_iv:nnnn #1 } } } { { y \tl_to_str:n { cons } } { \mal_quasiquote:n { #1 } } } } \cs_generate_variant:Nn \mal_quasiquote_item:n { e } \cs_new:Nn \mal_qq_loop:n { l n \tl_if_empty:nF {#1} { \mal_quasiquote_item:e { \tl_head:n { #1 } } { \mal_qq_loop:o { \use_none:n #1 } } } } \cs_generate_variant:Nn \mal_qq_loop:n { o } \cs_new:Nn \mal_quasiquote:n { \tl_if_head_eq_charcode:nNTF { #1 } l { \str_if_eq:eVTF { \tl_item:nn { #1 } 3 } \c_unquote_symbol { \exp_not:o { \use_iv:nnnn #1 } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \tl_if_head_eq_charcode:nNTF { #1 } v { l n { y \tl_to_str:n { vec } } { \mal_qq_loop:o { \use_none:nn #1 } } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } m } { \tl_if_head_eq_charcode_p:nN { #1 } y } { l n { \c_quote_symbol } { \exp_not:n { #1 } } } { \exp_not:n { #1 } } } } } \cs_new:Nn \mal_eval_quasiquote:nn { \mal_quasiquote:n { #2 } } % Step 8 \tl_const:Nx \c_defmacro_symbol { y \tl_to_str:n { defmacro! } } \cs_new:Nn \mal_eval_defmacro:nnnN { % \iow_term:n {defmacro~#2~#3~#4} \mal_eval:nN {#3} #4 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:Nx \l_tmpa_tl { c n \tl_range:Vnn \l_tmpa_tl { 3 } { -1 } } \prop_put:NnV #4 {#2} \l_tmpa_tl } % \iow_term:V \l_tmpa_tl } % Step 9 \tl_const:Nx \c_try_symbol { y \tl_to_str:n { try* } } \cs_new:Nn \mal_eval_catch:nnnnnnN { % \iow_term:n {catch~exception=#1~l=#2~meta=#3~catch*=#4~symbol=#5~handler=#6~env=#7} \mal_env_new:N #7 \prop_put:cno \l_mal_tmp_env_prop { #5 } { \use_none:n #1 } \mal_eval:nc { #6 } \l_mal_tmp_env_prop } \cs_generate_variant:Nn \mal_eval_catch:nnnnnnN { VnnnnnN } \cs_new:Nn \mal_eval_try:nnnN { % \iow_term:n {try~try*=#1~tested=#2~catch_list=#3~env=#4} \mal_eval:nN { #2 } #4 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \mal_eval_catch:VnnnnnN \l_tmpa_tl #3 #4 } } % EVAL \cs_new:Nn \mal_fn_apply:nn { % \iow_term:n {fn_apply:~func=#1~args=#2} \tl_if_head_eq_charcode:nNTF { #1 } b { \use_none:nn #1 { #2 } } { \bool_lazy_or:nnTF { \tl_if_head_eq_charcode_p:nN { #1 } u } { \tl_if_head_eq_charcode_p:nN { #1 } c } { \exp_args:Nx \mal_env_new:N { \tl_item:nn { #1 } { 4 } } \mal_env_set_keys_values:on { \use_none:nnnn #1 } { #2 } \mal_eval:xc { \tl_item:nn { #1 } { 3 } } \l_mal_tmp_env_prop } { \tl_set:Nx \l_tmpa_tl { e s \tl_to_str:n { can~only~apply~functions } } } } % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_fn_apply:nn { nx, Vo, VV, xx } \cs_new:Nn \mal_eval_list:nN { % \iow_term:n {eval_mal_list~tl=#1~env=#2} \tl_set:Nx \l_tmpa_tl { \tl_head:n {#1} } \bool_case_true:nF { { \tl_if_eq_p:NN \l_tmpa_tl \c_empty_tl } { \tl_set:Nn \l_tmpa_tl { l n } } { \tl_if_eq_p:NN \l_tmpa_tl \c_def_symbol } { \mal_eval:oN { \use_iii:nnn #1 } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_set:No \l_tmpb_tl { \use_ii:nnn #1 } \prop_put:NVV #2 \l_tmpb_tl \l_tmpa_tl } } { \tl_if_eq_p:NN \l_tmpa_tl \c_let_symbol } { \mal_eval_let:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_if_symbol } { \tl_if_empty:oTF { \use_none:nnn #1 } { \mal_eval_if:nnnN #1 #2 } { \mal_eval_if:nnnnN #1 #2 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_do_symbol } { \tl_map_inline:on { \use_none:n #1 } { \mal_eval:nN { ##1 } #2 \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \tl_map_break: } } } { \tl_if_eq_p:NN \l_tmpa_tl \c_fn_symbol } { \mal_fn:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_quote_symbol } { \tl_set:No \l_tmpa_tl { \use_ii:nn #1 } } { \tl_if_eq_p:NN \l_tmpa_tl \c_quasiquote_symbol } { \mal_eval:xN { \mal_eval_quasiquote:nn #1 } #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_defmacro_symbol } { \mal_eval_defmacro:nnnN #1 #2 } { \tl_if_eq_p:NN \l_tmpa_tl \c_try_symbol } { \tl_if_empty:oTF { \use_none:nn #1 } { \mal_eval:oN { \use_ii:nn #1 } #2 } { \mal_eval_try:nnnN #1 #2 } } } { % \iow_term:n {eval_mal_list~apply_phase~tl=#1~env=#2} \mal_eval:xN { \tl_head:n { #1 } } #2 \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \tl_if_head_eq_charcode:VNTF \l_tmpa_tl c { \mal_fn_apply:Vo \l_tmpa_tl { \use_none:n #1 } \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl #2 } } { \seq_push:NV \l_mal_stack_seq \l_tmpa_tl \tl_clear:N \l_tmpa_tl \mal_eval_iterate_tl:oN { \use_none:n #1 } #2 \seq_pop:NN \l_mal_stack_seq \l_tmpb_tl \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_fn_apply:VV \l_tmpb_tl \l_tmpa_tl } } } } } \cs_generate_variant:Nn \mal_eval_list:nN { oN } \cs_new:Nn \mal_eval:nN { % \iow_term:n {EVAL:~ast=#1~env=#2} \mal_env_get:NVT #2 \c_debug_eval_symbol { \bool_lazy_or:nnF { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl n } { \tl_if_head_eq_charcode_p:VN \l_tmpa_tl f } { \iow_term:x { EVAL: ~ \mal_printer_pr_str:nN { #1 } \c_true_bool } } } \exp_args:Nx \token_case_charcode:NnF { \tl_head:n {#1} } { l { \mal_eval_list:oN { \use_none:nn #1 } #2 } y { \mal_env_get:NnF #2 { #1 } { \tl_set:Nx \l_tmpa_tl { e s \use_none:n #1 \tl_to_str:n { ~not~found } } } } v { \tl_set:Nn \l_tmpa_tl { v n } \mal_eval_iterate_tl:oN { \use_none:nn #1 } #2 } m { \mal_eval_map:nN { #1 } #2 } } { \tl_set:Nn \l_tmpa_tl {#1} } % \iow_term:n {EVAL:~ast=#1~returns} % \iow_term:V \l_tmpa_tl } \cs_generate_variant:Nn \mal_eval:nN { nc, oN, VN, xc, xN } % REPL \cs_new:Nn \repl_loop: { % \ior_str_get_term is able to display a prompt on the same line, % but this would make ./run far more complex for little benefit. \iow_term:n {user>~} \ior_str_get_term:nN {} \l_tmpa_str \str_if_eq:VnF \l_tmpa_str {MAL_LATEX3_END_OF_INPUT} % from ./run { % Ignore empty lines, the MAL self-hosting relies on this % *not* triggering an error. \str_if_eq:VnF \l_tmpa_str {} { \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } } \repl_loop: } } \cs_new:Nn \mal_re:n { % \iow_term:n {re:~#1} \str_set:Nn \l_tmpa_str {#1} \mal_read_str: \tl_if_head_eq_charcode:VNF \l_tmpa_tl e { \mal_eval:VN \l_tmpa_tl \l_mal_repl_env_prop } \tl_if_head_eq_charcode:VNT \l_tmpa_tl e { \iow_term:n {error~during~startup~#1} \iow_term:x { \mal_printer_pr_str:VN \l_tmpa_tl \c_true_bool } Trigger a missing begin document error } } \cs_generate_variant:Nn \mal_re:n { x } \mal_re:n { (def!~not~(fn*~(a)~(if~a~false~true))) } \mal_re:x { (def!~load-file~(fn*~(f) ~(eval~(read-string~(str~"(do~"~(slurp~f)~"\c_backslash_str nnil)"))))) } \mal_re:n { (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))))))) } \mal_def_builtin:nnn { eval } { eval_builtin } { \mal_eval:nN #1 \l_mal_repl_env_prop } \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *host-language* } } { s \tl_to_str:n { LaTeX3 } } \tl_clear:N \l_tmpa_tl \ior_open:Nn \g_tmpa_ior {argv} \ior_str_map_inline:Nn \g_tmpa_ior { \tl_put_right:Nn \l_tmpa_tl { { s #1 } } } \ior_close:N \g_tmpa_ior \prop_put:Nxx \l_mal_repl_env_prop { y \tl_to_str:n { *ARGV* } } { l n \tl_tail:V \l_tmpa_tl } % ./run removes the normal LaTeX output. \iow_term:n {MAL_LATEX3_START_OF_OUTPUT} \tl_if_empty:NTF \l_tmpa_tl { \mal_re:n { (println (str "Mal [" *host-language* "]")) } \repl_loop: } { \tl_set:Nx \l_tmpa_tl { \tl_head:V \l_tmpa_tl } \mal_re:x { (load-file~" \tl_tail:V \l_tmpa_tl ") } % without initial s } \iow_term:n {MAL_LATEX3_END_OF_OUTPUT} % for ./run \ExplSyntaxOff \begin{document} \end{document} ================================================ FILE: impls/latex3/types.sty ================================================ \ProvidesExplPackage {types} {2023/01/01} {0.0.1} {MAL~types} % This file is included almost everywhere, it seems a good place to % define the variants we need. \cs_generate_variant:Nn \int_compare:nNnTF { oNoTF } \cs_generate_variant:Nn \int_const:Nn { NV } \cs_generate_variant:Nn \int_if_zero:nTF { VTF } \cs_generate_variant:Nn \int_set:Nn { Nx } \cs_generate_variant:Nn \int_to_alph:n { V } \cs_generate_variant:Nn \int_to_arabic:n { o, V } \cs_generate_variant:Nn \ior_open:Nn {Nx} \cs_generate_variant:Nn \iow_term:n { x, V } \cs_generate_variant:Nn \prop_put:Nnn { cxn, Nxn, NxV } \cs_generate_variant:Nn \regex_extract_once:NnNTF {NVNTF} \cs_generate_variant:Nn \str_head:n { V } \cs_generate_variant:Nn \str_if_eq:nnTF { eVTF, xnTF } \cs_generate_variant:Nn \str_if_eq_p:nn { eV } \cs_generate_variant:Nn \str_item:nn { Vn } \cs_generate_variant:Nn \str_map_function:nN { oN } \cs_generate_variant:Nn \str_map_inline:nn { on } \cs_generate_variant:Nn \str_set:Nn { Nx } \cs_generate_variant:Nn \str_tail:n { V} \cs_generate_variant:Nn \sys_get_shell:nnN { xnN } \cs_generate_variant:Nn \tl_const:Nn { cx } \cs_generate_variant:Nn \tl_if_eq:nnTF { xxTF } \cs_generate_variant:Nn \tl_if_head_eq_charcode:nNF { VNF } \cs_generate_variant:Nn \tl_if_head_eq_charcode:nNT { VNT } \cs_generate_variant:Nn \tl_if_head_eq_charcode:nNTF { VNTF } \cs_generate_variant:Nn \tl_if_head_eq_charcode_p:nN { VN } \cs_generate_variant:Nn \tl_item:nn { nV } \cs_generate_variant:Nn \tl_map_inline:nn { on } \cs_generate_variant:Nn \tl_map_tokens:nn { on } \cs_generate_variant:Nn \tl_range:nnn { Vnn } \cs_generate_variant:Nn \tl_tail:n { V } % A global stack is convenient for storage of local variables during % recursive computations. \seq_new:N \l_mal_stack_seq % TeX usually uses local assignments for this, but the number of % groups is limited to 255, which is not enough for MAL recursions. % A mal form is represented by a token list starting with a letter % defining the type (this sometimes allows f expansion). % n nil % f false % t true % y .. symbol the rest is a str % s .. string the rest is a str % k .. keyword the rest is a str % i .. number the rest is a tl/str of digits % l meta elt elt.. list % v meta elt elt.. vector % map_... map \map_.. is a prop (may contain __meta__) % atom_.. atom \atom_.. tl var contains a mal form % e .. exception the rest is a mal form % u meta impl env arg arg.. function the argument is a tl of mal forms % c meta impl env arg arg.. macro (see function) % b n \mal_..:n built-in function, expecting a tl of mal forms % Global counter used to create unique control sequences for atoms (in % core.sty) and environments (in env.sty). \int_new:N \l_mal_object_counter_int \cs_new:Nn \mal_map_new: { \int_incr:N \l_mal_object_counter_int \tl_set:Nx \l_tmpa_tl { map_ \int_use:N \l_mal_object_counter_int } \prop_new:c \l_tmpa_tl } % Put keys and values read from a tl of MAL forms into \l_tmpa_tl, % which must be a prop variable. % Defined here because it is used by core.sty and reader.sty. \cs_new:Nn \mal_assoc_internal:n { % \iow_term:n {assoc_internal~#1} \tl_if_empty:nF { #1 } { \prop_put:cxx \l_tmpa_tl { \tl_head:n { #1 } } { \tl_item:nn { #1 } 2 } \mal_assoc_internal:o { \use_none:nn #1 } } } \cs_generate_variant:Nn \mal_assoc_internal:n { o } \cs_new:Nn \mal_hash_map:n { \mal_map_new: \mal_assoc_internal:n { #1 } } \cs_generate_variant:Nn \mal_hash_map:n { V } ================================================ FILE: impls/lib/README.md ================================================ This directory contains general-purpose reusable code that does not fit in the process. The split in small files is motivated by implementations too limited to load a single big file, but MAL has no proper module management. However, here are some guidelines. - Begin with an one-line ;; short description - Describe the restrictions on each parameter in comments. - Define private symbols in hidden environments when possible. If this is not possible, for example for macros, give them a name starting with an underscore. If a module provides tests, you may run against an implementation IMPL with these commands. ``` make IMPL^stepA cd tests python ../runtest.py lib/MODULE.mal ../IMPL/run ``` Users and implementors should use the following syntax in order to ensure that the same file is only loaded once. ``` (load-file "../lib/load-file-once.mal") (load-file-once "../lib/foo.mal") (load-file-once "../lib/bar.mal") ``` ================================================ FILE: impls/lib/alias-hacks.mal ================================================ ;; aliases for common clojure names to mal builtins ;; NOTE: this is a hack ;; Origin: https://github.com/chr15m/frock ; TODO: re-implement as actually useful macros: ; destructuring, arg checking, etc. (def! _alias_add_implicit (fn* [special added] (fn* [x & xs] (list special x (cons added xs))))) (defmacro! let (_alias_add_implicit 'let* 'do)) (defmacro! when (_alias_add_implicit 'if 'do)) (defmacro! def (_alias_add_implicit 'def! 'do)) (defmacro! fn (_alias_add_implicit 'fn* 'do)) (defmacro! defn (_alias_add_implicit 'def! 'fn)) (def! partial (fn* [pfn & args] (fn* [& args-inner] (apply pfn (concat args args-inner))))) ================================================ FILE: impls/lib/benchmark.mal ================================================ ;; An alternative approach, to complement perf.mal (load-file "../lib/load-file-once.mal") (load-file-once "../lib/trivial.mal") ; gensym inc (def! benchmark* (fn* [f n results] (if (< 0 n) (let* [start-ms (time-ms) _ (f) end-ms (time-ms)] (benchmark* f (- n 1) (conj results (- end-ms start-ms)))) results))) (defmacro! benchmark (fn* [expr n] `(benchmark* (fn* [] ~expr) ~n []))) ================================================ FILE: impls/lib/equality.mal ================================================ ;; equality.mal ;; This file checks whether the `=` function correctly implements equality of ;; hash-maps and sequences (lists and vectors). If not, it redefines the `=` ;; function with a pure mal (recursive) implementation that only relies on the ;; native original `=` function for comparing scalars (integers, booleans, ;; symbols, strings, keywords, atoms, nil). ;; Save the original (native) `=` as scalar-equal? (def! scalar-equal? =) ;; A faster `and` macro which doesn't use `=` internally. (defmacro! bool-and ; boolean (fn* [& xs] ; interpreted as logical values (if (empty? xs) true `(if ~(first xs) (bool-and ~@(rest xs)) false)))) (defmacro! bool-or ; boolean (fn* [& xs] ; interpreted as logical values (if (empty? xs) false `(if ~(first xs) true (bool-or ~@(rest xs)))))) (def! starts-with? (fn* [a b] (bool-or (empty? a) (bool-and (mal-equal? (first a) (first b)) (starts-with? (rest a) (rest b)))))) (def! hash-map-vals-equal? (fn* [a b map-keys] (bool-or (empty? map-keys) (let* [key (first map-keys)] (bool-and (contains? b key) (mal-equal? (get a key) (get b key)) (hash-map-vals-equal? a b (rest map-keys))))))) ;; This implements = in pure mal (using only scalar-equal? as native impl) (def! mal-equal? (fn* [a b] (cond (sequential? a) (bool-and (sequential? b) (scalar-equal? (count a) (count b)) (starts-with? a b)) (map? a) (let* [keys-a (keys a)] (bool-and (map? b) (scalar-equal? (count keys-a) (count (keys b))) (hash-map-vals-equal? a b keys-a))) true (scalar-equal? a b)))) (def! hash-map-equality-correct? (fn* [] (try* (bool-and (= {:a 1} {:a 1}) (not (= {:a 1} {:a 1 :b 2}))) (catch* _ false)))) (def! sequence-equality-correct? (fn* [] (try* (bool-and (= [:a :b] (list :a :b)) (not (= [:a :b] [:a :b :c]))) (catch* _ false)))) ;; If the native `=` implementation doesn't support sequences or hash-maps ;; correctly, replace it with the pure mal implementation (if (not (bool-and (hash-map-equality-correct?) (sequence-equality-correct?))) (do (def! = mal-equal?) (println "equality.mal: Replaced = with pure mal implementation"))) ================================================ FILE: impls/lib/load-file-once.mal ================================================ ;; Like load-file, but will never load the same path twice. ;; This file is normally loaded with `load-file`, so it needs a ;; different mechanism to neutralize multiple inclusions of ;; itself. Moreover, the file list should never be reset. (def! load-file-once (try* load-file-once (catch* _ (let* [seen (atom {"../lib/load-file-once.mal" nil})] (fn* [filename] (if (not (contains? @seen filename)) (do (swap! seen assoc filename nil) (load-file filename)))))))) ================================================ FILE: impls/lib/memoize.mal ================================================ ;; Memoize any function. ;; Implement `memoize` using an atom (`mem`) which holds the memoized results ;; (hash-map from the arguments to the result). When the function is called, ;; the hash-map is checked to see if the result for the given argument was already ;; calculated and stored. If this is the case, it is returned immediately; ;; otherwise, it is calculated and stored in `mem`. ;; For recursive functions, take care to store the wrapper under the ;; same name than the original computation with an assignment like ;; `(def! f (memoize f))`, so that intermediate results are memorized. ;; Adapted from http://clojure.org/atoms (def! memoize (fn* [f] (let* [mem (atom {})] (fn* [& args] (let* [key (str args)] (if (contains? @mem key) (get @mem key) (let* [ret (apply f args)] (do (swap! mem assoc key ret) ret)))))))) ================================================ FILE: impls/lib/perf.mal ================================================ ;; Mesure performances. (load-file "../lib/load-file-once.mal") (load-file-once "../lib/trivial.mal") ; gensym inc ;; Evaluate an expression, but report the time spent (defmacro! time (fn* (exp) (let* [start (gensym) ret (gensym)] `(let* (~start (time-ms) ~ret ~exp) (do (println "Elapsed time:" (- (time-ms) ~start) "msecs") ~ret))))) ;; Count evaluations of a function during a given time frame. (def! run-fn-for (let* [ run-fn-for* (fn* [fn max-ms acc-ms last-iters] (let* [start (time-ms) _ (fn) elapsed (- (time-ms) start) iters (inc last-iters) new-acc-ms (+ acc-ms elapsed)] ;; (do (prn "new-acc-ms:" new-acc-ms "iters:" iters)) (if (>= new-acc-ms max-ms) last-iters (run-fn-for* fn max-ms new-acc-ms iters)))) ] (fn* [fn max-secs] ;; fn : function without parameters ;; max-secs : number (seconds) ;; return : number (iterations) (do ;; Warm it up first (run-fn-for* fn 1000 0 0) ;; Now do the test (run-fn-for* fn (* 1000 max-secs) 0 0))))) ================================================ FILE: impls/lib/pprint.mal ================================================ ;; Pretty printer a MAL object. (def! pprint (let* [ spaces- (fn* [indent] (if (> indent 0) (str " " (spaces- (- indent 1))) "")) pp-seq- (fn* [obj indent] (let* [xindent (+ 1 indent)] (apply str (pp- (first obj) 0) (map (fn* [x] (str "\n" (spaces- xindent) (pp- x xindent))) (rest obj))))) pp-map- (fn* [obj indent] (let* [ks (keys obj) kindent (+ 1 indent) kwidth (count (seq (str (first ks)))) vindent (+ 1 (+ kwidth kindent))] (apply str (pp- (first ks) 0) " " (pp- (get obj (first ks)) 0) (map (fn* [k] (str "\n" (spaces- kindent) (pp- k kindent) " " (pp- (get obj k) vindent))) (rest ks))))) pp- (fn* [obj indent] (cond (list? obj) (str "(" (pp-seq- obj indent) ")") (vector? obj) (str "[" (pp-seq- obj indent) "]") (map? obj) (str "{" (pp-map- obj indent) "}") :else (pr-str obj))) ] (fn* [obj] (println (pp- obj 0))))) ================================================ FILE: impls/lib/protocols.mal ================================================ ;; A sketch of Clojure-like protocols, implemented in Mal ;; By chouser (Chris Houser) ;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc ;; This function maps a MAL value to a keyword representing its type. ;; Most applications will override the default with an explicit value ;; for the `:type` key in the metadata. (def! find-type (fn* [obj] (cond (symbol? obj) :mal/symbol (keyword? obj) :mal/keyword (atom? obj) :mal/atom (nil? obj) :mal/nil (true? obj) :mal/boolean (false? obj) :mal/boolean (number? obj) :mal/number (string? obj) :mal/string (macro? obj) :mal/macro true (let* [metadata (meta obj) type (if (map? metadata) (get metadata :type))] (cond (keyword? type) type (list? obj) :mal/list (vector? obj) :mal/vector (map? obj) :mal/map (fn? obj) :mal/function true (throw "unknown MAL value in protocols")))))) ;; A protocol (abstract class, interface..) is represented by a symbol. ;; It describes methods (abstract functions, contracts, signals..). ;; Each method is described by a sequence of two elements. ;; First, a symbol setting the name of the method. ;; Second, a vector setting its formal parameters. ;; The first parameter is required, plays a special role. ;; It is usually named `this` (`self`..). ;; For example, ;; (defprotocol protocol ;; (method1 [this]) ;; (method2 [this argument])) ;; can be thought as: ;; (def! method1 (fn* [this]) ..) ;; (def! method2 (fn* [this argument]) ..) ;; (def! protocol ..) ;; The return value is the new protocol. (defmacro! defprotocol (fn* [proto-name & methods] ;; A protocol is an atom mapping a type extending the protocol to ;; another map from method names as keywords to implementations. (let* [ drop2 (fn* [args] (if (= 2 (count args)) () (cons (first args) (drop2 (rest args))))) rewrite (fn* [method] (let* [ name (first method) args (nth method 1) argc (count args) varargs? (if (<= 2 argc) (= '& (nth args (- argc 2)))) dispatch `(get (get @~proto-name (find-type ~(first args))) ~(keyword (str name))) body (if varargs? `(apply ~dispatch ~@(drop2 args) ~(nth args (- argc 1))) (cons dispatch args)) ] (list 'def! name (list 'fn* args body)))) ] `(do ~@(map rewrite methods) (def! ~proto-name (atom {})))))) ;; A type (concrete class..) extends (is a subclass of, implements..) ;; a protocol when it provides implementations for the required methods. ;; (extend type protocol { ;; :method1 (fn* [this] ..) ;; :method2 (fn* [this arg1 arg2])}) ;; Additionnal protocol/methods pairs are equivalent to successive ;; calls with the same type. ;; The return value is `nil`. (def! extend (fn* [type proto methods & more] (do (swap! proto assoc type methods) (if (first more) (apply extend type more))))) ;; An object satisfies a protocol when its type extends the protocol, ;; that is if the required methods can be applied to the object. (def! satisfies? (fn* [protocol obj] (contains? @protocol (find-type obj)))) ;; If `(satisfies protocol obj)` with the protocol below ;; then `(method1 obj)` and `(method2 obj 1 2)` ;; dispatch to the concrete implementation provided by the exact type. ;; Should the type evolve, the calling code needs not change. ================================================ FILE: impls/lib/reducers.mal ================================================ ;; Left and right folds. ;; Left fold (f (.. (f (f init x1) x2) ..) xn) (def! reduce (fn* (f init xs) ;; f : Accumulator Element -> Accumulator ;; init : Accumulator ;; xs : sequence of Elements x1 x2 .. xn ;; return : Accumulator (if (empty? xs) init (reduce f (f init (first xs)) (rest xs))))) ;; Right fold (f x1 (f x2 (.. (f xn init)) ..)) ;; The natural implementation for `foldr` is not tail-recursive, and ;; the one based on `reduce` constructs many intermediate functions, so we ;; rely on efficient `nth` and `count`. (def! foldr (let* [ rec (fn* [f xs acc index] (if (< index 0) acc (rec f xs (f (nth xs index) acc) (- index 1)))) ] (fn* [f init xs] ;; f : Element Accumulator -> Accumulator ;; init : Accumulator ;; xs : sequence of Elements x1 x2 .. xn ;; return : Accumulator (rec f xs init (- (count xs) 1))))) ================================================ FILE: impls/lib/test_cascade.mal ================================================ ;; Iteration on evaluations interpreted as boolean values. (load-file "../lib/load-file-once.mal") (load-file-once "../lib/trivial.mal") ; gensym ;; `(cond test1 result1 test2 result2 .. testn resultn)` ;; is rewritten (in the step files) as ;; `(if test1 result1 (if test2 result2 (.. (if testn resultn nil))))` ;; It is common that `testn` is `"else"`, `:else`, `true` or similar. ;; `(or x1 x2 .. xn x)` ;; is almost rewritten as ;; `(if x1 x1 (if x2 x2 (.. (if xn xn x))))` ;; except that each argument is evaluated at most once. ;; Without arguments, returns `nil`. (defmacro! or (fn* [& xs] (if (< (count xs) 2) (first xs) (let* [r (gensym)] `(let* (~r ~(first xs)) (if ~r ~r (or ~@(rest xs)))))))) ;; Conjonction of predicate values (pred x1) and .. and (pred xn) ;; Evaluate `pred x` for each `x` in turn. Return `false` if a result ;; is `nil` or `false`, without evaluating the predicate for the ;; remaining elements. If all test pass, return `true`. (def! every? (fn* (pred xs) ;; pred : Element -> interpreted as a logical value ;; xs : sequence of Elements x1 x2 .. xn ;; return : boolean (cond (empty? xs) true (pred (first xs)) (every? pred (rest xs)) true false))) ;; Disjonction of predicate values (pred x1) or .. (pred xn) ;; Evaluate `(pred x)` for each `x` in turn. Return the first result ;; that is neither `nil` nor `false`, without evaluating the predicate ;; for the remaining elements. If all tests fail, return nil. (def! some (fn* (pred xs) ;; pred : Element -> interpreted as a logical value ;; xs : sequence of Elements x1 x2 .. xn ;; return : boolean (if (empty? xs) nil (or (pred (first xs)) (some pred (rest xs)))))) ;; Search for first evaluation returning `nil` or `false`. ;; Rewrite `x1 x2 .. xn x` as ;; (let* [r1 x1] ;; (if r1 test1 ;; (let* [r2 x2] ;; .. ;; (if rn ;; x ;; rn) ..) ;; r1)) ;; Without arguments, returns `true`. (defmacro! and (fn* (& xs) ;; Arguments and the result are interpreted as boolean values. (cond (empty? xs) true (= 1 (count xs)) (first xs) true (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar (and ~@(rest xs)) ~condvar)))))) ================================================ FILE: impls/lib/threading.mal ================================================ ;; Composition of partially applied functions. (load-file "../lib/load-file-once.mal") (load-file-once "../lib/reducers.mal") ; reduce ;; Rewrite x (a a1 a2) .. (b b1 b2) as ;; (b (.. (a x a1 a2) ..) b1 b2) ;; If anything else than a list is found were `(a a1 a2)` is expected, ;; replace it with a list with one element, so that `-> x a` is ;; equivalent to `-> x (list a)`. (defmacro! -> (fn* (x & xs) (reduce _iter-> x xs))) (def! _iter-> (fn* [acc form] (if (list? form) `(~(first form) ~acc ~@(rest form)) (list form acc)))) ;; Like `->`, but the arguments describe functions that are partially ;; applied with *left* arguments. The previous result is inserted at ;; the *end* of the new argument list. ;; Rewrite x ((a a1 a2) .. (b b1 b2)) as ;; (b b1 b2 (.. (a a1 a2 x) ..)). (defmacro! ->> (fn* (x & xs) (reduce _iter->> x xs))) (def! _iter->> (fn* [acc form] (if (list? form) `(~(first form) ~@(rest form) ~acc) (list form acc)))) ================================================ FILE: impls/lib/trivial.mal ================================================ ;; Trivial but convenient functions. ;; Integer predecessor (number -> number) (def! inc (fn* [a] (+ a 1))) ;; Integer predecessor (number -> number) (def! dec (fn* (a) (- a 1))) ;; Integer nullity test (number -> boolean) (def! zero? (fn* (n) (= 0 n))) ;; Returns the unchanged argument. (def! identity (fn* (x) x)) ;; Generate a hopefully unique symbol. See section "Plugging the Leaks" ;; of http://www.gigamonkeys.com/book/macros-defining-your-own.html (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc)))))) ================================================ FILE: impls/livescript/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive \ apt-get -y install libreadline-dev libedit-dev livescript npm ENV NPM_CONFIG_CACHE /mal/.npm ================================================ FILE: impls/livescript/Makefile ================================================ SOURCES_BASE = reader.ls printer.ls env.ls core.ls utils.ls SOURCES_STEPS = step0_repl.ls step1_read_print.ls step2_eval.ls \ step4_if_fn_do.ls step5_tco.ls step6_file.ls step7_quote.ls \ step8_macros.ls step9_try.ls stepA_mal.ls SOURCES = $(SOURCES_BASE) $(SOURCES_STEPS) BINS = $(SOURCES:%.ls=%.js) LSC = lsc all: node_modules $(BINS) node_modules: npm install %.js: %.ls node_modules $(LSC) -d -c $(@:%.js=%.ls) step1_read_print.js: utils.js reader.js printer.js step2_eval.js: utils.js reader.js printer.js step3_env.js: utils.js reader.js printer.js env.js step4_if_fn_do.js: utils.js reader.js printer.js env.js core.js step5_tco.js: utils.js reader.js printer.js env.js core.js step6_file.js: utils.js reader.js printer.js env.js core.js step7_quote.js: utils.js reader.js printer.js env.js core.js step8_macros.js: utils.js reader.js printer.js env.js core.js step9_try.js: utils.js reader.js printer.js env.js core.js stepA_mal.js: utils.js reader.js printer.js env.js core.js clean: rm -f $(BINS) ================================================ FILE: impls/livescript/core.ls ================================================ { zip, map, apply, and-list, join, Obj, concat, all, pairs-to-obj, obj-to-pairs, reject, keys, values, difference, empty, reverse, chars } = require 'prelude-ls' {pr_str} = require './printer' {read_str, list-to-map, map-keyword, keyword-prefix} = require './reader' fs = require 'fs' {readline} = require './node_readline' export runtime-error = (msg) -> throw new Error msg export unpack-tco = (ast) -> if ast.type == \tco then ast.eval! else ast fn = (body) -> {type: \function, value: body} const-nil = -> {type: \const, value: \nil} const-int = (int) -> {type: \int, value: int} const-bool = (bool) -> {type: \const, value: if bool then \true else \false} const-str = (str) -> {type: \string, value: str} list-or-vector = ({type}) -> type in [\list \vector] are-lists-equal = (equals-fn, a, b) -> if a.length != b.length then false else zip a, b |> map (apply equals-fn) |> and-list deep-equals = (a, b) -> if (list-or-vector a) and (list-or-vector b) then are-lists-equal deep-equals, a.value, b.value else if a.type == \map and b.type == \map then a-keys = keys a.value b-keys = keys b.value if a-keys.length == b-keys.length and \ empty (difference a-keys, b-keys) #if are-lists-equal (==), a-keys, b-keys a-keys |> map (key) -> [a.value[key], b.value[key]] |> map (apply deep-equals) |> and-list else false else if a.type != b.type then false else a.value == b.value check-param = (name, idx, test, expected, actual) -> if not test runtime-error "'#{name}' expected parameter #{idx} to be #{expected}, got #{actual}" check-type = (name, idx, expected, actual) -> check-param name, idx, expected == actual, expected, actual export ns = do '+': fn (a, b) -> const-int a.value + b.value '-': fn (a, b) -> const-int a.value - b.value '*': fn (a, b) -> const-int a.value * b.value '/': fn (a, b) -> const-int parseInt (a.value / b.value) 'list': fn (...list) -> {type: \list, value: list} 'list?': fn (param) -> const-bool param.type == \list 'empty?': fn ({type, value}) -> switch type | \const => if value == \nil then const-bool true else runtime-error "'empty?' is not supported on #{value}" | \list, \vector => const-bool value.length == 0 | \map => const-bool Obj.empty value | otherwise => runtime-error "'empty?' is not supported on type #{type}" 'count': fn ({type, value}) -> switch type | \const => if value == \nil then const-int 0 else runtime-error "'count' is not supported on #{value}" | \list, \vector => const-int value.length | \map => value |> Obj.keys |> (.length) |> const-int | otherwise => runtime-error "'count' is not supported on type #{type}" '=': fn (a, b) -> const-bool (deep-equals a, b) '<': fn (a, b) -> const-bool a.value < b.value '>': fn (a, b) -> const-bool a.value > b.value '<=': fn (a, b) -> const-bool a.value <= b.value '>=': fn (a, b) -> const-bool a.value >= b.value 'pr-str': fn (...params) -> params |> map (p) -> pr_str p, print_readably=true |> join ' ' |> const-str 'str': fn (...params) -> params |> map (p) -> pr_str p, print_readably=false |> join '' |> const-str 'prn': fn (...params) -> params |> map (p) -> pr_str p, print_readably=true |> join ' ' |> console.log |> const-nil 'println': fn (...params) -> params |> map (p) -> pr_str p, print_readbly=false |> join ' ' |> console.log |> const-nil 'read-string': fn ({type, value}) -> check-type 'read-string', 0, \string, type read_str value 'slurp': fn (filename) -> if filename.type != \string runtime-error "'slurp' expected the first parameter to be a string, got a #{filename.type}" const-str <| fs.readFileSync filename.value, 'utf8' 'atom': fn (value) -> {type: \atom, value: value} 'atom?': fn (atom) -> const-bool atom.type == \atom 'deref': fn (atom) -> check-type 'deref', 0, \atom, atom.type atom.value 'reset!': fn (atom, value) -> check-type 'reset!', 0, \atom, atom.type atom.value = value 'swap!': fn (atom, fn, ...args) -> check-type 'swap!', 0, \atom, atom.type if fn.type != \function runtime-error "'swap!' expected the second parameter to be a function, got a #{fn.type}" atom.value = unpack-tco (fn.value.apply @, [atom.value] ++ args) 'cons': fn (value, list) -> check-param 'cons', 1, (list-or-vector list), 'list or vector', list.type {type: \list, value: [value] ++ list.value} 'concat': fn (...params) -> if not all list-or-vector, params runtime-error "'concat' expected all parameters to be a list or vector" {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 check-param 'nth', 1, index.type == \int, 'int', index.type if index.value < 0 or index.value >= list.value.length runtime-error 'list index out of bounds' list.value[index.value] 'first': fn (list) -> if list.type == \const and list.value == \nil return const-nil! check-param 'first', 0, (list-or-vector list), 'list or vector', list.type if list.value.length == 0 then const-nil! else list.value[0] 'rest': fn (list) -> if list.type == \const and list.value == \nil return {type: \list, value: []} check-param 'rest', 0, (list-or-vector list), 'list or vector', list.type {type: \list, value: list.value.slice 1} 'throw': fn (value) -> throw value 'apply': fn (fn, ...params, list) -> check-type 'apply', 0, \function, fn.type if not list then runtime-error "apply expected at least two parameters" check-param 'apply', params.length+1, (list-or-vector list), 'list or vector', list.type unpack-tco fn.value.apply @, params ++ list.value 'map': fn (fn, list) -> check-type 'map', 0, \function, fn.type check-param 'map', 1, (list-or-vector list), 'list or vector', list.type mapped-list = list.value |> map (value) -> unpack-tco fn.value.apply @, [value] {type: \list, value: mapped-list} 'nil?': fn (ast) -> const-bool (ast.type == \const and ast.value == \nil) 'true?': fn (ast) -> const-bool (ast.type == \const and ast.value == \true) 'false?': fn (ast) -> const-bool (ast.type == \const and ast.value == \false) 'symbol?': fn (ast) -> const-bool ast.type == \symbol 'symbol': fn (str) -> check-type 'symbol', 0, \string, str.type {type: \symbol, value: str.value} 'keyword': fn (str) -> if str.type == \keyword then return str check-type 'keyword', 0, \string, str.type {type: \keyword, value: ':' + str.value} 'keyword?': fn (ast) -> const-bool ast.type == \keyword 'number?': fn (ast) -> const-bool ast.type == \int 'fn?': fn (ast) -> const-bool (ast.type == \function and not ast.is_macro) 'macro?': fn (ast) -> const-bool (ast.type == \function and ast.is_macro) 'vector': fn (...params) -> {type: \vector, value: params} 'vector?': fn (ast) -> const-bool ast.type == \vector 'hash-map': fn (...params) -> list-to-map params 'map?': fn (ast) -> const-bool ast.type == \map 'assoc': fn (m, ...params) -> check-type 'assoc', 0, \map, m.type # Turn the params into a map, this is kind of hacky. params-map = list-to-map params # Copy the map by cloning (prototyping). new-map = ^^m.value for k, v of params-map.value new-map[k] = v {type: \map, value: new-map} 'dissoc': fn (m, ...keys) -> check-type 'dissoc', 0, \map, m.type # Convert keyword to map key strings. str-keys = keys |> map map-keyword new-map = m.value |> obj-to-pairs |> reject ([key, value]) -> key in str-keys |> pairs-to-obj {type: \map, value: new-map} 'get': fn (m, key) -> if m.type == \const and m.value == \nil then return const-nil! check-type 'get', 0, \map, m.type str-key = map-keyword key value = m.value[str-key] if value then value else const-nil! 'contains?': fn (m, key) -> check-type 'contains?', 0, \map, m.type str-key = map-keyword key const-bool (str-key of m.value) 'keys': fn (m) -> check-type 'keys', 0, \map, m.type result = keys m.value |> map (key) -> if key.startsWith keyword-prefix then {type: \keyword, value: key.substring 1} else {type: \string, value: key} {type: \list, value: result} 'vals': fn (m) -> check-type 'vals', 0, \map, m.type {type: \list, value: values m.value} 'sequential?': fn (ast) -> const-bool list-or-vector ast 'with-meta': fn (ast, m) -> ast with {meta: m} 'meta': fn (ast) -> if ast.meta then ast.meta else const-nil! 'readline': fn (prompt) -> check-type 'readline', 0, \string, prompt.type result = readline prompt.value if result? then const-str result else const-nil! 'time-ms': fn -> const-int (new Date).getTime! 'conj': fn (list, ...params) -> check-param 'conj', 0, (list-or-vector list), 'list or vector', list.type if list.type == \list type: \list value: (reverse params) ++ list.value else type: \vector value: list.value ++ params 'string?': fn (ast) -> const-bool ast.type == \string 'seq': fn (seq) -> switch seq.type | \list => if seq.value.length then seq else const-nil! | \vector => if seq.value.length then {type: \list, value: seq.value} else const-nil! | \string => if seq.value.length then {type: \list, value: chars seq.value |> map const-str} else const-nil! | otherwise => if seq.type == \const and seq.value == \nil then const-nil! else runtime-error "unsupported type for 'seq': #{seq.type}" ================================================ FILE: impls/livescript/env.ls ================================================ export class Env (outer = null, data = {}) -> @outer = outer @data = data set: (symbol, ast) -> @data[symbol] = ast get: (symbol) -> if symbol of @data then @data[symbol] else if @outer? then @outer.get symbol ================================================ FILE: impls/livescript/error.ls ================================================ ================================================ FILE: impls/livescript/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline.so"; // NOTE: libreadline is GPL //var RL_LIB = "libedit.so"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var koffi = require('koffi'), fs = require('fs'); var koffi_rl = koffi.load(RL_LIB) var rllib = { readline: koffi_rl.func("char *readline(char *prompt)"), add_history: koffi_rl.func("int add_history(char *line)") } var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i switch type | \const => value | \int => value | \string => if print_readably then encode-string value else value | \symbol => value | \keyword => value | \list => '(' + (pr_list value, print_readably) + ')' | \vector => '[' + (pr_list value, print_readably) + ']' | \map => '{' + (pr_map value, print_readably) + '}' | \function => '#' | \atom => '(atom ' + (pr_str value) + ')' encode-string = (str) -> str |> (.replace /[\n\"\\]/g, (ch) -> switch ch | '\n' => '\\n' | '"' => '\\"' | '\\' => '\\\\') |> (enc) -> "\"#{enc}\"" pr_list = (list, print_readably) -> list |> map (ast) -> pr_str ast, print_readably |> join ' ' pr_map_key = (key, print_readably) -> if key.startsWith keyword-prefix key.substring 1 else if print_readably encode-string key else key pr_map = (obj, print_readably) -> obj |> obj-to-pairs |> map ([key, value]) -> key_str = pr_map_key key, print_readably value_str = pr_str value, print_readably key_str + ' ' + value_str |> join ' ' ================================================ FILE: impls/livescript/reader.ls ================================================ readline = require 'readline' {id, map, pairs-to-obj} = require 'prelude-ls' {list-to-pairs} = require './utils' export class OnlyComment parse-error = (msg) -> throw new Error msg class Reader (tokens) -> @tokens = tokens @pos = 0 # returns the token at the current position # and increments position. next: -> result = @peek! if result? then @pos += 1 result # just returns the token at the current position. peek: -> if @pos < @tokens.length @tokens[@pos] eof-or-comment = (reader) -> token = reader.peek! if token? and not token.startsWith ';' then parse-error "expected EOF, got '#{token}'" export read_str = (str) -> str |> tokenizer |> (tokens) -> new Reader tokens |> (reader) -> result = read_form reader if token? then parse-error "expected EOF, got '#{token}'" result # This function will take a single string and return an array/list # of all the tokens (strings) in it. tokenizer = (str) -> re = // [\s,]* # whitespace or commas ( ~@ # special two-char ~@ | [\[\]{}()'`~^@] # special single char one of []{}'`~^@ | "(?:\\.| [^\\"])*"? # double-quoted string | ;.* # any seq of chars starting ; | [^\s\[\]{}('"`,;)]+ # seq of non-special chars: symbols, numbers, ) # "true", "false" and "nil". //y tokens = [] while re.lastIndex < str.length idx = re.lastIndex m = re.exec str if not m # Allow whitespace or commas at the end of the input. break if /[\s,]+/.exec str.substring idx parse-error "parse error at character #{idx}" tok = m[1] # Ignore comments. if tok[0] != ';' then tokens.push m[1] tokens read_form = (reader) -> switch reader.peek! | '(' => read_list reader, ')' | '[' => read_list reader, ']' | '{' => read_list reader, '}' | '\'' => read-macro 'quote', reader | '\`' => read-macro 'quasiquote', reader | '~' => read-macro 'unquote', reader | '~@' => read-macro 'splice-unquote', reader | '@' => read-macro 'deref', reader # todo only symbol? | '^' => read-with-meta reader | otherwise => if that? then read_atom reader else parse-error 'expected a form, got EOF' read_list = (reader, end) -> list = [] reader.next! # accept '(', '[' or '{' loop token = reader.peek! if not token? parse-error "expected '#{end}', got EOF" else if token == end reader.next! break list.push read_form reader switch end | ')' => {type: \list, value: list} | ']' => {type: \vector, value: list} | '}' => list-to-map list special_chars = '[]{}\'`~^@' constants = [\true \false \nil] read_atom = (reader) -> token = reader.peek! if token in constants {type: \const, value: reader.next!} else if token.match /^"(?:\\.|[^\\"])*"$/ {type: \string, value: decode-string reader.next!} else if token[0] == '"' parse-error "expected '\"', got EOF" else if token.match /^-?\d+$/ {type: \int, value: parseInt reader.next!} else if token != '~@' and token not in special_chars if token.startsWith ':' {type: \keyword, value: reader.next!} else {type: \symbol, value: reader.next!} else parse-error "expected an atom, got #{token}" decode-string = (str) -> str |> (.slice 1, -1) |> (.replace /\\[\"\\n]/g, (esc) -> switch esc | '\\n' => '\n' | '\\"' => '"' | '\\\\' => '\\') export keyword-prefix = '\u029e' export map-keyword = (key) -> switch key.type | \string => key.value | \keyword => keyword-prefix + key.value | otherwise => parse-error "#{key.type} can't be a map key" export list-to-map = (list) -> if list.length % 2 != 0 parse-error "map should have an even number of elements, got #{list.length}" list-to-pairs list |> map ([key, value]) -> [(map-keyword key), value] |> pairs-to-obj |> (obj) -> {type: \map, value: obj} read-macro = (symbol, reader) -> reader.next! # accept macro start token do type: \list value: * {type: \symbol, value: symbol} * read_form reader read-with-meta = (reader) -> reader.next! # accept ^ meta = read_form reader form = read_form reader do type: \list value: * {type: \symbol, value: 'with-meta'} * form * meta ================================================ FILE: impls/livescript/run ================================================ #!/usr/bin/env bash exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ================================================ FILE: impls/livescript/step0_repl.ls ================================================ readline = require './node_readline' {id} = require 'prelude-ls' READ = id EVAL = id PRINT = id rep = (line) -> PRINT EVAL READ line loop line = readline.readline 'user> ' break if not line? or line == '' console.log rep line # rl = readline.createInterface do # input : process.stdin # output : process.stdout # prompt: 'user> ' # rl.prompt! # rl.on 'line', (line) -> # console.log rep line # rl.prompt! # rl.on 'close', -> # process.exit 0 ================================================ FILE: impls/livescript/step1_read_print.ls ================================================ readline = require './node_readline' {id} = require 'prelude-ls' {read_str, OnlyComment} = require './reader' {pr_str} = require './printer' EVAL = id rep = (line) -> pr_str EVAL read_str line loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch {message}: ex if ex not instanceof OnlyComment console.log message ================================================ FILE: impls/livescript/step2_eval.ls ================================================ readline = require './node_readline' {id, map, Obj} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' repl_env = do '+': type: \function value: (a, b) -> {type: \int, value: a.value + b.value} '-': type: \function value: (a, b) -> {type: \int, value: a.value - b.value} '*': type: \function value: (a, b) -> {type: \int, value: a.value * b.value} '/': type: \function value: (a, b) -> {type: \int, value: parseInt(a.value / b.value)} eval_ast = (repl_env, {type, value}: ast) --> # console.log "EVAL: #{pr_str ast}" switch type | \symbol => result = repl_env[value] if not result? then throw new Error 'symbol not found: ', value result | \list, \vector => result = value |> map eval_ast repl_env if type == \list and result.length != 0 fn = result[0] if fn.type != \function throw new Error fn.value, ' is not a function' fn.value.apply repl_env, result.slice 1 else {type: type, value: result} | \map => {type: \map, value: value |> Obj.map eval_ast repl_env} | otherwise => ast rep = (line) -> line |> read_str |> eval_ast repl_env |> pr_str loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch {message} console.error message ================================================ FILE: impls/livescript/step3_env.ls ================================================ readline = require './node_readline' {id, map, Obj, each} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' repl_env = new Env null, do '+': type: \function value: (a, b) -> {type: \int, value: a.value + b.value} '-': type: \function value: (a, b) -> {type: \int, value: a.value - b.value} '*': type: \function value: (a, b) -> {type: \int, value: a.value * b.value} '/': type: \function value: (a, b) -> {type: \int, value: parseInt(a.value / b.value)} is-symbol = ({type, value}: ast, name) -> type == \symbol and value == name list-to-pairs = (list) -> [0 to (list.length - 2) by 2] \ |> map (idx) -> [list[idx], list[idx+1]] is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] eval_ast = (env, {type, value}: ast) --> dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return {type: \vector, value: value |> map eval_ast env} | \map => return {type: \map, value: value |> Obj.map eval_ast env} | otherwise => return ast if value.length == 0 then ast else if value[0].type == \symbol params = value[1 to] switch value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | otherwise => eval_apply env, value else eval_apply env, value check_params = (name, params, expected) -> if params.length != expected throw new Error "#{name} expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol throw new Error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] throw new Error "expected 1st parameter of let* to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 throw new Error "binding list of let* must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol throw new Error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Evaluate the 'body' of let* with the new environment. eval_ast let_env, params[1] eval_apply = (env, list) -> [fn, ...args] = list |> map eval_ast env if fn.type != \function throw new Error fn.value, ' is not a function' fn.value.apply env, args rep = (line) -> line |> read_str |> eval_ast repl_env |> pr_str loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step4_if_fn_do.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns} = require './core' {list-to-pairs} = require './utils' is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} eval_ast = (env, {type, value}: ast) --> dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 then ast else if value[0].type == \symbol params = value[1 to] switch value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | otherwise => eval_apply env, value else eval_apply env, value check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Evaluate the 'body' of let* with the new environment. eval_ast let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" params |> map eval_ast env |> last eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond eval_ast env, params[1] else if params.length > 2 eval_ast env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, do type: \list value: values.slice binds.length # Evaluate the function body with the new environment. eval_ast fn_env, body {type: \function, value: fn_instance} eval_apply = (env, list) -> [fn, ...args] = list |> map eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" fn.value.apply env, args repl_env = new Env for symbol, value of ns repl_env.set symbol, value rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step5_tco.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if value[0].type == \symbol params = value[1 to] switch value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | otherwise => eval_apply env, value else eval_apply env, value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, do type: \list value: values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance} eval_apply = (env, list) -> [fn, ...args] = list |> map eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" fn.value.apply env, args repl_env = new Env for symbol, value of ns repl_env.set symbol, value rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step6_file.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast eval: -> eval_ast env, ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if value[0].type == \symbol params = value[1 to] switch value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | otherwise => eval_apply env, value else eval_apply env, value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, do type: \list value: values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance} eval_apply = (env, list) -> [fn, ...args] = list |> map eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" fn.value.apply env, args repl_env = new Env for symbol, value of ns repl_env.set symbol, value # Evil eval. repl_env.set 'eval', do type: \function value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' # Define load-file. rep ' (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' # Parse program arguments. # The first two (exe and core-file) are, respectively, # the interpreter executable (nodejs or lsc) and the # source file being executed (stepX_*.(ls|js)). [exe, core-file, mal-file, ...argv] = process.argv repl_env.set '*ARGV*', do type: \list value: argv |> map (arg) -> type: \string value: arg if mal-file rep "(load-file \"#{mal-file}\")" else # REPL. loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step7_quote.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast eval: -> eval_ast env, ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} make-symbol = (name) -> {type: \symbol, value: name} make-list = (value) -> {type: \list, value: value} make-call = (name, params) -> make-list [make-symbol name] ++ params is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if value[0].type == \symbol params = value[1 to] switch value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params | 'quasiquote' => eval_quasiquote env, params | otherwise => eval_apply env, value else eval_apply env, value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, make-list values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance} eval_apply = (env, list) -> [fn, ...args] = list |> map eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" fn.value.apply env, args eval_quote = (env, params) -> if params.length != 1 runtime-error "quote expected 1 parameter, got #{params.length}" params[0] eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] quasiquote ast quasiquote = (ast) -> if ast.type in [\symbol, \map] make-call 'quote', [ast] 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 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', [ elt.value[1] acc ] else make-call 'cons', [ quasiquote elt acc ] eval_quasiquote = (env, params) -> new-ast = eval_quasiquoteexpand params defer-tco env, new-ast repl_env = new Env for symbol, value of ns repl_env.set symbol, value # Evil eval. repl_env.set 'eval', do type: \function value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' # Define load-file. rep ' (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' # Parse program arguments. # The first two (exe and core-file) are, respectively, # the interpreter executable (nodejs or lsc) and the # source file being executed (stepX_*.(ls|js)). [exe, core-file, mal-file, ...argv] = process.argv repl_env.set '*ARGV*', do type: \list value: argv |> map (arg) -> type: \string value: arg if mal-file rep "(load-file \"#{mal-file}\")" else # REPL. loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step8_macros.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns, unpack-tco} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast eval: -> eval_ast env, ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} make-symbol = (name) -> {type: \symbol, value: name} make-list = (value) -> {type: \list, value: value} make-call = (name, params) -> make-list [make-symbol name] ++ params is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if ast.value[0].type == \symbol params = ast.value[1 to] switch ast.value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | otherwise => eval_apply env, ast.value else eval_apply env, ast.value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, make-list values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance, is_macro: false} eval_apply = (env, list) -> [first, ...raw_args] = list fn = first |> eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" if fn.is_macro return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) args = raw_args |> map eval_ast env fn.value.apply env, args eval_quote = (env, params) -> if params.length != 1 runtime-error "quote expected 1 parameter, got #{params.length}" params[0] eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] quasiquote ast quasiquote = (ast) -> if ast.type in [\symbol, \map] make-call 'quote', [ast] 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 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', [ elt.value[1] acc ] else make-call 'cons', [ quasiquote elt acc ] eval_quasiquote = (env, params) -> new-ast = eval_quasiquoteexpand params defer-tco env, new-ast eval_defmacro = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of defmacro!, got a #{name.type}" # Evaluate the second parameter. fn = eval_ast env, params[1] if fn.type != \function runtime-error "expected a function for the second parameter of defmacro!, got a #{fn.type}" # Copy fn and mark the function as a macro. macro_fn = fn with is_macro: true env.set name.value, macro_fn repl_env = new Env for symbol, value of ns repl_env.set symbol, value # Evil eval. repl_env.set 'eval', do type: \function value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). # Read, Evaluate, Print rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' # Define load-file. rep ' (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' # Define cond. 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)))))))' # Parse program arguments. # The first two (exe and core-file) are, respectively, # the interpreter executable (nodejs or lsc) and the # source file being executed (stepX_*.(ls|js)). [exe, core-file, mal-file, ...argv] = process.argv repl_env.set '*ARGV*', do type: \list value: argv |> map (arg) -> type: \string value: arg if mal-file rep "(load-file \"#{mal-file}\")" else # REPL. loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/step9_try.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns, unpack-tco} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast eval: -> eval_ast env, ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} make-symbol = (name) -> {type: \symbol, value: name} make-list = (value) -> {type: \list, value: value} make-call = (name, params) -> make-list [make-symbol name] ++ params is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if ast.value[0].type == \symbol params = ast.value[1 to] switch ast.value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | 'try*' => eval_try env, params | otherwise => eval_apply env, ast.value else eval_apply env, ast.value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, make-list values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance, is_macro: false} eval_apply = (env, list) -> [first, ...raw_args] = list fn = first |> eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" if fn.is_macro return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) args = raw_args |> map eval_ast env fn.value.apply env, args eval_quote = (env, params) -> if params.length != 1 runtime-error "quote expected 1 parameter, got #{params.length}" params[0] eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] quasiquote ast quasiquote = (ast) -> if ast.type in [\symbol, \map] make-call 'quote', [ast] 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 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', [ elt.value[1] acc ] else make-call 'cons', [ quasiquote elt acc ] eval_quasiquote = (env, params) -> new-ast = eval_quasiquoteexpand params defer-tco env, new-ast eval_defmacro = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of defmacro!, got a #{name.type}" # Evaluate the second parameter. fn = eval_ast env, params[1] if fn.type != \function runtime-error "expected a function for the second parameter of defmacro!, got a #{fn.type}" # Copy fn and mark the function as a macro. macro_fn = fn with is_macro: true env.set name.value, macro_fn eval_try = (env, params) -> if params.length > 2 runtime-error "'try*' expected 1 or 2 parameters, got #{params.length}" try-form = params[0] if params.length == 1 return eval_ast env, try-form catch-clause = params[1] if catch-clause.type != \list or catch-clause.value.length != 3 or not (is-symbol catch-clause.value[0], 'catch*') or catch-clause.value[1].type != \symbol runtime-error "'try*' expected the second parameter to be of the form (catch* A B)" try eval_ast env, try-form catch error error-symbol = catch-clause.value[1].value error-value = \ if error.message then {type: \string, value: error.message} else error catch-env = new Env env catch-env.set error-symbol, error-value eval_ast catch-env, catch-clause.value[2] repl_env = new Env for symbol, value of ns repl_env.set symbol, value # Evil eval. repl_env.set 'eval', do type: \function value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). # Read, Evaluate, Print rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' # Define load-file. rep ' (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' # Define cond. 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)))))))' # Parse program arguments. # The first two (exe and core-file) are, respectively, # the interpreter executable (nodejs or lsc) and the # source file being executed (stepX_*.(ls|js)). [exe, core-file, mal-file, ...argv] = process.argv repl_env.set '*ARGV*', do type: \list value: argv |> map (arg) -> type: \string value: arg if mal-file rep "(load-file \"#{mal-file}\")" else # REPL. loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/stepA_mal.ls ================================================ readline = require './node_readline' {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' {read_str} = require './reader' {pr_str} = require './printer' {Env} = require './env' {runtime-error, ns, unpack-tco} = require './core' {list-to-pairs} = require './utils' defer-tco = (env, ast) -> type: \tco env: env ast: ast eval: -> eval_ast env, ast is-thruthy = ({type, value}) -> type != \const or value not in [\nil \false] fmap-ast = (fn, {type, value}: ast) --> {type: type, value: fn value} make-symbol = (name) -> {type: \symbol, value: name} make-list = (value) -> {type: \list, value: value} make-call = (name, params) -> make-list [make-symbol name] ++ params is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name eval_ast = (env, {type, value}: ast) --> loop dbgeval = env.get "DEBUG-EVAL" if dbgeval and is-thruthy dbgeval then console.log "EVAL: #{pr_str ast}" switch type | \symbol => return (env.get value or throw new Error "'#{value}' not found") | \list => # Proceed after this switch | \vector => return (ast |> fmap-ast map eval_ast env) | \map => return (ast |> fmap-ast Obj.map eval_ast env) | otherwise => return ast if value.length == 0 return ast else result = if ast.value[0].type == \symbol params = ast.value[1 to] switch ast.value[0].value | 'def!' => eval_def env, params | 'let*' => eval_let env, params | 'do' => eval_do env, params | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | 'try*' => eval_try env, params | otherwise => eval_apply env, ast.value else eval_apply env, ast.value if result.type == \tco env = result.env {type, value}: ast = result.ast else return result check_params = (name, params, expected) -> if params.length != expected runtime-error "'#{name}' expected #{expected} parameters, got #{params.length}" eval_def = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of def!, got a #{name.type}" # Evaluate the second parameter and store # it under name in the env. env.set name.value, (eval_ast env, params[1]) eval_let = (env, params) -> check_params 'let*', params, 2 binding_list = params[0] if binding_list.type not in [\list \vector] runtime-error "expected 1st parameter of 'let*' to be a binding list (or vector), got a #{binding_list.type}" else if binding_list.value.length % 2 != 0 runtime-error "binding list of 'let*' must have an even number of parameters" # Make a new environment with the # current environment as outer. let_env = new Env env # Evaluate all binding values in the # new environment. binding_list.value |> list-to-pairs |> each ([binding_name, binding_value]) -> if binding_name.type != \symbol runtime-error "expected a symbol as binding name, got a #{binding_name.type}" let_env.set binding_name.value, (eval_ast let_env, binding_value) # Defer evaluation of let* body with TCO. defer-tco let_env, params[1] eval_do = (env, params) -> if params.length == 0 runtime-error "'do' expected at least one parameter" [...rest, last-param] = params rest |> each eval_ast env defer-tco env, last-param eval_if = (env, params) -> if params.length < 2 runtime-error "'if' expected at least 2 parameters" else if params.length > 3 runtime-error "'if' expected at most 3 parameters" cond = eval_ast env, params[0] if is-thruthy cond defer-tco env, params[1] else if params.length > 2 defer-tco env, params[2] else {type: \const, value: \nil} eval_fn = (env, params) -> check_params 'fn*', params, 2 if params[0].type not in [\list \vector] runtime-error "'fn*' expected first parameter to be a list or vector." if not all (.type == \symbol), params[0].value runtime-error "'fn*' expected only symbols in the parameters list." binds = params[0].value |> map (.value) vargs = null # Parse variadic bind. if binds.length >= 2 [...rest, amper, name] = binds if amper == '&' and name != '&' binds = rest vargs = name if elem-index '&', binds runtime-error "'fn*' invalid usage of variadic parameters." if (unique binds).length != binds.length runtime-error "'fn*' duplicate symbols in parameters list." body = params[1] fn_instance = (...values) -> if not vargs and values.length != binds.length runtime-error "function expected #{binds.length} parameters, got #{values.length}" else if vargs and values.length < binds.length runtime-error "function expected at least #{binds.length} parameters, got #{values.length}" # Set binds to values in the new env. fn_env = new Env env for [name, value] in (zip binds, values) fn_env.set name, value if vargs fn_env.set vargs, make-list values.slice binds.length # Defer evaluation of the function body to TCO. defer-tco fn_env, body {type: \function, value: fn_instance, is_macro: false} eval_apply = (env, list) -> [first, ...raw_args] = list fn = first |> eval_ast env if fn.type != \function runtime-error "#{fn.value} is not a function, got a #{fn.type}" if fn.is_macro return (defer-tco env, (unpack-tco (fn.value.apply env, raw_args))) args = raw_args |> map eval_ast env fn.value.apply env, args eval_quote = (env, params) -> if params.length != 1 runtime-error "quote expected 1 parameter, got #{params.length}" params[0] eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] quasiquote ast quasiquote = (ast) -> if ast.type in [\symbol, \map] make-call 'quote', [ast] 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 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', [ elt.value[1] acc ] else make-call 'cons', [ quasiquote elt acc ] eval_quasiquote = (env, params) -> new-ast = eval_quasiquoteexpand params defer-tco env, new-ast eval_defmacro = (env, params) -> check_params 'def!', params, 2 # Name is in the first parameter, and is not evaluated. name = params[0] if name.type != \symbol runtime-error "expected a symbol for the first parameter of defmacro!, got a #{name.type}" # Evaluate the second parameter. fn = eval_ast env, params[1] if fn.type != \function runtime-error "expected a function for the second parameter of defmacro!, got a #{fn.type}" # Copy fn and mark the function as a macro. macro_fn = fn with is_macro: true env.set name.value, macro_fn eval_try = (env, params) -> if params.length > 2 runtime-error "'try*' expected 1 or 2 parameters, got #{params.length}" try-form = params[0] if params.length == 1 return eval_ast env, try-form catch-clause = params[1] if catch-clause.type != \list or catch-clause.value.length != 3 or not (is-symbol catch-clause.value[0], 'catch*') or catch-clause.value[1].type != \symbol runtime-error "'try*' expected the second parameter to be of the form (catch* A B)" try eval_ast env, try-form catch error error-symbol = catch-clause.value[1].value error-value = \ if error.message then {type: \string, value: error.message} else error catch-env = new Env env catch-env.set error-symbol, error-value eval_ast catch-env, catch-clause.value[2] repl_env = new Env for symbol, value of ns repl_env.set symbol, value # Evil eval. repl_env.set 'eval', do type: \function value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). # Read, Evaluate, Print rep = (line) -> line |> read_str |> eval_ast repl_env |> (ast) -> pr_str ast, print_readably=true # Define not. rep '(def! not (fn* (x) (if x false true)))' # Define load-file. rep ' (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' # Define cond. 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)))))))' # Parse program arguments. # The first two (exe and core-file) are, respectively, # the interpreter executable (nodejs or lsc) and the # source file being executed (stepX_*.(ls|js)). [exe, core-file, mal-file, ...argv] = process.argv repl_env.set '*ARGV*', do type: \list value: argv |> map (arg) -> type: \string value: arg repl_env.set '*host-language*', {type: \string, value: 'livescript'} if mal-file rep "(load-file \"#{mal-file}\")" else # REPL. rep '(println (str "Mal [" *host-language* "]"))' loop line = readline.readline 'user> ' break if not line? or line == '' try console.log rep line catch error if error.message then console.error error.message else console.error "Error:", pr_str error, print_readably=true ================================================ FILE: impls/livescript/utils.ls ================================================ {map} = require 'prelude-ls' export list-to-pairs = (list) -> [0 to (list.length - 2) by 2] \ |> map (idx) -> [list[idx], list[idx+1]] ================================================ FILE: impls/logo/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Rebuild ucblogo. # * without X libraries so that the executable starts in text mode. # * Add the timems function implemented in C RUN apt -y install autoconf autoconf-archive automake dpkg-dev g++ libncurses-dev RUN sed -i 's/Types: deb$/Types: deb deb-src/' /etc/apt/sources.list.d/ubuntu.sources RUN apt-get -y update RUN cd /tmp \ && apt-get source ucblogo \ && cd /tmp/ucblogo-* \ && autoreconf -f -i \ && ./configure --disable-docs --disable-x11 \ && echo "extern NODE *ltimems(NODE *);" >> globals.h \ && echo "NODE *ltimems(NODE *args) { struct timeval tv; gettimeofday(&tv, NULL); return(make_floatnode(((FLONUM)tv.tv_sec) * 1000.0 + (tv.tv_usec / 1000))); }" >> coms.c \ && sed -i -e 's/^\(.*lthrow.*\)$/\1 {"timems", 0, 0, 0, PREFIX_PRIORITY, ltimems},/' init.c \ && make \ && make install \ && cd /tmp \ && rm -rf /tmp/ucblogo* ENV HOME /mal ================================================ FILE: impls/logo/Makefile ================================================ SOURCES_BASE = readline.lg types.lg reader.lg printer.lg SOURCES_LISP = env.lg core.lg stepA_mal.lg SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: all dist clean all: @true dist: mal.lg mal mal.lg: $(SOURCES) cat $+ | grep -v "^load " > $@ mal: mal.lg echo "#!/usr/bin/env logo" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.lg mal ================================================ FILE: impls/logo/core.lg ================================================ make "global_exception [] to equal_q :a :b case obj_type :a [ [[list vector] if not memberp obj_type :b [list vector] [output "false] make "a seq_val :a make "b seq_val :b if notequalp count :a count :b [output "false] (foreach :a :b [if not equal_q ?1 ?2 [output "false]]) output "true ] [[map] if "map <> obj_type :b [output "false] localmake "ka map_keys :a localmake "kb map_keys :b if notequalp count :ka count :kb [output "false] (foreach :ka map_vals :a [if not equal_q map_get :b ?1 ?2 [output "false]]) output "true ] [else output :a = :b] ] end to |mal_=| :a :b output bool_to_mal equal_q :a :b end to mal_throw :a make "global_exception :a (throw "error "_mal_exception_) end to mal_nil? :a output bool_to_mal ((obj_type :a) = "nil) end to mal_true? :a output bool_to_mal ((obj_type :a) = "true) end to mal_false? :a output bool_to_mal ((obj_type :a) = "false) end to mal_string? :a output bool_to_mal ((obj_type :a) = "string) end to mal_symbol :a output symbol_new string_val :a end to mal_symbol? :a output bool_to_mal ((obj_type :a) = "symbol) end to mal_keyword :a output ifelse "keyword = obj_type :a ":a [keyword_new string_val :a] end to mal_keyword? :a output bool_to_mal ((obj_type :a) = "keyword) end to mal_number? :a output bool_to_mal ((obj_type :a) = "number) end to mal_fn? :a output bool_to_mal memberp obj_type :a [fn nativefn] end to mal_macro? :a output bool_to_mal "macro = obj_type :a end to |mal_pr-str| [:args] output string_new pr_seq :args "true "| | end to mal_str [:args] output string_new pr_seq :args "false " end to mal_prn [:args] print pr_seq :args "true "| | output nil_new end to mal_println [:args] print pr_seq :args "false "| | output nil_new end to |mal_read-string| :str output read_str string_val :str end to mal_readline :prompt localmake "line readline string_val :prompt if :line=[] [output nil_new] output string_new :line end to mal_slurp :str localmake "filename string_val :str openread :filename setread :filename localmake "content " until [eofp] [ make "content word :content readchar ] close :filename output string_new :content end to |mal_<| :a :b output bool_to_mal lessp number_val :a number_val :b end to |mal_<=| :a :b output bool_to_mal lessequalp number_val :a number_val :b end to |mal_>| :a :b output bool_to_mal greaterp number_val :a number_val :b end to |mal_>=| :a :b output bool_to_mal greaterequalp number_val :a number_val :b end to |mal_+| :a :b output number_new sum number_val :a number_val :b end to |mal_-| :a :b output number_new difference number_val :a number_val :b end to |mal_*| :a :b output number_new product number_val :a number_val :b end to |mal_/| :a :b output number_new quotient number_val :a number_val :b end to |mal_time-ms| ; Native function timems is added to coms.c (see Dockerfile) output number_new timems end to mal_list [:args] output list_new :args end to mal_list? :a output bool_to_mal ((obj_type :a) = "list) end to mal_vector [:args] output vector_new :args end to mal_vector? :a output bool_to_mal ((obj_type :a) = "vector) end to |mal_hash-map| [:pairs] output map_assoc :map_empty :pairs end to mal_map? :a output bool_to_mal "map = obj_type :a end to mal_assoc :map [:args] output map_assoc :map :args end to mal_get :map :key if "nil = obj_type :map [output nil_new] localmake "val map_get :map :key if "notfound = obj_type :val [output nil_new] output :val end to mal_contains? :m :k output bool_to_mal "notfound <> obj_type map_get :m :k end to mal_keys :map output list_new map_keys :map end to mal_vals :map output list_new map_vals :map end to mal_sequential? :a output bool_to_mal memberp obj_type :a [list vector] end to mal_cons :a :b output list_new fput :a seq_val :b end to mal_concat [:args] output list_new map.se "seq_val :args end to mal_vec :s output vector_new seq_val :s end to mal_nth :a :i make "a seq_val :a make "i number_val :i if or (:i < 0) (:i >= count :a) [(throw "error [nth: index out of range])] output item (:i + 1) :a end to mal_first :a if "nil = obj_type :a [output nil_new] make "a seq_val :a output ifelse emptyp :a "nil_new [first :a] end to mal_rest :a if "nil = obj_type :a [output list_new []] make "a seq_val :a output list_new ifelse emptyp :a [[]] [butfirst :a] end to mal_empty? :a output bool_to_mal emptyp seq_val :a end to mal_count :a output number_new ifelse "nil = obj_type :a 0 [count seq_val :a] end to mal_apply :f [:args] localmake "callargs map.se [ifelse emptyp ?rest [seq_val ?] [(list ?)]] :args output invoke_fn :f :callargs end to mal_map :f :seq output list_new map [invoke_fn :f (list ?)] seq_val :seq end to mal_conj :a0 [:rest] case obj_type :a0 [ [[list] localmake "newlist seq_val :a0 foreach :rest [make "newlist fput ? :newlist] output list_new :newlist] [[vector] output vector_new sentence seq_val :a0 :rest] [else (throw "error [conj requires list or vector]) ] ] end to mal_seq :a case obj_type :a [ [[string] make "a string_val :a if emptyp :a [output nil_new] localmake "chars [] for [i [count :a] 1 -1] [ make "chars fput string_new item :i :a :chars ] output list_new :chars ] [[list] if emptyp seq_val :a [output nil_new] output :a ] [[vector] make "a seq_val :a if emptyp :a [output nil_new] output list_new :a ] [[nil] output nil_new ] [else (throw "error [seq requires string or list or vector or nil]) ] ] end to mal_atom? :a output bool_to_mal ((obj_type :a) = "atom) end to invoke_fn :f :callargs output case obj_type :f [ [[nativefn] nativefn_apply :f :callargs ] [[fn] fn_apply :f :callargs ] [[macro] macro_apply :f :callargs ] [else (throw "error [Wrong type for apply])] ] end to mal_swap! :atom :f [:args] localmake "callargs fput mal_deref :atom :args output mal_reset! :atom invoke_fn :f :callargs end to logo_to_mal :a output cond [ [[memberp :a [true false]] bool_to_mal :a] [[numberp :a] number_new :a] [[wordp :a] string_new :a] [[listp :a] list_new map "logo_to_mal :a] [else nil_new] ] end to |mal_logo-eval| :str localmake "res runresult string_val :str if emptyp :res [output nil_new] output logo_to_mal first :res end make "core_ns [ = throw nil? true? false? string? symbol symbol? keyword keyword? number? fn? macro? pr-str str prn println read-string readline slurp < <= > >= + - * / time-ms list list? vector vector? hash-map map? assoc dissoc get contains? keys vals sequential? cons concat vec nth first rest empty? count apply map conj seq meta with-meta atom atom? deref reset! swap! logo-eval mal_logo_eval ] ================================================ FILE: impls/logo/env.lg ================================================ to env_new :outer :binds :exprs output listtoarray (list :outer :binds :exprs) end to env_keys :env output item 2 :env end to env_get :env :key ; Start with the quick memberp built-in, and only iterate slowly in ; LOGO once a match is found. until [memberp :key item 2 :env] [ make "env item 1 :env if emptyp :env [output notfound_new] ] foreach item 2 :env [if ? = :key [output item # item 3 :env]] end to env_set :env :key :val .setitem 2 :env fput :key item 2 :env .setitem 3 :env fput :val item 3 :env end ================================================ FILE: impls/logo/examples/tree.mal ================================================ ; Draw a tree ; ; The classic Logo demo for recursive functions - now in Mal! ; White background with blue pen (logo-eval "setbackground 7") (logo-eval "setpencolor 1") ; Initialize turtle location (logo-eval "penup setxy 0 -100 pendown") ; Expose Logo drawing functions to Mal code (def! fd (fn* [size] (logo-eval (str "fd " size)))) (def! bk (fn* [size] (logo-eval (str "bk " size)))) (def! lt (fn* [size] (logo-eval (str "lt " size)))) (def! rt (fn* [size] (logo-eval (str "rt " size)))) ; Tree parts (def! leaf (fn* [size] (do (fd size) (bk size)))) (def! branch (fn* [size] (do (fd size) (draw-tree size) (bk size)))) (def! two-branches (fn* [size] (do (lt 10) (branch size) (rt 40) (branch size) (lt 30)))) (def! draw-tree (fn* [size] (if (< size 5) (leaf size) (two-branches (/ size 2))))) ; Draw it (draw-tree 250) ================================================ FILE: impls/logo/printer.lg ================================================ to pr_str :exp :readable output case obj_type :exp [ [[nil] "nil] [[true] "true] [[false] "false] [[number] number_val :exp] [[symbol] symbol_value :exp] [[keyword] word ": keyword_val :exp] [[string] print_string string_val :exp :readable] [[list] (word "\( pr_seq seq_val :exp :readable "| | "\) ) ] [[vector] (word "\[ pr_seq seq_val :exp :readable "| | "\] ) ] [[map] (word "\{ pr_seq (map.se [list ?1 ?2] map_keys :exp map_vals :exp) :readable "| | "\} ) ] [[atom] (word "|(atom | pr_str mal_deref :exp "true "\) ) ] [[nativefn] "#] [[fn] "# ] [[macro] "# ] [else (throw "error (sentence [unknown type] obj_type :exp))] ] end to escape_string :s output map [ case rawascii ? [ [[34 92] word "\\ ?] [[10] "\\n] [else ?] ] ] :s end to print_string :exp :readable ifelse :readable [ output (word "\" escape_string :exp "\" ) ] [ output :exp ] end to pr_seq :seq :readable :delim_char output apply "word map [ ifelse # = 1 [pr_str ? :readable] [word :delim_char pr_str ? :readable] ] :seq end ================================================ FILE: impls/logo/reader.lg ================================================ ; LOGO, variables defined in a procedure are visible from called ; procedures. Use this quirk to pass the current parser status. ; str: the parsed string (constant) ; cnt: its length (constant) ; idx: the currently parsed index, or cnt + 1 make "new_line_char char 10 make "forbidden_chars (word :new_line_char char 13 "| "(),;[\\]{}|) make "separator_chars (word :new_line_char "| ,|) to read_allowed_chars localmake "res " while [:idx <= :cnt] [ localmake "c item :idx :str if memberp :c :forbidden_chars [output :res] make "idx :idx + 1 make "res word :res :c ] output :res end to skip_separators while [:idx <= :cnt] [ localmake "c item :idx :str cond [ [[:c = "|;|] do.until [ make "idx :idx + 1 if :cnt < :idx "stop ] [:new_line_char = item :idx :str] ] [[not memberp :c :separator_chars] stop] ] make "idx :idx + 1 ] end to read_string localmake "res " while [:idx <= :cnt] [ localmake "c item :idx :str make "idx :idx + 1 if :c = "" [output :res] if :c = "\\ [ if :cnt < :idx [(throw "error [unbalananced ""])] make "c item :idx :str make "idx :idx + 1 if :c = "n [make "c :new_line_char] ] make "res word :res :c ] (throw "error [unbalanced ""]) end to read_symbol localmake "token word :c read_allowed_chars output cond [ [[:token = "nil] nil_new] [[memberp :token [false true]] bool_to_mal :token] [[numberp :token] number_new :token] [else symbol_new :token] ] end to read_seq :end_char localmake "res [] forever [ skip_separators if :cnt < :idx [(throw "error (sentence "EOF, "expected :end_char))] if :end_char = item :idx :str [ make "idx :idx + 1 ; reversing once is more efficient than successive lputs. output reverse :res ] make "res fput read_form :res ] end to reader_macro :symbol_name output list_new list symbol_new :symbol_name read_form end to with_meta_reader_macro localmake "meta read_form output list_new (list symbol_new "with-meta read_form :meta) end to read_unquote if :idx <= :cnt [if "@ = item :idx :str [ make "idx :idx + 1 output reader_macro "splice-unquote ]] output reader_macro "unquote end to read_form skip_separators if :cnt < :idx [(throw "error [EOF, expected a form])] localmake "c item :idx :str make "idx :idx + 1 output case :c [ [' reader_macro "quote ] [` reader_macro "quasiquote ] [~ read_unquote ] [^ with_meta_reader_macro ] [@ reader_macro "deref ] [|(| list_new read_seq "|)|] [|[| vector_new read_seq "|]|] [|{| map_assoc :map_empty read_seq "|}|] [|)]}| (throw "error (sentence "unexpected "' :c "'))] [" string_new read_string] [: keyword_new read_allowed_chars] [else read_symbol ] ] end to read_str :str localmake "idx 1 localmake "cnt count :str output read_form end ================================================ FILE: impls/logo/readline.lg ================================================ make "backspace_char char 8 to readline :prompt type :prompt wait 0 ; flush standard output localmake "line " forever [ localmake "c readchar ifelse emptyp :c [ output [] ] [ case rawascii :c [ [[4] output []] [[10] type :c output :line] [[127] if not emptyp :line [ (type :backspace_char "| | :backspace_char) make "line butlast :line ]] [else type :c make "line word :line :c] ] ] ] end ================================================ FILE: impls/logo/run ================================================ #!/usr/bin/env bash exec ucblogo $(dirname $0)/${STEP:-stepA_mal}.lg - "${@}" ================================================ FILE: impls/logo/step0_repl.lg ================================================ load "../logo/readline.lg to _read :str output :str end to _eval :ast output :ast end to _print :exp output :exp end to rep :str output _print _eval _read :str end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ print rep :line ] ] [:line = []] (print) end repl bye ================================================ FILE: impls/logo/step1_read_print.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg to _read :str output read_str :str end to _eval :ast output :ast end to _print :exp output pr_str :exp "true end to rep :str output _print _eval _read :str end to print_exception :exception if not emptyp :exception [ (print "Error: item 2 :exception) ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end repl bye ================================================ FILE: impls/logo/step2_eval.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg to _read :str output read_str :str end to _eval :ast :env ; (print "EVAL: _print :ast) case obj_type :ast [ [[symbol] localmake "val map_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast localmake "f _eval :a0 :env output nativefn_apply :f map [_eval ? :env] :ast ] [else output :ast] ] end to _print :exp output pr_str :exp "true end to rep :str output _print _eval _read :str :repl_env end to mal_add :a :b output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b output number_new ((number_val :a) / (number_val :b)) end to print_exception :exception if not emptyp :exception [ (print "Error: item 2 :exception) ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end make "repl_env map_assoc :map_empty (list symbol_new "+ nativefn_new "mal_add symbol_new "- nativefn_new "mal_sub symbol_new "* nativefn_new "mal_mul symbol_new "/ nativefn_new "mal_div) repl bye ================================================ FILE: impls/logo/step3_env.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg to _read :str output read_str :str end to _eval :ast :env if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] output _eval item 2 :ast :letenv ] [else localmake "f _eval :a0 :env output nativefn_apply :f map [_eval ? :env] :ast ] ] ] [else output :ast] ] end to _print :exp output pr_str :exp "true end to rep :str output _print _eval _read :str :repl_env end to mal_add :a :b output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b output number_new ((number_val :a) / (number_val :b)) end to print_exception :exception if not emptyp :exception [ (print "Error: item 2 :exception) ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end make "repl_env env_new [] map "symbol_new [+ - * / ] ~ map "nativefn_new [mal_add mal_sub mal_mul mal_div] repl bye ================================================ FILE: impls/logo/step4_if_fn_do.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to _eval :ast :env if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] output _eval item 2 :ast :letenv ] [[do] foreach :ast [ ifelse emptyp ?rest [output _eval ? :env] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ output _eval item 3 :ast :env ] [ output nil_new ]] [else output _eval item 2 :ast :env] ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] output _eval fn_body :f fn_gen_env :f map [_eval ? :env] :ast ] [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ (print "Error: item 2 :exception) ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end ; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| repl bye ================================================ FILE: impls/logo/step5_tco.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ (print "Error: item 2 :exception) ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end ; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| repl bye ================================================ FILE: impls/logo/step6_file.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ (print "Error: :e) ] ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end to mal_eval :a output _eval :a :repl_env end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] env_set :repl_env symbol_new "eval nativefn_new "mal_eval env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| ifelse emptyp :command.line [ repl ] [ catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error ] bye ================================================ FILE: impls/logo/step7_quote.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to quasiquote :ast case obj_type :ast [ [[list] localmake "xs seq_val ast if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ output item 2 :xs ]] output qq_seq :xs] [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] [[map symbol] output list_new (list symbol_new "quote :ast)] [else output :ast] ] end to qq_seq :xs localmake "result list_new [] foreach reverse :xs [make "result qq_folder ? :result] output :result end to qq_folder :elt :acc if "list = obj_type :elt [ localmake "ys seq_val :elt if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ output list_new (list symbol_new "concat item 2 :ys :acc) ]] ] output list_new (list symbol_new "cons quasiquote :elt :acc) end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[quote] output first :ast] [[quasiquote] make "ast quasiquote first :ast ] ; TCO [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ (print "Error: :e) ] ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end to mal_eval :a output _eval :a :repl_env end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] env_set :repl_env symbol_new "eval nativefn_new "mal_eval env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| ifelse emptyp :command.line [ repl ] [ catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error ] bye ================================================ FILE: impls/logo/step8_macros.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to quasiquote :ast case obj_type :ast [ [[list] localmake "xs seq_val ast if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ output item 2 :xs ]] output qq_seq :xs] [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] [[map symbol] output list_new (list symbol_new "quote :ast)] [else output :ast] ] end to qq_seq :xs localmake "result list_new [] foreach reverse :xs [make "result qq_folder ? :result] output :result end to qq_folder :elt :acc if "list = obj_type :elt [ localmake "ys seq_val :elt if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ output list_new (list symbol_new "concat item 2 :ys :acc) ]] ] output list_new (list symbol_new "cons quasiquote :elt :acc) end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[quote] output first :ast] [[quasiquote] make "ast quasiquote first :ast ] ; TCO [[defmacro!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "macro_fn macro_new _eval :a2 :env env_set :env :a1 :macro_fn output :macro_fn ] [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [[macro] make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ (print "Error: :e) ] ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end to mal_eval :a output _eval :a :repl_env end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] env_set :repl_env symbol_new "eval nativefn_new "mal_eval env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| ifelse emptyp :command.line [ repl ] [ catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error ] bye ================================================ FILE: impls/logo/step9_try.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to quasiquote :ast case obj_type :ast [ [[list] localmake "xs seq_val ast if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ output item 2 :xs ]] output qq_seq :xs] [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] [[map symbol] output list_new (list symbol_new "quote :ast)] [else output :ast] ] end to qq_seq :xs localmake "result list_new [] foreach reverse :xs [make "result qq_folder ? :result] output :result end to qq_folder :elt :acc if "list = obj_type :elt [ localmake "ys seq_val :elt if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ output list_new (list symbol_new "concat item 2 :ys :acc) ]] ] output list_new (list symbol_new "cons quasiquote :elt :acc) end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[quote] output first :ast] [[quasiquote] make "ast quasiquote first :ast ] ; TCO [[defmacro!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "macro_fn macro_new _eval :a2 :env env_set :env :a1 :macro_fn output :macro_fn ] [[try*] localmake "a1 first :ast ifelse 1 = count :ast [ make "ast :a1 ; TCO ] [ localmake "result nil_new localmake "result nil_new catch "error [make "result _eval :a1 :env] localmake "exception error ifelse emptyp :exception [ output :result ] [ localmake "e item 2 :exception localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] localmake "a2 seq_val item 2 :ast localmake "catchenv env_new :env [] [] env_set :catchenv item 2 :a2 :exception_obj make "env :catchenv make "ast item 3 :a2 ; TCO ] ] ] [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [[macro] make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ (print "Error: :e) ] ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end to mal_eval :a output _eval :a :repl_env end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] env_set :repl_env symbol_new "eval nativefn_new "mal_eval env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself re "|(def! not (fn* (a) (if a false true)))| re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| ifelse emptyp :command.line [ repl ] [ catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error ] bye ================================================ FILE: impls/logo/stepA_mal.lg ================================================ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg load "../logo/types.lg load "../logo/env.lg load "../logo/core.lg to _read :str output read_str :str end to quasiquote :ast case obj_type :ast [ [[list] localmake "xs seq_val ast if not emptyp :xs [if equal_q first :xs symbol_new "unquote [ output item 2 :xs ]] output qq_seq :xs] [[vector] output list_new (list symbol_new "vec qq_seq seq_val :ast)] [[map symbol] output list_new (list symbol_new "quote :ast)] [else output :ast] ] end to qq_seq :xs localmake "result list_new [] foreach reverse :xs [make "result qq_folder ? :result] output :result end to qq_folder :elt :acc if "list = obj_type :elt [ localmake "ys seq_val :elt if not emptyp :ys [if equal_q first :ys symbol_new "splice-unquote [ output list_new (list symbol_new "concat item 2 :ys :acc) ]] ] output list_new (list symbol_new "cons quasiquote :elt :acc) end to _eval :ast :env forever [ if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ (print "EVAL: _print :ast "/ map "_print env_keys :env) ] case obj_type :ast [ [[symbol] localmake "val env_get :env :ast if "notfound = obj_type :val [ (throw "error sentence (word "' symbol_value :ast "') [not found]) ] output :val ] [[vector] output vector_new map [_eval ? :env] seq_val :ast] [[map] output map_map [_eval ? :env] :ast] [[list] make "ast seq_val :ast if emptyp :ast [output list_new []] localmake "a0 first :ast make "ast butfirst :ast case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ [[def!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "val _eval :a2 :env env_set :env :a1 :val output :val ] [[let*] localmake "a1 first :ast localmake "letenv env_new :env [] [] foreach seq_val first :ast [ if 1 = modulo # 2 [ env_set :letenv ? _eval first ?rest :letenv ] ] make "env :letenv make "ast item 2 :ast ] ; TCO [[quote] output first :ast] [[quasiquote] make "ast quasiquote first :ast ] ; TCO [[defmacro!] localmake "a1 first :ast localmake "a2 item 2 :ast localmake "macro_fn macro_new _eval :a2 :env env_set :env :a1 :macro_fn output :macro_fn ] [[try*] localmake "a1 first :ast ifelse 1 = count :ast [ make "ast :a1 ; TCO ] [ localmake "result nil_new localmake "result nil_new catch "error [make "result _eval :a1 :env] localmake "exception error ifelse emptyp :exception [ output :result ] [ localmake "e item 2 :exception localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] localmake "a2 seq_val item 2 :ast localmake "catchenv env_new :env [] [] env_set :catchenv item 2 :a2 :exception_obj make "env :catchenv make "ast item 3 :a2 ; TCO ] ] ] [[do] foreach :ast [ ; TCO for last item ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] ] [[if] localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ [[nil false] ifelse 3 = count :ast [ make "ast item 3 :ast ; TCO ] [ output nil_new ]] [else make "ast item 2 :ast] ; TCO ]] [[fn*] output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [[macro] make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] ] ] [else output :ast] ] ] end to _print :exp output pr_str :exp "true end to re :str ignore _eval _read :str :repl_env end to rep :str output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ (print "Error: :e) ] ] end to repl do.until [ localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] ] [:line = []] (print) end to mal_eval :a output _eval :a :repl_env end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] env_set :repl_env symbol_new "eval nativefn_new "mal_eval env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself re "|(def! *host-language* "logo")| re "|(def! not (fn* (a) (if a false true)))| re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))| ifelse emptyp :command.line [ re "|(println (str "Mal [" *host-language* "]"))| repl ] [ catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error ] bye ================================================ FILE: impls/logo/tests/stepA_mal.mal ================================================ ;; Testing basic Logo interop (logo-eval "7") ;=>7 (logo-eval "\"hello") ;=>"hello" (logo-eval "[7 8 9]") ;=>(7 8 9) (logo-eval "123 = 123") ;=>true (logo-eval "not emptyp []") ;=>false (logo-eval "print [hello world]") ;/hello world ;=>nil (logo-eval "make \"foo 8") (logo-eval ":foo") ;=>8 (logo-eval "apply \"word map \"reverse [Abc Abcd Abcde]") ;=>"cbAdcbAedcbA" (logo-eval "map [1 + ?] [1 2 3]") ;=>(2 3 4) ================================================ FILE: impls/logo/types.lg ================================================ ; Make Logo's string-comparison case sensitive make "caseignoredp "false ; Load the 'case' library macro case "dummy [] ; Redefine 'case' macro to not override caseignoredp .macro case :case.value :case.clauses catch "case.error [output case.helper :case.value :case.clauses] (throw "error [Empty CASE clause]) end ; For efficiency of env_get and map_get, ensure that MAL equality ; (equal_q) and LOGO equality (equalp/=) return the same result when ; an argument is neither a list, map, vector or atom. to obj_type :obj output ifelse wordp :obj ""number [item 1 :obj] end to list_new :val output list "list :val end to vector_new :val output list "vector :val end to seq_val :obj output item 2 :obj end to |mal_with-meta| :obj :meta output (listtoarray fput :meta ifelse listp :obj [ :obj ] [ butfirst arraytolist :obj ] 0) end to mal_meta :obj output ifelse listp :obj "nil_new [item 0 :obj] end ; Convenient for map_get and env_get. make "global_notfound [notfound] to notfound_new output :global_notfound end make "global_nil [nil] to nil_new output :global_nil end make "global_false [false] make "global_true [true] to bool_to_mal :bool output ifelse :bool ":global_true ":global_false end to number_new :val output :val end to number_val :obj output :obj end to symbol_new :name output list "symbol :name end to symbol_value :obj output item 2 :obj end to keyword_new :val output list "keyword :val end to keyword_val :obj output item 2 :obj end to string_new :val output list "string :val end to string_val :obj output item 2 :obj end to nativefn_new :f output list "nativefn :f end to nativefn_apply :fn :args output apply item 2 :fn :args end make "map_empty [map [] []] to map_get :map :key foreach item 2 :map [if ? = :key [output item # item 3 :map]] output notfound_new end ; Returns a new list with the key-val pair set to map_assoc :map :pairs foreach :pairs [ if 1 = modulo # 2 [ if memberp ? item 2 :map [make "map (mal_dissoc :map ?)] make "map (list "map fput ? item 2 :map fput first ?rest item 3 :map) ] ] output :map end ; Returns a new list without the key-val pair set to mal_dissoc :map [:removals] localmake "keys [] localmake "vals [] (foreach item 2 :map item 3 :map [ if not memberp ?1 :removals [ make "keys fput ?1 :keys make "vals fput ?2 :vals ] ]) output (list "map :keys :vals) end to map_keys :map output item 2 :map end to map_vals :map output item 3 :map end to map_map :fn :map output (list "map item 2 :map map :fn item 3 :map) end to fn_new :args :env :body localmake "i difference count :args 1 if 0 < :i [if equalp symbol_new "& item :i :args [ output (list "fn :env :body :i filter [# <> :i] :args) ]] output (list "fn :env :body 0 :args) end to fn_gen_env :fn :args localmake "varargs item 4 :fn if :varargs = 0 [output env_new item 2 :fn item 5 :fn :args] if :varargs = 1 [output env_new item 2 :fn item 5 :fn (list list_new :args)] localmake "new_args array :varargs foreach :args [ .setitem # :new_args ? if :varargs = # + 1 [ .setitem :varargs :new_args list_new ?rest output env_new item 2 :fn item 5 :fn :new_args ] ] (throw "error [not enough arguments for vararg function]) end to fn_apply :fn :args output _eval item 3 :fn fn_gen_env :fn :args end to fn_env :fn output item 2 :fn end to fn_body :fn output item 3 :fn end to macro_new :fn output list "macro :fn end to macro_apply :fn :args output fn_apply item 2 :fn :args end to mal_atom :value output listtoarray list "atom :value end to mal_deref :a output item 2 :a end to mal_reset! :a :val .setitem 2 :a :val output :val end ================================================ FILE: impls/lua/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # luarocks 3.8.0+dfsg1-1 only supports 5.1 5.2 5.3, # and its dependencies default on 5.1 if no version is available. # Explicitly install the desired version before luarocks. RUN apt-get -y install liblua5.3-dev lua5.3 RUN apt-get -y install gcc libpcre3-dev luarocks # luarocks .cache directory is relative to HOME ENV HOME /mal ================================================ FILE: impls/lua/Makefile ================================================ SOURCES_BASE = utils.lua types.lua reader.lua printer.lua SOURCES_LISP = env.lua core.lua stepA_mal.lua SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) libraries := linenoise.so rex_pcre.so linenoise.so_package := linenoise rex_pcre.so_package := lrexlib-pcre all: $(libraries) dist: mal.lua mal SOURCE_NAMES = $(patsubst %.lua,%,$(SOURCES)) mal.lua: $(SOURCES) echo "local $(foreach n,$(SOURCE_NAMES),$(n),) M" > $@ echo "M={} $(foreach n,$(SOURCE_NAMES),$(n)=M);" >> $@ cat $+ | grep -v -e "return M$$" \ -e "return Env" \ -e "local M =" \ -e "^#!" \ $(foreach n,$(SOURCE_NAMES),-e "require('$(n)')") >> $@ mal: mal.lua echo "#!/usr/bin/env lua" > $@ cat $< >> $@ chmod +x $@ clean: rm -f $(libraries) mal.lua mal rm -rf lib $(libraries): luarocks install --tree=./ $($@_package) find . -name $@ | xargs ln -s ================================================ FILE: impls/lua/core.lua ================================================ local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local readline = require('readline') local Nil, List, HashMap, _pr_str = types.Nil, types.List, types.HashMap, printer._pr_str local M = {} -- string functions function pr_str(...) return printer._pr_seq(table.pack(...), true, " ") end function str(...) return printer._pr_seq(table.pack(...), false, "") end function prn(...) print(printer._pr_seq(table.pack(...), true, " ")) io.flush() return Nil end function println(...) print(printer._pr_seq(table.pack(...), false, " ")) io.flush() return Nil end function slurp(file) local lines = {} for line in io.lines(file) do lines[#lines+1] = line end return table.concat(lines, "\n") .. "\n" end function do_readline(prompt) local line = readline.readline(prompt) if line == nil then return Nil else return line end end -- hash map functions function assoc(hm, ...) return types._assoc_BANG(types.copy(hm), ...) end function dissoc(hm, ...) return types._dissoc_BANG(types.copy(hm), ...) end function get(hm, key) local res = hm[key] if res == nil then return Nil end return res end function keys(hm) local res = {} for k,v in pairs(hm) do res[#res+1] = k end return List:new(res) end function vals(hm) local res = {} for k,v in pairs(hm) do res[#res+1] = v end return List:new(res) end -- sequential functions function cons(a,lst) local new_lst = lst:slice(1) table.insert(new_lst, 1, a) return List:new(new_lst) end function concat(...) local arg = table.pack(...) local new_lst = {} for i = 1, #arg do for j = 1, #arg[i] do table.insert(new_lst, arg[i][j]) end end return List:new(new_lst) end function vec(a) return types.Vector:new(types.copy(a)) end function nth(seq, idx) if idx+1 <= #seq then return seq[idx+1] else types.throw("nth: index out of range") end end function first(a) if #a == 0 then return Nil else return a[1] end end function rest(a) if a == Nil then return List:new() else return List:new(a:slice(2)) end end function apply(f, ...) local arg = table.pack(...) if types._malfunc_Q(f) then f = f.fn end local args = concat(types.slice(arg, 1, #arg-1), arg[#arg]) return f(table.unpack(args)) end function map(f, lst) if types._malfunc_Q(f) then f = f.fn end return List:new(utils.map(f, lst)) end -- metadata functions function meta(obj) local m = getmetatable(obj) if m == nil or m.meta == nil then return Nil end return m.meta end function with_meta(obj, meta) local new_obj = types.copy(obj) getmetatable(new_obj).meta = meta return new_obj end -- atom functions function swap_BANG(atm,f,...) if types._malfunc_Q(f) then f = f.fn end local args = List:new(table.pack(...)) table.insert(args, 1, atm.val) atm.val = f(table.unpack(args)) return atm.val end local function conj(obj, ...) local arg = table.pack(...) local new_obj = types.copy(obj) if types._list_Q(new_obj) then for i, v in ipairs(arg) do table.insert(new_obj, 1, v) end else for i, v in ipairs(arg) do table.insert(new_obj, v) end end return new_obj end local function seq(obj, ...) if obj == Nil or #obj == 0 then return Nil elseif types._list_Q(obj) then return obj elseif types._vector_Q(obj) then return List:new(obj) elseif types._string_Q(obj) then local chars = {} for i = 1, #obj do chars[#chars+1] = string.sub(obj,i,i) end return List:new(chars) end return Nil end local function lua_to_mal(a) if a == nil then return Nil elseif type(a) == "boolean" or type(a) == "number" or type(a) == "string" then return a elseif type(a) == "table" then local first_key, _ = next(a) if first_key == nil then return List:new({}) elseif type(first_key) == "number" then local list = {} for i, v in ipairs(a) do list[i] = lua_to_mal(v) end return List:new(list) else local hashmap = {} for k, v in pairs(a) do hashmap[lua_to_mal(k)] = lua_to_mal(v) end return HashMap:new(hashmap) end end return tostring(a) end local function lua_eval(str) local f, err = load("return "..str) if err then types.throw("lua-eval: can't load code: "..err) end return lua_to_mal(f()) end M.ns = { ['='] = types._equal_Q, throw = types.throw, ['nil?'] = function(a) return a==Nil end, ['true?'] = function(a) return a==true end, ['false?'] = function(a) return a==false end, ['number?'] = function(a) return types._number_Q(a) end, symbol = function(a) return types.Symbol:new(a) end, ['symbol?'] = function(a) return types._symbol_Q(a) end, ['string?'] = function(a) return types._string_Q(a) end, keyword = function(a) if types._keyword_Q(a) then return a else return types._keyword_from_lua_string(a) end end, ['keyword?'] = function(a) return types._keyword_Q(a) end, ['fn?'] = function(a) return types._fn_Q(a) end, ['macro?'] = function(a) return types._macro_Q(a) end, ['pr-str'] = pr_str, str = str, prn = prn, println = println, ['read-string'] = reader.read_str, readline = do_readline, slurp = slurp, ['<'] = function(a,b) return a'] = function(a,b) return a>b end, ['>='] = function(a,b) return a>=b end, ['+'] = function(a,b) return a+b end, ['-'] = function(a,b) return a-b end, ['*'] = function(a,b) return a*b end, ['/'] = function(a,b) return math.floor(a/b) end, ['time-ms'] = function() return math.floor(os.clock()*1000000) end, list = function(...) return List:new(table.pack(...)) end, ['list?'] = function(a) return types._list_Q(a) end, vector = function(...) return types.Vector:new(table.pack(...)) end, ['vector?'] = types._vector_Q, ['hash-map'] = types.hash_map, ['map?'] = types._hash_map_Q, assoc = assoc, dissoc = dissoc, get = get, ['contains?'] = function(a,b) return a[b] ~= nil end, keys = keys, vals = vals, ['sequential?'] = types._sequential_Q, cons = cons, concat = concat, vec = vec, nth = nth, first = first, rest = rest, ['empty?'] = function(a) return a==Nil or #a == 0 end, count = function(a) return #a end, apply = apply, map = map, conj = conj, seq = seq, meta = meta, ['with-meta'] = with_meta, atom = function(a) return types.Atom:new(a) end, ['atom?'] = types._atom_Q, deref = function(a) return a.val end, ['reset!'] = function(a,b) a.val = b; return b end, ['swap!'] = swap_BANG, ['lua-eval'] = lua_eval, } return M ================================================ FILE: impls/lua/env.lua ================================================ local table = require('table') local types = require('types') local printer = require('printer') local Env = {} function Env:new(outer, binds, exprs) -- binds is a MAL sequence of MAL symbols -- exprs is an LUA table of MAL forms local data = {} local newObj = {outer = outer, data = data} self.__index = self if binds then for i, b in ipairs(binds) do if binds[i].val == '&' then data[binds[i+1].val] = types.List.slice(exprs, i) break end data[binds[i].val] = exprs[i] end end return setmetatable(newObj, self) end function Env:get(sym) -- sym is an LUA string -- returns nil if the key is not found local env = self local result while true do result = env.data[sym] if result ~= nil then return result end env = env.outer if env == nil then return nil end end end function Env:set(sym,val) -- sym is an LUA string self.data[sym] = val return val end function Env:debug() local env = self while env.outer ~=nil do line = ' ENV:' for k, v in pairs(env.data) do line = line .. ' ' .. k .. '=' .. printer._pr_str(v) end print(line) env = env.outer end end return Env ================================================ FILE: impls/lua/printer.lua ================================================ local string = require('string') local table = require('table') local types = require('types') local utils = require('utils') local M = {} function M._pr_str(obj, print_readably) if utils.instanceOf(obj, types.Symbol) then return obj.val elseif types._list_Q(obj) then return "(" .. M._pr_seq(obj, print_readably, " ") .. ")" elseif types._vector_Q(obj) then return "[" .. M._pr_seq(obj, print_readably, " ") .. "]" elseif types._hash_map_Q(obj) then local res = {} for k,v in pairs(obj) do res[#res+1] = M._pr_str(k, print_readably) res[#res+1] = M._pr_str(v, print_readably) end return "{".. table.concat(res, " ").."}" elseif types._keyword_Q(obj) then return ':' .. types._lua_string_from_keyword(obj) elseif types._string_Q(obj) then if print_readably then local sval = obj:gsub('\\', '\\\\') sval = sval:gsub('"', '\\"') sval = sval:gsub('\n', '\\n') return '"' .. sval .. '"' else return obj end elseif obj == types.Nil then return "nil" elseif obj == true then return "true" elseif obj == false then return "false" elseif types._malfunc_Q(obj) then return "(fn* "..M._pr_str(obj.params).." "..M._pr_str(obj.ast)..")" elseif types._atom_Q(obj) then return "(atom "..M._pr_str(obj.val)..")" elseif type(obj) == 'function' or types._functionref_Q(obj) then return "#" else return string.format("%s", obj) end end function M._pr_seq(obj, print_readably, separator) return table.concat( utils.map(function(e) return M._pr_str(e,print_readably) end, obj), separator) end return M ================================================ FILE: impls/lua/reader.lua ================================================ local rex = require('rex_pcre') local string = require('string') local table = require('table') local types = require('types') local throw, Nil, Symbol, List = types.throw, types.Nil, types.Symbol, types.List local M = {} Reader = {} function Reader:new(tokens) local newObj = {tokens = tokens, position = 1} self.__index = self return setmetatable(newObj, self) end function Reader:next() self.position = self.position + 1 return self.tokens[self.position-1] end function Reader:peek() return self.tokens[self.position] end function M.tokenize(str) local results = {} local re_pos = 1 local re = rex.new("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)", rex.flags().EXTENDED) while true do local s, e, t = re:exec(str, re_pos) if not s or s > e then break end re_pos = e + 1 local val = string.sub(str,t[1],t[2]) if string.sub(val,1,1) ~= ";" then table.insert(results, val) end end return results end function M.read_atom(rdr) local int_re = rex.new("^-?[0-9]+$") local float_re = rex.new("^-?[0-9][0-9.]*$") local string_re = rex.new("^\"(?:\\\\.|[^\\\\\"])*\"$") local token = rdr:next() if int_re:exec(token) then return tonumber(token) elseif float_re:exec(token) then return tonumber(token) elseif string_re:exec(token) then local sval = string.sub(token,2,string.len(token)-1) sval = string.gsub(sval, '\\\\', '\u{029e}') sval = string.gsub(sval, '\\"', '"') sval = string.gsub(sval, '\\n', '\n') sval = string.gsub(sval, '\u{029e}', '\\') return sval elseif string.sub(token,1,1) == '"' then throw("expected '\"', got EOF") elseif string.sub(token,1,1) == ':' then return types._keyword_from_lua_string(string.sub(token,2)) elseif token == "nil" then return Nil elseif token == "true" then return true elseif token == "false" then return false else return Symbol:new(token) end end function M.read_sequence(rdr, start, last) local ast = {} local token = rdr:next() if token ~= start then throw("expected '"..start.."'") end token = rdr:peek() while token ~= last do if not token then throw("expected '"..last.."', got EOF") end table.insert(ast, M.read_form(rdr)) token = rdr:peek() end rdr:next() return ast end function M.read_list(rdr) return types.List:new(M.read_sequence(rdr, '(', ')')) end function M.read_vector(rdr) return types.Vector:new(M.read_sequence(rdr, '[', ']')) end function M.read_hash_map(rdr) local seq = M.read_sequence(rdr, '{', '}') return types.hash_map(table.unpack(seq)) end function M.read_form(rdr) local token = rdr:peek() if "'" == token then rdr:next() return List:new({Symbol:new('quote'), M.read_form(rdr)}) elseif '`' == token then rdr:next() return List:new({Symbol:new('quasiquote'), M.read_form(rdr)}) elseif '~' == token then rdr:next() return List:new({Symbol:new('unquote'), M.read_form(rdr)}) elseif '~@' == token then rdr:next() return List:new({Symbol:new('splice-unquote'), M.read_form(rdr)}) elseif '^' == token then rdr:next() local meta = M.read_form(rdr) return List:new({Symbol:new('with-meta'), M.read_form(rdr), meta}) elseif '@' == token then rdr:next() return List:new({Symbol:new('deref'), M.read_form(rdr)}) elseif ')' == token then throw("unexpected ')'") elseif '(' == token then return M.read_list(rdr) elseif ']' == token then throw("unexpected ']'") elseif '[' == token then return M.read_vector(rdr) elseif '}' == token then throw("unexpected '}'") elseif '{' == token then return M.read_hash_map(rdr) else return M.read_atom(rdr) end end function M.read_str(str) local tokens = M.tokenize(str) if #tokens == 0 then error(nil) end return M.read_form(Reader:new(tokens)) end return M ================================================ FILE: impls/lua/readline.lua ================================================ local LN = require('linenoise') local M = {} local history_loaded = false local history_file = os.getenv("HOME") .. "/.mal-history" M.raw = false function M.readline(prompt) if not history_loaded then history_loaded = true xpcall(function() for line in io.lines(history_file) do LN.historyadd(line) end end, function(exc) return true -- ignore the error end) end if M.raw then io.write(prompt); io.flush(); line = io.read() else line = LN.linenoise(prompt) end if line then LN.historyadd(line) xpcall(function() local f = io.open(history_file, "a") f:write(line.."\n") f:close() end, function(exc) return true -- ignore the error end) end return line end return M ================================================ FILE: impls/lua/run ================================================ #!/usr/bin/env bash exec lua $(dirname $0)/${STEP:-stepA_mal}.lua "${@}" ================================================ FILE: impls/lua/step0_repl.lua ================================================ #!/usr/bin/env lua local readline = require('readline') function READ(str) return str end function EVAL(ast, any) return ast end function PRINT(exp) return exp end function rep(str) return PRINT(EVAL(READ(str),"")) end if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end print(rep(line)) end ================================================ FILE: impls/lua/step1_read_print.lua ================================================ #!/usr/bin/env lua local readline = require('readline') local types = require('types') local reader = require('reader') local printer = require('printer') -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) return ast end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl function rep(str) return PRINT(EVAL(READ(str),"")) end if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step2_eval.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) -- print("EVAL: " .. printer._pr_str(ast, true)) if types._symbol_Q(ast) then if env[ast.val] == nil then types.throw("'"..ast.val.."' not found") end return env[ast.val] elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local f = EVAL(ast[1], env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) return f(table.unpack(args)) end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = {['+'] = function(a,b) return a+b end, ['-'] = function(a,b) return a-b end, ['*'] = function(a,b) return a*b end, ['/'] = function(a,b) return math.floor(a/b) end} function rep(str) return PRINT(EVAL(READ(str),repl_env)) end if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step3_env.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local a0,a1,a2 = ast[1], ast[2],ast[3] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end return EVAL(a2, let_env) else local f = EVAL(a0, env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) return f(table.unpack(args)) end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end repl_env:set('+', function(a,b) return a+b end) repl_env:set('-', function(a,b) return a-b end) repl_env:set('*', function(a,b) return a*b end) repl_env:set('/', function(a,b) return math.floor(a/b) end) if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step4_if_fn_do.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end return EVAL(a2, let_env) elseif 'do' == a0sym then local el = utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2)) return el[#el] elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then return EVAL(a3, env) else return types.Nil end else return EVAL(a2, env) end elseif 'fn*' == a0sym then return function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end else local f = EVAL(a0, env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) return f(table.unpack(args)) end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step5_tco.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") if #arg > 0 and arg[1] == "--raw" then readline.raw = true end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step6_file.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end repl_env:set('eval', function(ast) return EVAL(ast, repl_env) end) repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if #arg > 0 and arg[1] == "--raw" then readline.raw = true table.remove(arg,1) end if #arg > 0 then rep("(load-file \""..arg[1].."\")") os.exit(0) end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step7_quote.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval 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 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}) else return ast end end function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'quote' == a0sym then return a1 elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end repl_env:set('eval', function(ast) return EVAL(ast, repl_env) end) repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if #arg > 0 and arg[1] == "--raw" then readline.raw = true table.remove(arg,1) end if #arg > 0 then rep("(load-file \""..arg[1].."\")") os.exit(0) end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step8_macros.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval 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 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}) else return ast end end function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end -- apply list local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'quote' == a0sym then return a1 elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then local mac = types.copy(EVAL(a2, env)) mac.ismacro = true return env:set(a1.val, mac) elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) if types._macro_Q(f) then ast = f.fn(table.unpack(args)) -- TCO else args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end repl_env:set('eval', function(ast) return EVAL(ast, repl_env) end) repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if #arg > 0 and arg[1] == "--raw" then readline.raw = true table.remove(arg,1) end if #arg > 0 then rep("(load-file \""..arg[1].."\")") os.exit(0) end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, function(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end) end ================================================ FILE: impls/lua/step9_try.lua ================================================ #!/usr/bin/env lua local table = require('table') local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval 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 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}) else return ast end end function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end -- apply list local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'quote' == a0sym then return a1 elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then local mac = types.copy(EVAL(a2, env)) mac.ismacro = true return env:set(a1.val, mac) elseif 'try*' == a0sym then if a2 == nil or a2[1].val ~= 'catch*' then ast = a1 -- TCO else local exc, result = nil, nil xpcall(function() result = EVAL(a1, env) end, function(err) exc = err end) if exc == nil then return result else if types._malexception_Q(exc) then exc = exc.val end ast, env = a2[3], Env:new(env, {a2[2]}, {exc}) -- TCO end end elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) if types._macro_Q(f) then ast = f.fn(table.unpack(args)) -- TCO else args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end repl_env:set('eval', function(ast) return EVAL(ast, repl_env) end) repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) -- core.mal: defined using mal rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") function print_exception(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end if #arg > 0 and arg[1] == "--raw" then readline.raw = true table.remove(arg,1) end if #arg > 0 then xpcall(function() rep("(load-file \""..arg[1].."\")") end, print_exception) os.exit(0) end while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, print_exception) end ================================================ FILE: impls/lua/stepA_mal.lua ================================================ #!/usr/bin/env lua local table = require('table') package.path = '../lua/?.lua;' .. package.path local readline = require('readline') local utils = require('utils') local types = require('types') local reader = require('reader') local printer = require('printer') local Env = require('env') local core = require('core') local List, Vector, HashMap = types.List, types.Vector, types.HashMap -- read function READ(str) return reader.read_str(str) end -- eval 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 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}) else return ast end end function EVAL(ast, env) while true do local dbgeval = env:get("DEBUG-EVAL") if dbgeval ~= nil and dbgeval ~= types.Nil and dbgeval ~= false then print("EVAL: " .. printer._pr_str(ast, true)) env:debug() end if types._symbol_Q(ast) then local result = env:get(ast.val) if result == nil then types.throw("'" .. ast.val .. "' not found") end return result elseif types._vector_Q(ast) then return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast)) elseif types._hash_map_Q(ast) then local new_hm = {} for k,v in pairs(ast) do new_hm[k] = EVAL(v, env) end return HashMap:new(new_hm) elseif not types._list_Q(ast) or #ast == 0 then return ast end -- apply list local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4] local a0sym = types._symbol_Q(a0) and a0.val or "" if 'def!' == a0sym then return env:set(a1.val, EVAL(a2, env)) elseif 'let*' == a0sym then local let_env = Env:new(env) for i = 1,#a1,2 do let_env:set(a1[i].val, EVAL(a1[i+1], let_env)) end env = let_env ast = a2 -- TCO elseif 'quote' == a0sym then return a1 elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then local mac = types.copy(EVAL(a2, env)) mac.ismacro = true return env:set(a1.val, mac) elseif 'try*' == a0sym then if a2 == nil or a2[1].val ~= 'catch*' then ast = a1 -- TCO else local exc, result = nil, nil xpcall(function() result = EVAL(a1, env) end, function(err) exc = err end) if exc == nil then return result else if types._malexception_Q(exc) then exc = exc.val end ast, env = a2[3], Env:new(env, {a2[2]}, {exc}) -- TCO end end elseif 'do' == a0sym then utils.map(function(x) return EVAL(x, env) end, types.slice(ast, 2, #ast - 1)) ast = ast[#ast] -- TCO elseif 'if' == a0sym then local cond = EVAL(a1, env) if cond == types.Nil or cond == false then if #ast > 3 then ast = a3 else return types.Nil end -- TCO else ast = a2 -- TCO end elseif 'fn*' == a0sym then return types.MalFunc:new(function(...) return EVAL(a2, Env:new(env, a1, table.pack(...))) end, a2, env, a1) else local f = EVAL(a0, env) local args = types.slice(ast, 2) if types._macro_Q(f) then ast = f.fn(table.unpack(args)) -- TCO else args = utils.map(function(x) return EVAL(x,env) end, args) if types._malfunc_Q(f) then ast = f.ast env = Env:new(f.env, f.params, args) -- TCO else return f(table.unpack(args)) end end end end end -- print function PRINT(exp) return printer._pr_str(exp, true) end -- repl local repl_env = Env:new() function rep(str) return PRINT(EVAL(READ(str),repl_env)) end -- core.lua: defined using Lua for k,v in pairs(core.ns) do repl_env:set(k, v) end repl_env:set('eval', function(ast) return EVAL(ast, repl_env) end) repl_env:set('*ARGV*', types.List:new(types.slice(arg,2))) -- core.mal: defined using mal rep("(def! *host-language* \"lua\")") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") function print_exception(exc) if exc then if types._malexception_Q(exc) then exc = printer._pr_str(exc.val, true) end print("Error: " .. exc) print(debug.traceback()) end end if #arg > 0 and arg[1] == "--raw" then readline.raw = true table.remove(arg,1) end if #arg > 0 then xpcall(function() rep("(load-file \""..arg[1].."\")") end, print_exception) os.exit(0) end rep("(println (str \"Mal [\" *host-language* \"]\"))") while true do line = readline.readline("user> ") if not line then break end xpcall(function() print(rep(line)) end, print_exception) end ================================================ FILE: impls/lua/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 100000)) res1 ;=>nil ================================================ FILE: impls/lua/tests/stepA_mal.mal ================================================ ;; Testing basic Lua interop ;;; lua-eval adds the string "return " to the beginning of the evaluated string ;;; and supplies that to Lua's loadstring(). If complex programs are needed, ;;; those can be wrapped by an anonymous function which is called immediately ;;; (see the foo = 8 example below). (lua-eval "7") ;=>7 (lua-eval "'7'") ;=>"7" (lua-eval "123 == 123") ;=>true (lua-eval "123 == 456") ;=>false (lua-eval "{7,8,9}") ;=>(7 8 9) (lua-eval "{abc = 789}") ;=>{"abc" 789} (lua-eval "print('hello')") ;/hello ;=>nil (lua-eval "(function() foo = 8 end)()") (lua-eval "foo") ;=>8 (lua-eval "string.gsub('This sentence has five words', '%w+', function(w) return '*'..#w..'*' end)") ;=>"*4* *8* *3* *4* *5*" (lua-eval "table.concat({3, 'a', 45, 'b'}, '|')") ;=>"3|a|45|b" ================================================ FILE: impls/lua/types.lua ================================================ local utils = require('utils') local M = {} -- type functions function M._sequential_Q(obj) return M._list_Q(obj) or M._vector_Q(obj) end function M._equal_Q(a,b) if M._symbol_Q(a) and M._symbol_Q(b) then return a.val == b.val elseif M._sequential_Q(a) and M._sequential_Q(b) then if #a ~= #b then return false end for i, v in ipairs(a) do if not M._equal_Q(v,b[i]) then return false end end return true elseif M._hash_map_Q(a) and M._hash_map_Q(b) then if #a ~= #b then return false end for k, v in pairs(a) do if not M._equal_Q(v,b[k]) then return false end end return true else return a == b end end function M.copy(obj) if type(obj) == "function" then return M.FunctionRef:new(obj) end if type(obj) ~= "table" then return obj end -- copy object data local new_obj = {} for k,v in pairs(obj) do new_obj[k] = v end -- copy metatable and link to original local old_mt = getmetatable(obj) if old_mt ~= nil then local new_mt = {} for k,v in pairs(old_mt) do new_mt[k] = v end setmetatable(new_mt, old_mt) setmetatable(new_obj, new_mt) end return new_obj end function M.slice(lst, start, last) if last == nil then last = #lst end local new_lst = {} if start <= last then for i = start, last do new_lst[#new_lst+1] = lst[i] end end return new_lst end -- Error/exceptions M.MalException = {} function M.MalException:new(val) local newObj = {val = val} self.__index = self return setmetatable(newObj, self) end function M._malexception_Q(obj) return utils.instanceOf(obj, M.MalException) end function M.throw(val) error(M.MalException:new(val)) end -- Nil local NilType = {} function NilType:new(val) local newObj = {} self.__index = self return setmetatable(newObj, self) end M.Nil = NilType:new() function M._nil_Q(obj) return obj == Nil end -- Numbers function M._number_Q(obj) return type(obj) == "number" end -- Strings function M._string_Q(obj) return type(obj) == "string" and "\u{029e}" ~= string.sub(obj,1,2) end -- Symbols M.Symbol = {} function M.Symbol:new(val) local newObj = {val = val} self.__index = self return setmetatable(newObj, self) end function M._symbol_Q(obj) return utils.instanceOf(obj, M.Symbol) end -- Keywords -- 5.1 does not support unicode escapes. Their length vary between 5.3 and 5.4. _keyword_mark = "\u{029e}" -- Two bytes. _keyword_mark_len = string.len(_keyword_mark) function M._keyword_Q(obj) return type(obj) == "string" and _keyword_mark == string.sub(obj,1,_keyword_mark_len) end function M._keyword_from_lua_string(value) return _keyword_mark .. value end function M._lua_string_from_keyword(obj) return string.sub(obj, _keyword_mark_len + 1) end -- Lists M.List = {} function M.List:new(lst) local newObj = lst and lst or {} self.__index = self return setmetatable(newObj, self) end function M._list_Q(obj) return utils.instanceOf(obj, M.List) end function M.List:slice(start,last) return M.List:new(M.slice(self,start,last)) end -- Vectors M.Vector = {} function M.Vector:new(lst) local newObj = lst and lst or {} self.__index = self return setmetatable(newObj, self) end function M._vector_Q(obj) return utils.instanceOf(obj, M.Vector) end function M.Vector:slice(start,last) return M.Vector:new(M.slice(self,start,last)) end -- Hash Maps -- M.HashMap = {} function M.HashMap:new(val) local newObj = val and val or {} self.__index = self return setmetatable(newObj, self) end function M.hash_map(...) return M._assoc_BANG(M.HashMap:new(), ...) end function M._hash_map_Q(obj) return utils.instanceOf(obj, M.HashMap) end function M._assoc_BANG(hm, ...) local arg = table.pack(...) for i = 1, #arg, 2 do hm[arg[i]] = arg[i+1] end return hm end function M._dissoc_BANG(hm, ...) local arg = table.pack(...) for i = 1, #arg do hm[arg[i]] = nil end return hm end -- Functions M.MalFunc = {} function M.MalFunc:new(fn, ast, env, params) local newObj = {fn = fn, ast = ast, env = env, params = params, ismacro = false} self.__index = self return setmetatable(newObj, self) end function M._malfunc_Q(obj) return utils.instanceOf(obj, M.MalFunc) end function M._fn_Q(obj) return type(obj) == "function" or (M._malfunc_Q(obj) and not obj.ismacro) end function M._macro_Q(obj) return M._malfunc_Q(obj) and obj.ismacro end -- Atoms M.Atom = {} function M.Atom:new(val) local newObj = {val = val} self.__index = self return setmetatable(newObj, self) end function M._atom_Q(obj) return utils.instanceOf(obj, M.Atom) end -- FunctionRefs M.FunctionRef = {} function M.FunctionRef:new(fn) local newObj = {fn = fn} return setmetatable(newObj, self) end function M._functionref_Q(obj) return utils.instanceOf(obj, M.FunctionRef) end function M.FunctionRef:__call(...) return self.fn(...) end return M ================================================ FILE: impls/lua/utils.lua ================================================ local M = {} function M.try(f, catch_f) local status, exception = pcall(f) if not status then catch_f(exception) end end function M.instanceOf(subject, super) super = tostring(super) local mt = getmetatable(subject) while true do if mt == nil then return false end if tostring(mt) == super then return true end mt = getmetatable(mt) end end --[[ function M.isArray(o) local i = 0 for _ in pairs(o) do i = i + 1 if o[i] == nil then return false end end return true end ]]-- function M.map(func, obj) local new_obj = {} for i,v in ipairs(obj) do new_obj[i] = func(v) end return new_obj end function M.dump(o) if type(o) == 'table' then local s = '{ ' for k,v in pairs(o) do if type(k) ~= 'number' then k = '"'..k..'"' end s = s .. '['..k..'] = ' .. M.dump(v) .. ',' end return s .. '} ' else return tostring(o) end end return M ================================================ FILE: impls/make/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Nothing additional needed for make ================================================ FILE: impls/make/Makefile ================================================ TESTS = tests/types.mk tests/reader.mk tests/stepA_mal.mk SOURCES_BASE = util.mk numbers.mk readline.mk gmsl.mk types.mk \ reader.mk printer.mk SOURCES_LISP = env.mk core.mk stepA_mal.mk SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.mk mal mal.mk: $(SOURCES) cat $+ | grep -v "^include " > $@ mal: mal.mk echo "#!/usr/bin/make -f" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.mk mal .PHONY: tests $(TESTS) tests: $(TESTS) $(TESTS): @echo "Running $@"; \ make -f $@ || exit 1; \ ================================================ FILE: impls/make/README ================================================ It is often useful to add $(warning /$0/ /$1/ /$2/ /$3/) at the very start of each interesting macro. Recal that foreach does nothing when the list only contains spaces, and adds spaces between the results even if some results are empty. If debugging the reader: # export READER_DEBUG=1 In order to get the equivalent of DEBUG_EVAL in step2: # export EVAL_DEBUG=1 ================================================ FILE: impls/make/core.mk ================================================ # # mal (Make a Lisp) Core functions # ifndef __mal_core_included __mal_core_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)readline.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk # General functions $(encoded_equal) = $(if $(call _equal?,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # Scalar functions nil? = $(if $(_nil?),$(__true),$(__false)) true? = $(if $(_true?),$(__true),$(__false)) false? = $(if $(_false?),$(__true),$(__false)) # Symbol functions symbol = $(call _symbol,$(_string_val)) symbol? = $(if $(_symbol?),$(__true),$(__false)) # Keyword functions keyword = $(if $(_keyword?),$1,$(call _keyword,$(_string_val))) keyword? = $(if $(_keyword?),$(__true),$(__false)) # Number functions number? = $(if $(_number?),$(__true),$(__false)) define < $(if $(call int_lt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ ,$(__true),$(__false)) endef define <$(encoded_equal) $(if $(call int_lte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ ,$(__true),$(__false)) endef define > $(if $(call int_gt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ ,$(__true),$(__false)) endef define >$(encoded_equal) $(if $(call int_gte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ ,$(__true),$(__false)) endef + = $(call _number,$(call int_add,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) - = $(call _number,$(call int_sub,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) * = $(call _number,$(call int_mult,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) / = $(call _number,$(call int_div,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) time-ms = $(call _number,$(shell date +%s%3N)) # String functions string? = $(if $(_string?),$(__true),$(__false)) pr-str = $(call _string,$(call _pr_str_mult,$1,yes,$(_SP))) str = $(call _string,$(_pr_str_mult)) prn = $(__nil)$(call print,$(call _pr_str_mult,$1,yes,$(_SP))) println = $(__nil)$(call print,$(call _pr_str_mult,$1,,$(_SP))) readline = $(or $(foreach res,$(call READLINE,$(_string_val))\ ,$(call _string,$(res:ok=)))\ ,$(__nil)) read-string = $(call READ_STR,$(_string_val)) slurp = $(call _string,$(call _read_file,$(_string_val))) # Function functions fn? = $(if $(_fn?),$(__true),$(__false)) macro? = $(if $(_macro?),$(__true),$(__false)) # List functions list? = $(if $(_list?),$(__true),$(__false)) # Vector functions vector? = $(if $(_vector?),$(__true),$(__false)) vec = $(if $(_list?)\ ,$(call vector,$(_seq_vals))$(rem \ ),$(if $(_vector?)\ ,$1$(rem \ ),$(call _error,vec$(encoded_colon)$(_SP)called$(_SP)on$(_SP)non-sequence))) # Hash map (associative array) functions hash-map = $(call _map_new,,$1) map? = $(if $(_hash_map?),$(__true),$(__false)) # set a key/value in a copy of the hash map assoc = $(call _map_new,$(firstword $1),$(_rest)) # unset keys in a copy of the hash map dissoc = $(call _map_new,$(firstword $1),,$(_rest)) keys = $(call list,$(_keys)) vals = $(call list,$(foreach k,$(_keys),$(call _get,$1,$k))) # retrieve the value of a string key object from the hash map, or # return nil if the key is not found. get = $(or $(call _get,$(firstword $1),$(lastword $1)),$(__nil)) contains? = $(if $(call _get,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # sequence operations sequential? = $(if $(_sequential?),$(__true),$(__false)) # Strip in case seq_vals is empty. cons = $(call list,$(strip $(firstword $1) $(call _seq_vals,$(lastword $1)))) # Strip in case foreach introduces a space after an empty argument. concat = $(call list,$(strip $(foreach l,$1,$(call _seq_vals,$l)))) nth = $(or $(word $(call int_add,1,$(call _number_val,$(lastword $1))),\ $(call _seq_vals,$(firstword $1)))\ ,$(call _error,nth: index out of range)) first = $(or $(if $(_sequential?),$(firstword $(_seq_vals))),$(__nil)) empty? = $(if $(_seq_vals),$(__false),$(__true)) count = $(call _number,$(words $(if $(_sequential?),$(_seq_vals)))) # Creates a new vector/list of the everything after but the first # element rest = $(call list,$(if $(_sequential?),$(call _rest,$(_seq_vals)))) # Takes a space separated arguments and invokes the first argument # (function object) using the remaining arguments. # Strip in case wordlist or _seq_vals is empty. apply = $(call _apply,$(firstword $1),$(strip \ $(wordlist 2,$(call int_sub,$(words $1),1),$1) \ $(call _seq_vals,$(lastword $1)))) # Map a function object over a list object map = $(call list,$(foreach e,$(call _seq_vals,$(lastword $1))\ ,$(call _apply,$(firstword $1),$e))) conj = $(foreach seq,$(firstword $1)\ ,$(call conj_$(call _obj_type,$(seq)),$(call _seq_vals,$(seq)),$(_rest))) # Strip in case $1 or $2 is empty. # Also, _reverse introduces blanks. conj_vector = $(call vector,$(strip $1 $2)) conj_list = $(call list,$(strip $(call _reverse,$2) $1)) seq = $(or $(seq_$(_obj_type))\ ,$(call _error,seq: called on non-sequence)) seq_list = $(if $(_seq_vals),$1,$(__nil)) seq_vector = $(if $(_seq_vals),$(call list,$(_seq_vals)),$(__nil)) seq_nil = $1 seq_string = $(if $(_string_val)\ ,$(call list,$(foreach c,$(call str_encode,$(_string_val))\ ,$(call _string,$(call str_decode,$c))))$(rem \ ),$(__nil)) # Metadata functions # are implemented in types.mk. # Atom functions atom? = $(if $(_atom?),$(__true),$(__false)) reset! = $(foreach v,$(lastword $1),$(call _reset,$(firstword $1),$v)$v) swap! = $(foreach a,$(firstword $1)\ ,$(call reset!,$a $(call _apply,$(word 2,$1),$(call deref,$a) $(_rest2)))) # Namespace of core functions core_ns := $(encoded_equal) throw nil? true? false? string? symbol \ symbol? keyword keyword? number? fn? macro? \ pr-str str prn println readline read-string slurp \ < \ <$(encoded_equal) > >$(encoded_equal) + - * / time-ms \ list list? vector vector? hash-map map? assoc dissoc get \ contains? keys vals \ sequential? cons concat vec nth first rest empty? count apply map \ conj seq \ with-meta meta atom atom? deref reset! swap! endif ================================================ FILE: impls/make/env.mk ================================================ # # mal (Make Lisp) Object Types and Functions # ifndef __mal_env_included __mal_env_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk # # ENV # # An ENV environment is a hash-map with an __outer__ reference to an # outer environment # Keys are stored as Make variables named $(env)_$(key). The outer # environment is the content of the variable itself. # 1: outer environment, or "" -> new environment ENV = $(call __new_obj,env,$1) # 1:env 2:key -> value or "" ENV_GET = $(if $1,$(or $($1_$2),$(call ENV_GET,$($1),$2))) # 1:env 2:key 3:value ENV_SET = $(eval $1_$2 := $3) # 1:env -> (encoded) keys env_keys = $(foreach k,$(patsubst $1_%,%,$(filter $1_%,$(.VARIABLES)))\ ,$(call _symbol_val,$k)) endif ================================================ FILE: impls/make/gmsl.mk ================================================ # # mal (Make Lisp) trimmed and namespaced GMSL functions/definitions # - derived from the GMSL 1.1.3 # ifndef __mal_gmsl_included __mal_gmsl_included := true # ---------------------------------------------------------------------------- # # GNU Make Standard Library (GMSL) # # A library of functions to be used with GNU Make's $(call) that # provides functionality not available in standard GNU Make. # # Copyright (c) 2005-2013 John Graham-Cumming # # This file is part of GMSL # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # Neither the name of the John Graham-Cumming nor the names of its # contributors may be used to endorse or promote products derived from # this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE # COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # ---------------------------------------------------------------------------- # Strings gmsl_characters := A B C D E F G H I J K L M N O P Q R S T U V W X Y Z gmsl_characters += a b c d e f g h i j k l m n o p q r s t u v w x y z gmsl_characters += 0 1 2 3 4 5 6 7 8 9 gmsl_characters += ` ~ ! @ \# $$ % ^ & * ( ) - _ = + gmsl_characters += { } [ ] \ : ; ' " < > , . / ? | endif ================================================ FILE: impls/make/numbers.mk ================================================ # # mal (Make a Lisp) number types # ifndef __mal_numbers_included __mal_numbers_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk LIST20_X := x x x x x x x x x x x x x x x x x x x x LIST100_X := $(foreach x,$(LIST20_X),X X X X X) LIST100_0 := $(foreach x,$(LIST20_X),0 0 0 0 0) LIST100_9 := $(foreach x,$(LIST20_X),9 9 9 9 9) ### ### general numeric utility functions ### int_encode = $(strip $(call _reverse,\ $(eval __temp := $(1))\ $(foreach a,- 0 1 2 3 4 5 6 7 8 9,\ $(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp))) int_decode = $(subst $(SPACE),,$(_reverse)) # trim extaneous zero digits off the end (front of number) _trim_zeros = $(if $(call _EQ,0,$(strip $(1))),0,$(if $(call _EQ,0,$(word 1,$(1))),$(call _trim_zeros,$(wordlist 2,$(words $(1)),$(1))),$(1))) trim_zeros = $(strip \ $(if $(call _EQ,0,$(strip $(filter-out -,$(1)))),\ $(filter-out -,$(1)),\ $(call _reverse,$(call _trim_zeros,$(call _reverse,$(filter-out -,$(1))))))\ $(if $(filter -,$(1)), -,)) # drop the last element of a list of words/digits drop_last = $(call _reverse,$(wordlist 2,$(words $(1)),$(call _reverse,$(1)))) ### utility function tests #$(info $(filter-out 1,$(filter 1%,1 132 456))) #$(info (int_encode 13): [$(call int_encode,13)]) #$(info (int_encode 156463): [$(call int_encode,156463)]) #$(info (int_encode -156463): [$(call int_encode,-156463)]) #$(info (int_decode (int_encode 156463)): [$(call int_decode,$(call int_encode,156463))]) #$(info trim_zeros(0 0 0): [$(call trim_zeros,0 0 0)]) #$(info trim_zeros(0 0 0 -): [$(call trim_zeros,0 0 0 -)]) ### ### comparisons ### # compare two digits and return 'true' if digit 1 is less than or # equal to digit 2 _lte_digit = $(strip \ $(if $(call _EQ,$(1),$(2)),\ true,\ $(if $(call _EQ,0,$(1)),\ true,\ $(if $(wordlist $(1),$(2),$(LIST20_X)),\ true,\ )))) # compare two lists of digits (MSB->LSB) of equal length and return # 'true' if number 1 is less than number 2 _lte_digits = $(strip \ $(if $(strip $(1)),\ $(if $(call _EQ,$(word 1,$(1)),$(word 1,$(2))),\ $(call _lte_digits,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),\ $(if $(call _lte_digit,$(word 1,$(1)),$(word 1,$(2))),true,)),\ true)) ### lte/less than or equal to _int_lte_encoded = $(strip \ $(foreach len1,$(words $(1)),$(foreach len2,$(words $(2)),\ $(if $(call _EQ,$(len1),$(len2)),\ $(call _lte_digits,$(call _reverse,$(1)),$(call _reverse,$(2))),\ $(if $(wordlist $(len1),$(len2),$(LIST100_X)),\ true,\ ))))) int_lte_encoded = $(strip \ $(if $(filter -,$(1)),\ $(if $(filter -,$(2)),\ $(call _int_lte_encoded,$(filter-out -,$(2)),$(filter-out -,$(1))),\ true),\ $(if $(filter -,$(2)),\ ,\ $(call _int_lte_encoded,$(1),$(2))))) int_lte = $(call int_lte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) ### lt/less than int_lt_encoded = $(strip \ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ ,\ $(call int_lte_encoded,$(1),$(2)))) int_lt = $(call int_lt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) ### gte/greater than or equal to int_gte_encoded = $(strip \ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ true,\ $(if $(call int_lte_encoded,$(1),$(2)),,true))) int_gte = $(call int_gte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) ### gt/greater than int_gt_encoded = $(strip \ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\ ,\ $(call int_gte_encoded,$(1),$(2)))) int_gt = $(call int_gt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))) #$(info _lte_digit,7,8: [$(call _lte_digit,7,8)]) #$(info _lte_digit,8,8: [$(call _lte_digit,8,8)]) #$(info _lte_digit,2,1: [$(call _lte_digit,2,1)]) #$(info _lte_digit,0,0: [$(call _lte_digit,0,0)]) #$(info _lte_digit,0,1: [$(call _lte_digit,0,1)]) #$(info _lte_digit,1,0: [$(call _lte_digit,1,0)]) #$(info _lte_digits,1 2 3,1 2 4: [$(call _lte_digits,1 2 3,1 2 4)]) #$(info _lte_digits,1 2 4,1 2 4: [$(call _lte_digits,1 2 4,1 2 4)]) #$(info _lte_digits,1 2 5,1 2 4: [$(call _lte_digits,1 2 5,1 2 4)]) #$(info _lte_digits,4 1,9 0: [$(call _lte_digits,4 1,9 0)]) # The main comparison operator (others are built on this) #$(info int_lte_encoded,1,1: [$(call int_lte_encoded,1,1)]) #$(info int_lte_encoded,1,2: [$(call int_lte_encoded,1,2)]) #$(info int_lte_encoded,2,1: [$(call int_lte_encoded,2,1)]) #$(info int_lte_encoded,0,3: [$(call int_lte_encoded,0,3)]) #$(info int_lte_encoded,3,0: [$(call int_lte_encoded,3,0)]) #$(info int_lte_encoded,1 4,0 9: [$(call int_lte_encoded,1 4,0 9)]) #$(info int_lte_encoded,4 3 2 1,4 3 2 1: [$(call int_lte_encoded,4 3 2 1,4 3 2 1)]) #$(info int_lte_encoded,5 3 2 1,4 3 2 1: [$(call int_lte_encoded,5 3 2 1,4 3 2 1)]) #$(info int_lte_encoded,4 3 2 1,5 3 2 1: [$(call int_lte_encoded,4 3 2 1,5 3 2 1)]) # negative numbers #$(info int_lte_encoded,7 -,7: [$(call int_lte_encoded,7 -,7)]) #$(info int_lte_encoded,7,7 -: [$(call int_lte_encoded,7,7 -)]) #$(info int_lte_encoded,7 -,7 -: [$(call int_lte_encoded,7 -,7 -)]) #$(info int_lte_encoded,1 7 -,0 7: [$(call int_lte_encoded,1 7 -,0 7)]) #$(info int_lte_encoded,1 7,0 7 -: [$(call int_lte_encoded,1 7,0 7 -)]) #$(info int_lte_encoded,1 7 -,0 7 -: [$(call int_lte_encoded,1 7 -,0 7 -)]) #$(info int_lte_encoded,4 3 2 1 -,4 3 2 1: [$(call int_lte_encoded,4 3 2 1 -,4 3 2 1)]) #$(info int_lte_encoded,4 3 2 1,4 3 2 1 -: [$(call int_lte_encoded,4 3 2 1,4 3 2 1 -)]) #$(info int_lte_encoded,4 3 2 1 -,4 3 2 1 -: [$(call int_lte_encoded,4 3 2 1 -,4 3 2 1 -)]) #$(info int_lte,1,1: [$(call int_lte,1,1)]) #$(info int_lte,1,2: [$(call int_lte,1,2)]) #$(info int_lte,2,1: [$(call int_lte,2,1)]) #$(info int_lte,0,3: [$(call int_lte,0,3)]) #$(info int_lte,3,0: [$(call int_lte,3,0)]) #$(info int_lte,1234,1234: [$(call int_lte,1234,1234)]) #$(info int_lte,1235,1234: [$(call int_lte,1235,1234)]) #$(info int_lte,1234,1235: [$(call int_lte,1234,1235)]) #$(info int_lte,-1234,1235: [$(call int_lte,-1234,1235)]) #$(info int_lte,1234,-1235: [$(call int_lte,1234,-1235)]) #$(info int_lte,-1234,-1235: [$(call int_lte,-1234,-1235)]) #$(info int_lt,1,1: [$(call int_lt,1,1)]) #$(info int_lt,1,2: [$(call int_lt,1,2)]) #$(info int_lt,2,1: [$(call int_lt,2,1)]) #$(info int_lt,0,3: [$(call int_lt,0,3)]) #$(info int_lt,3,0: [$(call int_lt,3,0)]) #$(info int_lt,1234,1234: [$(call int_lt,1234,1234)]) #$(info int_lt,1235,1234: [$(call int_lt,1235,1234)]) #$(info int_lt,1234,1235: [$(call int_lt,1234,1235)]) # #$(info int_gte,1,1: [$(call int_gte,1,1)]) #$(info int_gte,1,2: [$(call int_gte,1,2)]) #$(info int_gte,2,1: [$(call int_gte,2,1)]) #$(info int_gte,0,3: [$(call int_gte,0,3)]) #$(info int_gte,3,0: [$(call int_gte,3,0)]) #$(info int_gte,1234,1234: [$(call int_gte,1234,1234)]) #$(info int_gte,1235,1234: [$(call int_gte,1235,1234)]) #$(info int_gte,1234,1235: [$(call int_gte,1234,1235)]) # #$(info int_gt,1,1: [$(call int_gt,1,1)]) #$(info int_gt,1,2: [$(call int_gt,1,2)]) #$(info int_gt,2,1: [$(call int_gt,2,1)]) #$(info int_gt,0,3: [$(call int_gt,0,3)]) #$(info int_gt,3,0: [$(call int_gt,3,0)]) #$(info int_gt,1234,1234: [$(call int_gt,1234,1234)]) #$(info int_gt,1235,1234: [$(call int_gt,1235,1234)]) #$(info int_gt,1234,1235: [$(call int_gt,1234,1235)]) #$(info int_gt,-1234,1235: [$(call int_gt,-1234,1235)]) #$(info int_gt,-1234,-1235: [$(call int_gt,-1234,-1235)]) ### ### addition ### # add_digits_with_carry _add_digit = $(words $(if $(strip $(1)),$(wordlist 1,$(1),$(LIST20_X)),) \ $(if $(strip $(2)),$(wordlist 1,$(2),$(LIST20_X)),)) # add one to a single digit _inc_digit = $(words $(wordlist 1,$(if $(1),$(1),0),$(LIST20_X)) x) # add two encoded numbers digit by digit without resolving carries # (each digit will be larger than 9 if there is a carry value) _add = $(if $(1)$(2),$(call _add_digit,$(word 1,$(1)),$(word 1,$(2))) $(call _add,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),) # take the result of _add and resolve the carry values digit by digit _resolve_carries = $(strip \ $(if $(1),\ $(foreach num,$(word 1,$(1)),\ $(if $(filter-out 1,$(filter 1%,$(num))),\ $(call _resolve_carries,$(call _inc_digit,$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1)),$(2) $(patsubst 1%,%,$(num))),\ $(call _resolve_carries,$(wordlist 2,$(words $(1)),$(1)),$(2) $(num)))),\ $(2))) _negate = $(strip \ $(if $(call _EQ,0,$(strip $(1))),\ 0,\ $(if $(filter -,$(1)),$(filter-out -,$(1)),$(1) -))) # add two encoded numbers, returns encoded number _int_add_encoded = $(call _resolve_carries,$(call _add,$(1),$(2))) int_add_encoded = $(strip \ $(if $(filter -,$(1)),\ $(if $(filter -,$(2)),\ $(call _negate,$(call _int_add_encoded,$(filter-out -,$(1)),$(filter-out -,$(2)))),\ $(call int_sub_encoded,$(2),$(filter-out -,$(1)))),\ $(if $(filter -,$(2)),\ $(call int_sub_encoded,$(1),$(filter-out -,$(2))),\ $(call _int_add_encoded,$(1),$(2))))) # add two unencoded numbers, returns unencoded number int_add = $(call int_decode,$(call int_add_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) ### addition tests #$(info _add_digit(7,6,1): [$(call _add_digit,7,6,1)]) #$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) #$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)]) #$(info _carries(12 14 15): [$(call _carries,12 14 15)]) #$(info _inc_digit(0): $(call _inc_digit,0)) #$(info _inc_digit(1): $(call _inc_digit,1)) #$(info _inc_digit(9): $(call _inc_digit,9)) #$(info _inc_digit(18): $(call _inc_digit,18)) #$(info int_add_encoded(0,0): [$(call int_add_encoded,0,0)]) #$(info int_add(1,2): [$(call int_add,1,2)]) #$(info int_add(9,9): [$(call int_add,9,9)]) #$(info int_add(0,9): [$(call int_add,0,9)]) #$(info int_add(9,0): [$(call int_add,9,0)]) #$(info int_add(0,0): [$(call int_add,0,0)]) #$(info int_add(123,456): [$(call int_add,123,456)]) #$(info int_add(678,789): [$(call int_add,678,789)]) #$(info int_add(1,12): [$(call int_add,1,12)]) #$(info int_add(123,5): [$(call int_add,123,5)]) #$(info int_add(123456,9): [$(call int_add,123456,9)]) #$(info int_add(999999991,9): [$(call int_add,999999991,9)]) # negative numbers #$(info int_add(-2,2): [$(call int_add,-2,2)]) #$(info int_add(-1,2): [$(call int_add,-1,2)]) #$(info int_add(1,-2): [$(call int_add,1,-2)]) #$(info int_add(-1,-2): [$(call int_add,-1,-2)]) ### ### subtraction ### _get_zeros = $(if $(call _EQ,0,$(word 1,$(1))),$(call _get_zeros,$(wordlist 2,$(words $(1)),$(1)),$(2) 0),$(2)) # return a 9's complement of a single digit _complement9 = $(strip \ $(if $(call _EQ,0,$(1)),9,\ $(if $(call _EQ,1,$(1)),8,\ $(if $(call _EQ,2,$(1)),7,\ $(if $(call _EQ,3,$(1)),6,\ $(if $(call _EQ,4,$(1)),5,\ $(if $(call _EQ,5,$(1)),4,\ $(if $(call _EQ,6,$(1)),3,\ $(if $(call _EQ,7,$(1)),2,\ $(if $(call _EQ,8,$(1)),1,\ $(if $(call _EQ,9,$(1)),0))))))))))) # return a 10's complement of a single digit _complement10 = $(call _inc_digit,$(call _complement9,$(1))) # _complement_rest = $(if $(strip $(1)),\ $(strip \ $(call _complement10,$(word 1,$(1))) \ $(foreach digit,$(wordlist 2,$(words $(1)),$(1)),\ $(call _complement9,$(digit)))),) # return the complement of a number _complement = $(strip $(call _get_zeros,$(1)) \ $(call _complement_rest,$(wordlist $(call _inc_digit,$(words $(call _get_zeros,$(1)))),$(words $(1)),$(1)))) # subtracted encoded number 2 from encoded number 1 and return and # encoded number result. both numbers must be positive but may have # a negative result __int_sub_encoded = $(strip \ $(call trim_zeros,\ $(call drop_last,\ $(call int_add_encoded,\ $(1),\ $(wordlist 1,$(words $(1)),$(call _complement,$(2)) $(LIST100_9)))))) _int_sub_encoded = $(strip \ $(if $(call _EQ,0,$(strip $(2))),\ $(1),\ $(if $(call _int_lte_encoded,$(2),$(1)),\ $(call __int_sub_encoded,$(1),$(2)),\ $(call _negate,$(call __int_sub_encoded,$(2),$(1)))))) int_sub_encoded = $(strip \ $(if $(filter -,$(1)),\ $(if $(filter -,$(2)),\ $(call _int_sub_encoded,$(filter-out -,$(2)),$(filter-out -,$(1))),\ $(call _negate,$(call _int_add_encoded,$(filter-out -,$(1)),$(2)))),\ $(if $(filter -,$(2)),\ $(call _int_add_encoded,$(1),$(filter-out -,$(2))),\ $(call _int_sub_encoded,$(1),$(2))))) # subtract unencoded number 2 from unencoded number 1 and return # unencoded result int_sub = $(call int_decode,$(call int_sub_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) ### subtraction tests #$(info _get_zeros(5 7): [$(call _get_zeros,5 7)]) #$(info _get_zeros(0 0 0 2): [$(call _get_zeros,0 0 0 2)]) #$(info _get_zeros(0 0 0 2 5): [$(call _get_zeros,0 0 0 2 5)]) #$(info _complement(0): [$(call _complement,0)]) #$(info _complement(1): [$(call _complement,1)]) #$(info _complement(9): [$(call _complement,9)]) #$(info _complement(5 7): [$(call _complement,5 7)]) #$(info _complement(0 0 0 2): [$(call _complement,0 0 0 2)]) #$(info _complement(0 0 0 5 4 3 2 1): [$(call _complement,0 0 0 5 4 3 2 1)]) #$(info int_sub_encoded(0 0 1, 3 1): [$(call int_sub_encoded,0 0 1,3 1)]) #$(info int_sub_encoded(2, 2): [$(call int_sub_encoded,2,2)]) #$(info int_sub(2,1): [$(call int_sub,2,1)]) #$(info int_sub(2,0): [$(call int_sub,2,0)]) #$(info int_sub(2,2): [$(call int_sub,2,2)]) #$(info int_sub(100,13): [$(call int_sub,100,13)]) #$(info int_sub(100,99): [$(call int_sub,100,99)]) #$(info int_sub(91,19): [$(call int_sub,91,19)]) # negative numbers #$(info int_sub(1,2): [$(call int_sub,1,2)]) #$(info int_sub(-1,2): [$(call int_sub,-1,2)]) #$(info int_sub(1,-2): [$(call int_sub,1,-2)]) #$(info int_sub(-1,-2): [$(call int_sub,-1,-2)]) #$(info int_sub(-2,-1): [$(call int_sub,-2,-1)]) #$(info int_sub(19,91): [$(call int_sub,19,91)]) #$(info int_sub(91,-19): [$(call int_sub,91,-19)]) #$(info int_sub(-91,19): [$(call int_sub,-91,19)]) #$(info int_sub(-91,-19): [$(call int_sub,-91,-19)]) ### ### multiplication ### # multiply two digits #_mult_digit = $(words $(foreach x,$(1),$(2))) _mult_digit = $(strip \ $(words $(foreach x,$(wordlist 1,$(1),$(LIST20_X)),\ $(wordlist 1,$(2),$(LIST20_X))))) # multipy every digit of number 1 with number 2 # params: digits, digit, indent_zeros, results _mult_row = $(if $(strip $(1)),$(call _mult_row,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)0,$(4) $(call _mult_digit,$(word 1,$(1)),$(2))$(3)),$(4)) # multiply every digit of number 2 with every digit of number 1 adding # correct zero padding to the end of each result # params: digits, digits, indent_zeros, results _mult_each = $(if $(strip $(2)),$(call _mult_each,$(1),$(wordlist 2,$(words $(2)),$(2)),$(3)0,$(4) $(call _mult_row,$(1),$(word 1,$(2)),$(3))),$(4)) # add up a bunch of unencoded numbers. Basically reduce into the first number _add_many = $(if $(word 2,$(1)),$(call _add_many,$(call int_add,$(word 1,$(1)),$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1))),$(1)) # multiply two encoded numbers, returns encoded number _int_mult_encoded = $(call trim_zeros,$(call int_encode,$(call _add_many,$(call _mult_each,$(1),$(2))))) int_mult_encoded = $(strip \ $(if $(filter -,$(1)),\ $(if $(filter -,$(2)),\ $(call _int_mult_encoded,$(filter-out -,$(1)),$(filter-out -,$(2))),\ $(call _negate,$(call _int_mult_encoded,$(filter-out -,$(1)),$(2)))),\ $(if $(filter -,$(2)),\ $(call _negate,$(call _int_mult_encoded,$(1),$(filter-out -,$(2)))),\ $(call _int_mult_encoded,$(1),$(2))))) # multiply two unencoded numbers, returns unencoded number int_mult = $(call int_decode,$(call int_mult_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) #$(info _mult_digit(8,6): [$(call _mult_digit,8,6)]) #$(info _mult_digit(7,6): [$(call _mult_digit,7,6)]) #$(info _mult_row(8,6): [$(call _mult_row,8,6)]) #$(info _mult_row(8 7,6): [$(call _mult_row,8 7,6)]) #$(info _mult_row(8 7 3,6): [$(call _mult_row,8 7 3,6)]) #$(info _mult_each(8 7 6, 4 3 2): [$(call _mult_each,8 7 6,4 3 2)]) #$(info _add_many(123 234 345 456): [$(call _add_many,123 234 345 456)]) #$(info int_mult_encoded(8 7 3,6): [$(call int_mult_encoded,8 7 3,6)]) #$(info int_mult_encoded(8 7 3,0): [$(call int_mult_encoded,8 7 3,0)]) #$(info int_mult(378,6): [$(call int_mult,378,6)]) #$(info int_mult(678,234): [$(call int_mult,678,234)]) #$(info int_mult(1,23456): [$(call int_mult,1,23456)]) #$(info int_mult(0,23456): [$(call int_mult,0,23456)]) #$(info int_mult(0,0): [$(call int_mult,0,0)]) # negative numbers #$(info int_mult(-378,6): [$(call int_mult,-378,6)]) #$(info int_mult(678,-234): [$(call int_mult,678,-234)]) #$(info int_mult(-1,-23456): [$(call int_mult,-1,-23456)]) #$(info int_mult(0,-23456): [$(call int_mult,0,-23456)]) ### ### division ### # return list of zeros needed to pad number 2 to the same length as number 1 _zero_pad = $(strip $(wordlist 1,$(call int_sub,$(words $(1)),$(words $(2))),$(LIST100_0))) # num1, num2, zero pad, result_accumulator # algorithm: # - B = pad with zeros to make same digit length as A # - loop # - if (B <= A) # - A = subtract B from A # - C = C + 10^(B pad.length) # - else # - if B.length < origin B.length: break # - chop least significant digit of B _div = $(strip \ $(if $(call int_lte_encoded,$(3) $(2),$(1)),\ $(call _div,$(call int_sub_encoded,$(1),$(3) $(2)),$(2),$(3),$(call int_add_encoded,$(4),$(3) 1)),\ $(if $(3),\ $(call _div,$(1),$(2),$(wordlist 2,$(words $(3)),$(3)),$(4)),\ $(4)))) # divide two encoded numbers, returns encoded number _int_div_encoded = $(strip \ $(if $(call _EQ,0,$(1)),\ 0,\ $(if $(call _EQ,$(1),$(2)),\ 1,\ $(if $(call int_gt_encoded,$(2),$(1)),\ 0,\ $(call _div,$(1),$(2),$(call _zero_pad,$(1),$(2)),0))))) int_div_encoded = $(strip \ $(if $(filter -,$(1)),\ $(if $(filter -,$(2)),\ $(call _int_div_encoded,$(filter-out -,$(1)),$(filter-out -,$(2))),\ $(call _negate,$(call _int_div_encoded,$(filter-out -,$(1)),$(2)))),\ $(if $(filter -,$(2)),\ $(call _negate,$(call _int_div_encoded,$(1),$(filter-out -,$(2)))),\ $(call _int_div_encoded,$(1),$(2))))) # divide two unencoded numbers, returns unencoded number int_div = $(call int_decode,$(call int_div_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))) ### division tests #$(info _zero_pad(1 2 3 4,1 3): [$(call _zero_pad,1 2 3 4,1 3)]) #$(info _zero_pad(1 2,1 3): [$(call _zero_pad,1 2,1 3)]) #$(info _zero_pad(2,1 3): [$(call _zero_pad,1 2,1 3)]) # #$(info int_div_encoded(2,1): [$(call int_div_encoded,2,1)]) #$(info int_div_encoded(3,1): [$(call int_div_encoded,3,1)]) #$(info int_div_encoded(3,2): [$(call int_div_encoded,3,2)]) #$(info int_div_encoded(0,7): [$(call int_div_encoded,0,7)]) #$(info int_div_encoded(0 3,0 2): [$(call int_div_encoded,0 3,0 2)]) #$(info int_div_encoded(0 3,5): [$(call int_div_encoded,0 3,5)]) # #$(info int_div(5,1): [$(call int_div,5,1)]) #$(info int_div(5,2): [$(call int_div,5,2)]) #$(info int_div(123,7): [$(call int_div,123,7)]) #$(info int_div(100,7): [$(call int_div,100,7)]) # negative numbers #$(info int_div(-5,1): [$(call int_div,-5,1)]) #$(info int_div(5,-2): [$(call int_div,5,-2)]) #$(info int_div(-123,-7): [$(call int_div,-123,-7)]) ### combination tests # (/ (- (+ 515 (* 222 311)) 300) 41) = 1689 #$(info int_mult,222,311: [$(call int_mult,222,311)]) #$(info int_add(515,69042): [$(call int_add,515,69042)]) #$(info int_sub(69557,300): [$(call int_sub,69557,300)]) #$(info int_div(69257,41): [$(call int_div,69257,41)]) # (/ (- (+ 515 (* -222 311)) 300) 41) = -1678 #$(info int_mult,-222,311: [$(call int_mult,-222,311)]) #$(info int_add(515,-69042): [$(call int_add,515,-69042)]) #$(info int_sub(-68527,300): [$(call int_sub,-68527,300)]) #$(info int_div(-68827,41): [$(call int_div,-68827,41)]) ############################################################### all: @true endif # vim: ts=2 et ================================================ FILE: impls/make/printer.mk ================================================ # # mal (Make a Lisp) printer # ifndef __mal_printer_included __mal_printer_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk # return a printable form of the argument, the second parameter is # 'print_readably' which backslashes quotes in string values _pr_str = $(call $(_obj_type)_pr_str,$1,$2) # Like _pr_str but takes multiple values in first argument, the second # parameter is 'print_readably' which backslashes quotes in string # values, the third parameter is the delimeter to use between each # _pr_str'd value _pr_str_mult = $(subst $(SPACE),$3,$(foreach f,$1,$(call _pr_str,$f,$2))) # Type specific printing nil_pr_str := nil true_pr_str := true false_pr_str := false number_pr_str = $(_number_val) symbol_pr_str = $(_symbol_val) keyword_pr_str = $(encoded_colon)$(_keyword_val) string_pr_str = $(if $2\ ,"$(subst $(_NL),$(encoded_slash)n,$(rem \ )$(subst ",$(encoded_slash)",$(rem \ )$(subst $(encoded_slash),$(encoded_slash)$(encoded_slash),$(rem \ )$(_string_val))))"$(rem \ else \ ),$(_string_val)) corefn_pr_str := function_pr_str := macro_pr_str := list_pr_str = $(_LP)$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))$(_RP) vector_pr_str = [$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))] map_pr_str = {$(call _pr_str_mult,$(foreach k,$(_keys),$k $(call _get,$1,$k)),$2,$(_SP))} atom_pr_str = $(_LP)atom$(_SP)$(call _pr_str,$(deref),$2)$(_RP) endif ================================================ FILE: impls/make/reader.mk ================================================ # # mal (Make Lisp) Parser/Reader # ifndef __mal_reader_included __mal_reader_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk READER_DEBUG ?= _TOKEN_DELIMS := ; , " ` $(_SP) $(_NL) { } $(_LP) $(_RP) [ ] #`" reader_init = $(eval __reader_temp := $(str_encode)) reader_next = $(firstword $(__reader_temp)) reader_drop = $(eval __reader_temp := $(call _rest,$(__reader_temp))) reader_log = $(if $(READER_DEBUG),$(info READER: $1 from $(__reader_temp))) define READ_NUMBER $(call reader_log,number)$(rem \ )$(if $(filter 0 1 2 3 4 5 6 7 8 9,$(reader_next))\ ,$(reader_next)$(reader_drop)$(call READ_NUMBER)) endef define READ_STRING $(call reader_log,string)$(rem \ )$(if $(filter ",$(reader_next))\ ,$(reader_drop)$(rem "\ ),$(if $(filter $(encoded_slash),$(reader_next))\ ,$(reader_drop)$(rem \ )$(if $(filter n,$(reader_next)),$(_NL),$(reader_next))$(rem \ )$(reader_drop)$(call READ_STRING)$(rem \ ),$(if $(reader_next)\ ,$(reader_next)$(reader_drop)$(call READ_STRING)$(rem \ ),$(call _error,Expected '"'$(COMMA) got EOF)))) endef define READ_SYMBOL $(call reader_log,symbol or keyword)$(rem \ )$(if $(filter-out $(_TOKEN_DELIMS),$(reader_next))\ ,$(reader_next)$(reader_drop)$(call READ_SYMBOL)) endef # read and return tokens until $1 found # The last element if any is followed by a space. define READ_UNTIL $(call reader_log,until $1)$(rem \ )$(READ_SPACES)$(rem \ )$(if $(filter $1,$(reader_next))\ ,$(reader_drop)$(rem \ ),$(if $(reader_next)\ ,$(call READ_FORM) $(call READ_UNTIL,$1)$(rem \ ),$(call _error,Expected '$1'$(COMMA) got EOF))) endef define READ_COMMENT $(call reader_log,comment)$(rem \ )$(if $(filter-out $(_NL),$(reader_next))\ ,$(reader_drop)$(call READ_COMMENT)) endef define READ_SPACES $(call reader_log,spaces)$(rem \ )$(if $(filter $(_SP) $(_NL) $(COMMA),$(reader_next))\ ,$(reader_drop)$(call READ_SPACES)$(rem \ ),$(if $(filter ;,$(reader_next))\ ,$(READ_COMMENT))) endef define READ_FORM $(call reader_log,form)$(rem \ )$(READ_SPACES)$(rem \ )$(if $(filter-out undefined,$(flavor READ_FORM_$(reader_next)))\ ,$(call READ_FORM_$(reader_next)$(reader_drop))$(rem \ ),$(foreach sym,$(READ_SYMBOL)\ ,$(if $(filter false nil true,$(sym))\ ,$(__$(sym))$(rem \ ),$(call _symbol,$(sym))))) endef READ_FORM_ = $(call _error,expected a form$(COMMA) found EOF) # Reader macros READ_FORM_@ = $(call list,$(call _symbol,deref) $(call READ_FORM)) READ_FORM_' = $(call list,$(call _symbol,quote) $(call READ_FORM))#' READ_FORM_` = $(call list,$(call _symbol,quasiquote) $(call READ_FORM))#` READ_FORM_^ = $(call list,$(call _symbol,with-meta) $(foreach m,\ $(call READ_FORM),$(call READ_FORM) $m)) READ_FORM_~ = $(call list,$(if $(filter @,$(reader_next))\ ,$(reader_drop)$(call _symbol,splice-unquote)$(rem \ ),$(call _symbol,unquote)) $(call READ_FORM)) # Lists, vectors and maps # _map_new accepts a leading space, list and vector require )strip. READ_FORM_{ = $(call _map_new,,$(strip $(call READ_UNTIL,}))) READ_FORM_$(_LP) = $(call list,$(strip $(call READ_UNTIL,$(_RP)))) READ_FORM_[ = $(call vector,$(strip $(call READ_UNTIL,]))) READ_FORM_} = $(call _error,Unexpected '}') READ_FORM_$(_RP) = $(call _error,Unexpected '$(_RP)') READ_FORM_] = $(call _error,Unexpected ']') # Numbers define READ_FORM_- $(if $(filter 0 1 2 3 4 5 6 7 8 9,$(reader_next))\ ,$(call _number,-$(READ_NUMBER))$(rem \ ),$(call _symbol,-$(READ_SYMBOL))) endef READ_FORM_0 = $(call _number,0$(READ_NUMBER)) READ_FORM_1 = $(call _number,1$(READ_NUMBER)) READ_FORM_2 = $(call _number,2$(READ_NUMBER)) READ_FORM_3 = $(call _number,3$(READ_NUMBER)) READ_FORM_4 = $(call _number,4$(READ_NUMBER)) READ_FORM_5 = $(call _number,5$(READ_NUMBER)) READ_FORM_6 = $(call _number,6$(READ_NUMBER)) READ_FORM_7 = $(call _number,7$(READ_NUMBER)) READ_FORM_8 = $(call _number,8$(READ_NUMBER)) READ_FORM_9 = $(call _number,9$(READ_NUMBER)) # Strings READ_FORM_" = $(call _string,$(call str_decode,$(READ_STRING)))#" # Keywords READ_FORM_$(encoded_colon) = $(call _keyword,$(READ_SYMBOL)) READ_STR = $(reader_init)$(or $(READ_FORM),$(__nil)) endif ================================================ FILE: impls/make/readline.mk ================================================ # # mal (Make Lisp) shell readline wrapper # ifndef __mal_readline_included __mal_readline_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk # Call bash read/readline. Since each call is in a separate shell # instance we need to restore and save after each call in order to # have readline history. READLINE_HISTORY_FILE := $${HOME}/.mal-history # Either empty (if EOF) or an encoded string with the 'ok' suffix. READLINE = $(call str_encode_nospace,$(shell \ history -r $(READLINE_HISTORY_FILE); \ read -u 0 -r -e -p '$(str_decode_nospace)' line && \ history -s -- "$${line}" && \ echo "$${line}ok" ; \ history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ true \ )) endif ================================================ FILE: impls/make/rules.mk ================================================ # To load this file: # $(eval include rules.mk) # Usage: # (make* "$(eval $(call PRINT_RULE,abc,,@echo \"building $$@\"))") define PRINT_RULE $(1): $(2) $(3) endef # Usage: # (make* "$(eval $(call PRINT_LINES,abc:, @echo \"shell command\"))") define PRINT_LINES $(1) $(2) $(3) $(4) $(5) $(6) $(7) $(8) $(9) $(10) $(11) $(12) $(13) $(14) $(15) $(16) $(17) $(18) $(19) $(20) endef ================================================ FILE: impls/make/run ================================================ #!/usr/bin/env bash exec make --no-print-directory -f $(dirname $0)/${STEP:-stepA_mal}.mk "${@}" ================================================ FILE: impls/make/step0_repl.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk SHELL := /usr/bin/env bash define READ $1 endef define EVAL $1 endef define PRINT $1 endef REP = $(call PRINT,$(call EVAL,$(READ))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Call the read-eval-print loop $(REPL) # Do not complain that there is no target. .PHONY: none none: @true ================================================ FILE: impls/make/step1_read_print.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: just return the input define EVAL $(if $(__ERROR)\ ,,$1) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: read, eval, print, loop REP = $(call PRINT,$(call EVAL,$(READ))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # repl loop $(REPL) # Do not complain that there is no target. .PHONY: none none: @true ================================================ FILE: impls/make/step2_eval.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash EVAL_DEBUG ?= # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call _get,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef define EVAL $(if $(__ERROR)\ ,,$(if $(EVAL_DEBUG),\ $(call print,EVAL: $(call _pr_str,$1,yes)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call hash-map,$(foreach f,+ - * /\ ,$(call _symbol,$f) $(call _corefn,$f))) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # repl loop $(REPL) # Do not complain that there is no target. .PHONY: none none: @true ================================================ FILE: impls/make/step3_env.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Setup the environment $(foreach f,+ - * /\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # repl loop $(REPL) # Do not complain that there is no target. .PHONY: none none: @true ================================================ FILE: impls/make/step4_if_fn_do.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) # repl loop $(REPL) # Do not complain that there is no target. .PHONY: none none: @true ================================================ FILE: impls/make/step6_file.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) core_eval = $(call EVAL,$1,$(REPL_ENV)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) $(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line $(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) else # repl loop $(REPL) endif # Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true ================================================ FILE: impls/make/step7_quote.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter # If $1 is empty, `foreach` does no iteration at all. starts_with? = $(foreach f,$(firstword $1)\ ,$(and $(call _symbol?,$f),\ $(filter $2,$(call _symbol_val,$f)))) # elt, accumulator list -> new accumulator list QQ_LOOP = $(if $(and $(_list?),\ $(call starts_with?,$(_seq_vals),splice-unquote))\ ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list QQ_FOLD = $(if $1\ ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ ),$(call list)) QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) QUASIQUOTE_nil = $1 QUASIQUOTE_true = $1 QUASIQUOTE_false = $1 QUASIQUOTE_string = $1 QUASIQUOTE_number = $1 QUASIQUOTE_keyword = $1 QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ ,$(lastword $(_seq_vals))$(rem \ ),$(call QQ_FOLD,$(_seq_vals))) EVAL_special_quote = $1 EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) core_eval = $(call EVAL,$1,$(REPL_ENV)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) $(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line $(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) else # repl loop $(REPL) endif # Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true ================================================ FILE: impls/make/step8_macros.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter # If $1 is empty, `foreach` does no iteration at all. starts_with? = $(foreach f,$(firstword $1)\ ,$(and $(call _symbol?,$f),\ $(filter $2,$(call _symbol_val,$f)))) # elt, accumulator list -> new accumulator list QQ_LOOP = $(if $(and $(_list?),\ $(call starts_with?,$(_seq_vals),splice-unquote))\ ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list QQ_FOLD = $(if $1\ ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ ),$(call list)) QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) QUASIQUOTE_nil = $1 QUASIQUOTE_true = $1 QUASIQUOTE_false = $1 QUASIQUOTE_string = $1 QUASIQUOTE_number = $1 QUASIQUOTE_keyword = $1 QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ ,$(lastword $(_seq_vals))$(rem \ ),$(call QQ_FOLD,$(_seq_vals))) EVAL_special_quote = $1 EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(if $(call _macro?,$f)\ ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) endef define EVAL_special_defmacro! $(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) core_eval = $(call EVAL,$1,$(REPL_ENV)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) $(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) $(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line $(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) else # repl loop $(REPL) endif # Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true ================================================ FILE: impls/make/step9_try.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter # If $1 is empty, `foreach` does no iteration at all. starts_with? = $(foreach f,$(firstword $1)\ ,$(and $(call _symbol?,$f),\ $(filter $2,$(call _symbol_val,$f)))) # elt, accumulator list -> new accumulator list QQ_LOOP = $(if $(and $(_list?),\ $(call starts_with?,$(_seq_vals),splice-unquote))\ ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list QQ_FOLD = $(if $1\ ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ ),$(call list)) QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) QUASIQUOTE_nil = $1 QUASIQUOTE_true = $1 QUASIQUOTE_false = $1 QUASIQUOTE_string = $1 QUASIQUOTE_number = $1 QUASIQUOTE_keyword = $1 QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ ,$(lastword $(_seq_vals))$(rem \ ),$(call QQ_FOLD,$(_seq_vals))) EVAL_special_quote = $1 EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(if $(call _macro?,$f)\ ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) endef define EVAL_special_defmacro! $(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) # EVAL may fail and return nothing, so the first foreach may execute # nothing, so we need to duplicate the test for error. # The second foreach deliberately does nothing when there is no # catch_list. define EVAL_special_try* $(foreach res,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)))$(rem \ )$(if $(__ERROR)\ ,$(foreach catch_list,$(word 2,$1)\ ,$(foreach env,$(call ENV,$2)\ ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ )$(eval __ERROR :=)$(rem \ )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) endef define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) core_eval = $(call EVAL,$1,$(REPL_ENV)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) $(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) $(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line $(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) else # repl loop $(REPL) endif # Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true ================================================ FILE: impls/make/stepA_mal.mk ================================================ # # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /usr/bin/env bash # READ: read and parse input define READ $(READ_STR) endef # EVAL: evaluate the parameter # If $1 is empty, `foreach` does no iteration at all. starts_with? = $(foreach f,$(firstword $1)\ ,$(and $(call _symbol?,$f),\ $(filter $2,$(call _symbol_val,$f)))) # elt, accumulator list -> new accumulator list QQ_LOOP = $(if $(and $(_list?),\ $(call starts_with?,$(_seq_vals),splice-unquote))\ ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list QQ_FOLD = $(if $1\ ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ ),$(call list)) QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) QUASIQUOTE_nil = $1 QUASIQUOTE_true = $1 QUASIQUOTE_false = $1 QUASIQUOTE_string = $1 QUASIQUOTE_number = $1 QUASIQUOTE_keyword = $1 QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ ,$(lastword $(_seq_vals))$(rem \ ),$(call QQ_FOLD,$(_seq_vals))) EVAL_special_quote = $1 EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) EVAL_nil = $1 EVAL_true = $1 EVAL_false = $1 EVAL_string = $1 EVAL_number = $1 EVAL_keyword = $1 EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) # First foreach defines a constant, second one loops on keys. define EVAL_map $(foreach obj,$(call _map_new)\ ,$(obj)$(rem $(foreach k,$(_keys)\ ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef define EVAL_list $(if $(_seq_vals)\ ,$(foreach a0,$(firstword $(_seq_vals))\ ,$(if $(call _symbol?,$(a0))\ ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ ,$(if $(filter undefined,$(flavor $(dispatch)))\ ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ ),$1) endef define EVAL_apply $(foreach f,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(if $(call _macro?,$f)\ ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) endef define EVAL_special_defmacro! $(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) endef define EVAL_special_def! $(foreach res,$(call EVAL,$(lastword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef define EVAL_special_let* $(foreach let_env,$(call ENV,$2)\ ,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ )$(call EVAL,$(lastword $1),$(let_env))) endef EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) define EVAL_special_if $(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ ,$(call EVAL,$(word 2,$1),$2)$(rem \ ),$(if $(word 3,$1)\ ,$(call EVAL,$(lastword $1),$2)$(rem \ ),$(__nil))) endef EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) # EVAL may fail and return nothing, so the first foreach may execute # nothing, so we need to duplicate the test for error. # The second foreach deliberately does nothing when there is no # catch_list. define EVAL_special_try* $(foreach res,$(call EVAL,$(firstword $1),$2)\ ,$(if $(__ERROR)\ ,,$(res)))$(rem \ )$(if $(__ERROR)\ ,$(foreach catch_list,$(word 2,$1)\ ,$(foreach env,$(call ENV,$2)\ ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ )$(eval __ERROR :=)$(rem \ )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) endef define EVAL_special_make* $(eval __result := $(call str_decode_nospace,$(_string_val)))$(rem \ )$(call _string,$(call str_encode_nospace,$(__result))) endef define EVAL $(if $(__ERROR)\ ,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ )$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT $(if $(__ERROR)\ ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) # The foreach does nothing when line is empty (EOF). define REPL $(foreach line,$(call READLINE,user>$(_SP))\ ,$(eval __ERROR :=)$(rem \ )$(call print,$(call REP,$(line:ok=)))$(rem \ )$(call REPL)) endef # Read and evaluate for side effects but ignore the result. define RE $(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ )$(if $(__ERROR)\ ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) endef # core.mk: defined using Make $(foreach f,$(core_ns)\ ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) core_eval = $(call EVAL,$1,$(REPL_ENV)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) $(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself $(call RE, (def! not (fn* (a) (if a false true))) ) $(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) $(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) $(call RE, (def! *host-language* "make") ) ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line $(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) else # repl loop $(call RE, (println (str "Mal [" *host-language* "]")) ) $(REPL) endif # Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true ================================================ FILE: impls/make/tests/stepA_mal.mal ================================================ ;; Testing basic make interop (make* "7") ;=>"7" (make* "$(info foo)") ;/foo ;=>"" (make* "$(eval foo := 8)") (make* "$(foo)") ;=>"8" (make* "$(foreach v,a b c,X$(v)Y)") ;=>"XaY XbY XcY" (read-string (make* "($(foreach v,1 2 3,$(call int_add,1,$(v))))")) ;=>(2 3 4) ================================================ FILE: impls/make/types.mk ================================================ # # mal (Make a Lisp) object types # ifndef __mal_types_included __mal_types_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)gmsl.mk include $(_TOP_DIR)util.mk include $(_TOP_DIR)numbers.mk # Low-level type implemenation # magic is \u2344 \u204a __obj_magic := ⍄⁊ # \u2256 __obj_hash_code := 0 # 1:type 2:optional content -> variable name define __new_obj $(eval __obj_hash_code := $(call int_add,1,$(__obj_hash_code)))$(rem \ )$(foreach obj,$(__obj_magic)_$(__obj_hash_code)_$1\ ,$(obj)$(if $2,$(eval $(obj) := $2))) endef # Visualize Objects in memory _visualize_memory = $(foreach v,$(sort $(filter $(__obj_magic)_%,$(.VARIABLES)))\ ,$(info $v $($v))) # Errors/Exceptions __ERROR := throw = $(eval __ERROR := $1) _error = $(call throw,$(call _string,$(str_encode_nospace))) # Constant atomic values __nil := _nil __true := _true __false := _false # General functions _obj_type = $(lastword $(subst _, ,$1)) _clone_obj = $(_clone_obj_$(_obj_type)) _clone_obj_list = $(call list,$($1)) _clone_obj_vector = $(call vector,$($1)) _clone_obj_map = $(_map_new) _clone_obj_function = $(call __new_obj,function,$($1)) _clone_obj_corefn = $(call _corefn,$($1)) define _hash_equal? $(if $3\ ,$(and $(call _equal?,$($1_$(firstword $3)),$($2_$(firstword $3))),\ $(call _hash_equal?,$1,$2,$(call _rest,$3)))$(rem \ ),true) endef define _equal?_seq_loop $(if $1\ ,$(and $2,\ $(call _equal?,$(firstword $1),$(firstword $2)),\ $(call _equal?_seq_loop,$(_rest),$(call _rest,$2)))$(rem \ ),$(if $2,,true)) endef define _equal? $(or $(filter $1,$2),\ $(and $(filter %_list %_vector,$1),\ $(filter %_list %_vector,$2),\ $(call _equal?_seq_loop,$($1),$($2))),\ $(and $(filter %_map,$1),\ $(filter %_map,$2),\ $(call _EQ,$(_keys),$(call _keys,$2)),\ $(call _hash_equal?,$1,$2,$(_keys)))) endef _nil? = $(filter $(__nil),$1) _true? = $(filter $(__true),$1) _false? = $(filter $(__false),$1) # Conveniently for DEBUG-EVAL, returns false if $1 is empty. truthy? = $(filter-out _nil _false,$1) # Symbols _symbol = $1_symbol _symbol_val = $(1:_symbol=) _symbol? = $(filter %_symbol,$1) # Keywords _keyword = $1_keyword _keyword? = $(filter %_keyword,$1) _keyword_val = $(1:_keyword=) # Numbers _number = $1_number _number? = $(filter %_number,$1) _number_val = $(1:_number=) # Strings _string = $1_string _string? = $(filter %_string,$1) _string_val = $(1:_string=) # Functions _corefn = $(call __new_obj,corefn,$1) _function = $(call __new_obj,function,$2 $3 $1) _as_macro = $(call __new_obj,macro,$($1)) _fn? = $(filter %_corefn %_function,$1) _macro? = $(filter %_macro,$1) # 1:env 2:formal parameters 3:actual parameters define _function_set_env $(if $2\ ,$(if $(filter &_symbol,$(firstword $2))\ ,$(call ENV_SET,$1,$(lastword $2),$(call list,$3)),$(rem \ else \ $(call ENV_SET,$1,$(firstword $2),$(firstword $3)) $(call _function_set_env,$1,$(call _rest,$2),$(call _rest,$3))))) endef # Takes a function object and a list object of arguments and invokes # the function with space separated arguments define _apply $(if $(filter %_corefn,$1)\ ,$(call $($1),$2)$(rem \ ),$(if $(filter %_function %_macro,$1)\ ,$(foreach env,$(call ENV,$(word 2,$($1)))\ ,$(call _function_set_env,$(env),$(call _rest2,$($1)),$2)$(rem \ )$(call EVAL,$(firstword $($1)),$(env)))$(rem \ ),$(call _error,cannot apply non-function))) endef # Lists list = $(if $1,$(call __new_obj,list,$1),empty_list) _list? = $(filter %_list,$1) _seq_vals = $($1) # Vectors (same as lists for now) vector = $(if $1,$(call __new_obj,vector,$1),empty_vector) _vector? = $(filter %_vector,$1) # Hash maps (associative arrays) # 1:optional source map 2:optional key/value pairs 3:optional removals define _map_new $(foreach obj,$(call __new_obj,map,$(filter-out $3,$(if $1,$($1))))\ ,$(obj)$(rem \ $(foreach k,$($(obj))\ ,$(eval $(obj)_$k := $($1_$k)))\ $(call _foreach2,$2\ ,$$(call _assoc!,$(obj),$$k,$$v)))) endef _hash_map? = $(filter %_map,$1) # set a key/value in the hash map # map key val # sort removes duplicates. _assoc! = $(eval $1_$2 := $3)$(eval $1 := $(sort $($1) $2)) _keys = $($1) # retrieve the value of a plain string key from the hash map, or # return the empty string if the key is missing _get = $($1_$2) # sequence operations _sequential? = $(filter %_list %_vector,$1) # Metadata functions with-meta = $(foreach obj,$(call _clone_obj,$(firstword $1))\ ,$(obj)$(eval $(obj)_meta := $(lastword $1))) meta = $(or $($1_meta),$(__nil)) # atoms atom = $(call __new_obj,atom,$1) _atom? = $(filter %_atom,$1) deref = $($1) _reset = $(eval $1 = $2) endif ================================================ FILE: impls/make/util.mk ================================================ # # mal (Make Lisp) utility functions/definitions # ifndef __mal_util_included __mal_util_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)gmsl.mk encoded_equal := Ξ encoded_colon := κ encoded_slash := λ raw_hash := \# encoded_hash := η COMMA := , COLON := : LPAREN := ( RPAREN := ) SLASH := $(strip \ ) SPACE := SPACE := $(SPACE) $(SPACE) define NEWLINE endef # \u00ab _LP := « # \u00bb _RP := » ## \u00a7 _SP := § ## \u00ae _DOL := Ş ## \u00b6 _NL := ¶ # # Utility functions # _EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) # reverse list of words _reverse = $(if $1,$(call _reverse,$(_rest)) $(firstword $1)) #$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5)) # str_encode: take a string and return an encoded version of it with # every character separated by a space and special characters replaced # with special Unicode characters define str_encode $(eval __temp := $1)$(rem \ )$(foreach a,$(encoded_slash) $(_DOL) $(_LP) $(_RP) $(_NL) \ $(encoded_hash) $(encoded_colon) $(_SP) $(encoded_equal) $(gmsl_characters)\ ,$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(rem \ )$(__temp) endef # str_decode: take an encoded string an return an unencoded version of # it by replacing the special Unicode charactes with the real # characters and with all characters joined into a regular string str_decode = $(subst $(SPACE),,$1) define str_encode_nospace $(subst $(SLASH),$(encoded_slash),$(rem \ )$(subst $$,$(_DOL),$(rem \ )$(subst $(LPAREN),$(_LP),$(rem \ )$(subst $(RPAREN),$(_RP),$(rem \ )$(subst $(NEWLINE),$(_NL),$(rem \ )$(subst $(raw_hash),$(encoded_hash),$(rem \ )$(subst $(COLON),$(encoded_colon),$(rem \ )$(subst $(SPACE),$(_SP),$(rem \ )$(subst =,$(encoded_equal),$(rem \ )$1))))))))) endef define str_decode_nospace $(subst $(encoded_slash),$(SLASH),$(rem \ )$(subst $(_DOL),$$,$(rem \ )$(subst $(_LP),$(LPAREN),$(rem \ )$(subst $(_RP),$(RPAREN),$(rem \ )$(subst $(_NL),$(NEWLINE),$(rem \ )$(subst $(encoded_hash),$(raw_hash),$(rem \ )$(subst $(encoded_colon),$(COLON),$(rem \ )$(subst $(_SP),$(SPACE),$(rem \ )$(subst $(encoded_equal),=,$1))))))))) endef # Read a whole file substituting newlines with $(_NL) _read_file = $(call str_encode_nospace,$(shell \ sed -z 's/\n/$(_NL)/g' '$(str_decode_nospace)')) print = $(info $(str_decode_nospace)) _rest = $(wordlist 2,$(words $1),$1) _rest2 = $(wordlist 3,$(words $1),$1) # Evaluate $2 repeatedly with $k and $v set to key/value pairs from $1. define _foreach2 $(foreach k,$(firstword $1)\ ,$(foreach v,$(word 2,$1)\ ,$(eval $2)$(call _foreach2,$(_rest2),$2))) endef endif ================================================ FILE: impls/matlab/+types/Atom.m ================================================ classdef Atom < handle properties val end methods function atm = Atom(val) atm.val = val; end end end ================================================ FILE: impls/matlab/+types/Function.m ================================================ classdef Function < handle properties fn ast env params is_macro = false; meta = type_utils.nil; end methods function f = Function(fn, ast, env, params) f.fn = fn; f.ast = ast; f.env = env; f.params = params; end function ret = clone(obj) ret = types.Function(obj.fn, obj.ast, obj.env, obj.params); ret.is_macro = obj.is_macro; ret.meta = obj.meta; end end end ================================================ FILE: impls/matlab/+types/HashMap.m ================================================ classdef HashMap < handle properties data meta = type_utils.nil; end methods function obj = HashMap(varargin) if nargin == 0 if exist('OCTAVE_VERSION', 'builtin') ~= 0 obj.data = Dict(); else obj.data = containers.Map(); end else if exist('OCTAVE_VERSION', 'builtin') ~= 0 obj.data = Dict(); for i=1:2:length(varargin) obj.data(varargin{i}) = varargin{i+1}; end else obj.data = containers.Map(varargin(1:2:end), ... varargin(2:2:end)); end end end function len = length(obj) len = length(obj.data); end function ret = get(obj, key) ret = obj.data(key); end function ret = set(obj, key, val) obj.data(key) = val; ret = val; end function ret = keys(obj) ret = obj.data.keys(); end function ret = values(obj) ret = obj.data.values(); end function ret = clone(obj) ret = types.HashMap(); if length(obj) > 0 if exist('OCTAVE_VERSION', 'builtin') ~= 0 ret.data = Dict(obj.data.keys(), obj.data.values()); else ret.data = containers.Map(obj.data.keys(), obj.data.values()); end else if exist('OCTAVE_VERSION', 'builtin') ~= 0 ret.data = Dict(); else ret.data = containers.Map(); end end ret.meta = obj.meta; end end end ================================================ FILE: impls/matlab/+types/List.m ================================================ classdef List < handle properties data meta = type_utils.nil; end methods function obj = List(varargin) obj.data = varargin; meta = type_utils.nil; end function len = length(obj) len = length(obj.data); end function ret = get(obj, idx) ret = obj.data{idx}; end function ret = set(obj, key, val) obj.data{key} = val; ret = val; end function ret = append(obj, val) obj.data{end+1} = val; ret = val; end function ret = slice(obj, start, last) if nargin < 3 last = length(obj.data); end ret = types.List(obj.data{start:last}); end function ret = clone(obj) ret = types.List(); ret.data = obj.data; ret.meta = obj.meta; end % function varargout = subsref(vec, S) % % This doesn't work for ranges % [varargout{1:nargout}] = builtin('subsref', vec.data, S); % % varargout = cell(1,max(1,nargout)); % [varargout{:}] = builtin('subsref',vec.data,S); % %% switch S.type %% case '()' %% varargout = cell(1,numel(vec)); %% varargout{1} = builtin('subsref', vec.data, S); %% case '{}' %% varargout = cell(1,numel(vec)); %% varargout{1} = builtin('subsref', vec.data, S); %% case '.' %% error('Vector property access not yet implemented'); %% end % end % %function n = numel(varargin) % % n = 1; % %end end end ================================================ FILE: impls/matlab/+types/MalException.m ================================================ classdef MalException < MException properties obj end methods function exc = MalException(obj) exc@MException('MalException:object', 'MalException'); exc.obj = obj; end end end ================================================ FILE: impls/matlab/+types/Nil.m ================================================ classdef Nil methods function len = length(obj) len = 0; end function ret = eq(a,b) ret = strcmp(class(b),'types.Nil'); end end end ================================================ FILE: impls/matlab/+types/Reader.m ================================================ classdef Reader < handle properties tokens position end methods function rdr = Reader(tokens) rdr.tokens = tokens; rdr.position = 1; end function tok = next(rdr) rdr.position = rdr.position + 1; if rdr.position-1 > length(rdr.tokens) tok = false; else tok = rdr.tokens{rdr.position-1}; end end function tok = peek(rdr) if rdr.position > length(rdr.tokens) tok = false; else tok = rdr.tokens{rdr.position}; end end end end ================================================ FILE: impls/matlab/+types/Symbol.m ================================================ classdef Symbol properties name end methods function sym = Symbol(name) sym.name = name; end function ret = eq(a,b) ret = strcmp(a.name, b.name); end end end ================================================ FILE: impls/matlab/+types/Vector.m ================================================ classdef Vector < types.List methods function obj = Vector(varargin) obj.data = varargin; meta = type_utils.nil; end function ret = slice(obj, start, last) if nargin < 3 last = length(obj.data); end ret = types.Vector(obj.data{2:end}); end function ret = clone(obj) ret = types.Vector(); ret.data = obj.data; ret.meta = obj.meta; end end end ================================================ FILE: impls/matlab/.dockerignore ================================================ octave-4.0.0* ================================================ FILE: impls/matlab/Dict.m ================================================ % Implement containers.Map like structure % This only applies to GNU Octave and will break in Matlab when % arbitrary string keys are used. classdef Dict < handle properties data end methods function dict = Dict(keys, values) dict.data = struct(); if nargin > 0 for i=1:length(keys) dict.data.(keys{i}) = values{i}; end end end function ret = subsasgn(dict, ind, val) dict.data.(ind(1).subs{1}) = val; ret = dict; end function ret = subsref(dict, ind) if strcmp('.', ind(1).type) % Function call switch ind(1).subs case 'isKey' if numel(ind) > 1 ret = isfield(dict.data, ind(2).subs{1}); else error('Dict:invalidArgs', ... sprintf('''%s'' called with no arguments', ind(1).subs)); end case 'keys' ret = fieldnames(dict.data); case 'values' ret = {}; keys = fieldnames(dict.data); for i=1:length(keys) ret{end+1} = dict.data.(keys{i}); end case 'remove' if numel(ind) > 1 if numel(ind(2).subs) > 0 dict.data = rmfield(dict.data, ind(2).subs{1}); end else error('Dict:invalidArgs', ... sprintf('''%s'' called with no arguments', ind(1).subs)); end otherwise error('Dict:notfound', ... sprintf('''%s'' not found', ind(1).subs)); end else % Key lookup ret = dict.data.(ind(1).subs{1}); end end end end ================================================ FILE: impls/matlab/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install octave ENV HOME /mal ================================================ FILE: impls/matlab/Env.m ================================================ classdef Env < handle properties data outer end methods function env = Env(outer, binds, exprs) if exist('OCTAVE_VERSION', 'builtin') ~= 0 env.data = Dict(); else env.data = containers.Map(); end if nargin == 0 env.outer = false; else % Workaround Octave calling bug when the first % argument is the same type as the class (the class is % not properly initialized in that case) env.outer = outer{1}; end if nargin > 1 %env = Env(outer); for i=1:length(binds) k = binds.get(i).name; if strcmp(k, '&') env.data(binds.get(i+1).name) = exprs.slice(i); break; else env.data(k) = exprs.get(i); end end end end function ret = set(env, k, v) env.data(k.name) = v; ret = v; end function ret = get(env, k) while ~env.data.isKey(k) env = env.outer; if islogical(env) ret = {}; return; end end ret = env.data(k); end end end ================================================ FILE: impls/matlab/Makefile ================================================ all: clean: ================================================ FILE: impls/matlab/core.m ================================================ classdef core methods(Static) function ret = throw(obj) ret = type_utils.nil; if exist('OCTAVE_VERSION', 'builtin') ~= 0 % Until Octave has MException objects, we need to % store the error object globally to be able to pass % it to the error handler. global error_object; error_object = obj; exc = struct('identifier', 'MalException:object',... 'message', 'MalException'); rethrow(exc); else throw(types.MalException(obj)); end end function str = pr_str(varargin) strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... 'UniformOutput', false); str = strjoin(strs, ' '); end function str = do_str(varargin) strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... 'UniformOutput', false); str = strjoin(strs, ''); end function ret = prn(varargin) strs = cellfun(@(s) printer.pr_str(s,true), varargin, ... 'UniformOutput', false); fprintf('%s\n', strjoin(strs, ' ')); ret = type_utils.nil; end function ret = println(varargin) strs = cellfun(@(s) printer.pr_str(s,false), varargin, ... 'UniformOutput', false); fprintf('%s\n', strjoin(strs, ' ')); ret = type_utils.nil; end function ret = time_ms() secs = now-repmat(datenum('1970-1-1 00:00:00'),size(now)); ret = floor(secs.*repmat(24*3600.0*1000,size(now))); end function new_hm = assoc(hm, varargin) new_hm = clone(hm); for i=1:2:length(varargin) new_hm.set(varargin{i}, varargin{i+1}); end end function new_hm = dissoc(hm, varargin) new_hm = clone(hm); ks = intersect(hm.keys(),varargin); if exist('OCTAVE_VERSION', 'builtin') ~= 0 new_hm.data.remove(ks); else remove(new_hm.data, ks); end end function ret = get(hm, key) if isa(hm, 'types.Nil') ret = type_utils.nil; elseif hm.data.isKey(key) ret = hm.data(key); else ret = type_utils.nil; end end function ret = keys(hm) ks = hm.keys(); ret = types.List(ks{:}); end function ret = vals(hm) vs = hm.values(); ret = types.List(vs{:}); end function ret = cons(a, seq) cella = [{a}, seq.data]; ret = types.List(cella{:}); end function ret = concat(varargin) if nargin == 0 cella = {}; else cells = cellfun(@(x) x.data, varargin, ... 'UniformOutput', false); cella = cat(2,cells{:}); end ret = types.List(cella{:}); end function ret = first(seq) if isa(seq, 'types.Nil') ret = type_utils.nil; elseif length(seq) < 1 ret = type_utils.nil; else ret = seq.get(1); end end function ret = rest(seq) if isa(seq, 'types.Nil') ret = types.List(); else cella = seq.data(2:end); ret = types.List(cella{:}); end end function ret = nth(seq, idx) if idx+1 > length(seq) if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('Range:nth', ... 'nth: index out of range'); else throw(MException('Range:nth', ... 'nth: index out of range')) end end ret = seq.get(idx+1); end function ret = apply(varargin) f = varargin{1}; if isa(f, 'types.Function') f = f.fn; end first_args = varargin(2:end-1); rest_args = varargin{end}.data; args = [first_args rest_args]; ret = f(args{:}); end function ret = map(f, lst) if isa(f, 'types.Function') f = f.fn; end cells = cellfun(@(x) f(x), lst.data, 'UniformOutput', false); ret = types.List(cells{:}); end function ret = conj(varargin) seq = varargin{1}; args = varargin(2:end); if type_utils.list_Q(seq) cella = [fliplr(args), seq.data]; ret = types.List(cella{:}); else cella = [seq.data, args]; ret = types.Vector(cella{:}); end end function ret = seq(obj) if type_utils.list_Q(obj) if length(obj) > 0 ret = obj; else ret = type_utils.nil; end elseif type_utils.vector_Q(obj) if length(obj) > 0 ret = types.List(obj.data{:}); else ret = type_utils.nil; end elseif type_utils.string_Q(obj) if length(obj) > 0 cells = cellfun(@(c) char(c),... num2cell(double(obj)),... 'UniformOutput', false); ret = types.List(cells{:}); else ret = type_utils.nil; end elseif isa(obj, 'types.Nil') ret = type_utils.nil; else if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('Type:seq', ... 'seq: called on non-sequence'); else throw(MException('Type:seq',... 'seq: called on non-sequence')) end end end function new_obj = with_meta(obj, meta) new_obj = clone(obj); new_obj.meta = meta; end function meta = meta(obj) switch class(obj) case {'types.List', 'types.Vector', 'types.HashMap', 'types.Function'} meta = obj.meta; otherwise meta = type_utils.nil; end end function ret = reset_BANG(atm, val) atm.val = val; ret = val; end function ret = swap_BANG(atm, f, varargin) args = [{atm.val} varargin]; if isa(f, 'types.Function') f = f.fn; end atm.val = f(args{:}); ret = atm.val; end function n = ns() if exist('OCTAVE_VERSION', 'builtin') ~= 0 n = Dict(); else n = containers.Map(); end n('=') = @(a,b) type_utils.equal(a,b); n('throw') = @(a) core.throw(a); n('nil?') = @(a) isa(a, 'types.Nil'); n('true?') = @(a) isa(a, 'logical') && a == true; n('false?') = @(a) isa(a, 'logical') && a == false; n('string?') = @(a) type_utils.string_Q(a); n('symbol') = @(a) types.Symbol(a); n('symbol?') = @(a) isa(a, 'types.Symbol'); n('keyword') = @(a) type_utils.keyword(a); n('keyword?') = @(a) type_utils.keyword_Q(a); n('number?') = @(a) type_utils.number_Q(a); n('fn?') = @(a) type_utils.fn_Q(a); n('macro?') = @(a) type_utils.macro_Q(a); n('pr-str') = @(varargin) core.pr_str(varargin{:}); n('str') = @(varargin) core.do_str(varargin{:}); n('prn') = @(varargin) core.prn(varargin{:}); n('println') = @(varargin) core.println(varargin{:}); n('read-string') = @(a) reader.read_str(a); n('readline') = @(p) input(p, 's'); n('slurp') = @(a) fileread(a); n('<') = @(a,b) a') = @(a,b) a>b; n('>=') = @(a,b) a>=b; n('+') = @(a,b) a+b; n('-') = @(a,b) a-b; n('*') = @(a,b) a*b; n('/') = @(a,b) floor(a/b); n('time-ms') = @() core.time_ms(); n('list') = @(varargin) types.List(varargin{:}); n('list?') = @(a) type_utils.list_Q(a); n('vector') = @(varargin) types.Vector(varargin{:}); n('vector?') = @(a) type_utils.vector_Q(a); n('hash-map') = @(varargin) types.HashMap(varargin{:}); n('map?') = @(a) type_utils.hash_map_Q(a); n('assoc') = @(varargin) core.assoc(varargin{:}); n('dissoc') = @(varargin) core.dissoc(varargin{:}); n('get') = @(a,b) core.get(a,b); n('contains?') = @(a,b) a.data.isKey(b); n('keys') = @(a) core.keys(a); n('vals') = @(a) core.vals(a); 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); n('empty?') = @(a) length(a) == 0; % workaround Octave always giving length(a) of 1 n('count') = @(a) 0 + length(a); n('apply') = @(varargin) core.apply(varargin{:}); n('map') = @(varargin) core.map(varargin{:}); n('conj') = @(varargin) core.conj(varargin{:}); n('seq') = @(a) core.seq(a); n('with-meta') = @(a,b) core.with_meta(a,b); n('meta') = @(a) core.meta(a); n('atom') = @(a) types.Atom(a); n('atom?') = @(a) isa(a, 'types.Atom'); n('deref') = @(a) a.val; n('reset!') = @(a,b) core.reset_BANG(a,b); n('swap!') = @(varargin) core.swap_BANG(varargin{:}); end end end ================================================ FILE: impls/matlab/printer.m ================================================ % this is just being used as a namespace classdef printer methods (Static = true) function str = pr_str(obj, print_readably) switch class(obj) case 'types.Symbol' str = obj.name; case 'double' str = num2str(obj); case 'char' if type_utils.keyword_Q(obj) str = sprintf(':%s', obj(2:end)); else if print_readably str = strrep(obj, '\', '\\'); str = strrep(str, '"', '\"'); str = strrep(str, char(10), '\n'); str = sprintf('"%s"', str); else str = obj; end end case 'types.List' strs = cellfun(@(x) printer.pr_str(x, print_readably), ... obj.data, 'UniformOutput', false); str = sprintf('(%s)', strjoin(strs, ' ')); case 'types.Vector' strs = cellfun(@(x) printer.pr_str(x, print_readably), ... obj.data, 'UniformOutput', false); str = sprintf('[%s]', strjoin(strs, ' ')); case 'types.HashMap' strs = {}; ks = obj.keys(); for i=1:length(ks) k = ks{i}; strs{end+1} = printer.pr_str(k, print_readably); strs{end+1} = printer.pr_str(obj.get(k), print_readably); end str = sprintf('{%s}', strjoin(strs, ' ')); case 'types.Nil' str = 'nil'; case 'logical' if eq(obj, true) str = 'true'; else str = 'false'; end case 'types.Atom' str = sprintf('(atom %s)', printer.pr_str(obj.val,true)); otherwise str = '#'; end end end end ================================================ FILE: impls/matlab/reader.m ================================================ % this is just being used as a namespace classdef reader methods (Static = true) function tokens = tokenize(str) re = '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"?|;[^\n]*|[^\s\[\]{}(''"`,;)]*)'; % extract the capture group (to ignore spaces and commas) tokens = cellfun(@(x) x(1), regexp(str, re, 'tokens')); comments = cellfun(@(x) length(x) > 0 && x(1) == ';', tokens); tokens = tokens(~comments); end function atm = read_atom(rdr) token = rdr.next(); %fprintf('in read_atom: %s\n', token); if not(isempty(regexp(token, '^-?[0-9]+$', 'match'))) atm = str2double(token); elseif not(isempty(regexp(token, '^"(?:\\.|[^\\"])*"$', 'match'))) atm = token(2:length(token)-1); % If overlaps is enabled here then only the first '\\' % is replaced. Probably an GNU Octave bug since the % other repeated pairs are substituted correctly. atm = strrep(atm, '\\', char(255), 'overlaps', false); atm = strrep(atm, '\"', '"'); atm = strrep(atm, '\n', char(10)); atm = strrep(atm, char(255), '\'); elseif strcmp(token(1), '"') error('expected ''"'', got EOF'); elseif strcmp(token(1), ':') s = token(2:end); atm = type_utils.keyword(s); elseif strcmp(token, 'nil') atm = type_utils.nil; elseif strcmp(token, 'true') atm = true; elseif strcmp(token, 'false') atm = false; else atm = types.Symbol(token); end end function seq = read_seq(rdr, start, last) %fprintf('in read_seq\n'); seq = {}; token = rdr.next(); if not(strcmp(token, start)) error(sprintf('expected ''%s'', got EOF', start)); end token = rdr.peek(); while true if eq(token, false) error(sprintf('expected ''%s'', got EOF', last)); end if strcmp(token, last), break, end seq{end+1} = reader.read_form(rdr); token = rdr.peek(); end rdr.next(); end function lst = read_list(rdr) seq = reader.read_seq(rdr, '(', ')'); lst = types.List(seq{:}); end function vec = read_vector(rdr) seq = reader.read_seq(rdr, '[', ']'); vec = types.Vector(seq{:}); end function map = read_hash_map(rdr) seq = reader.read_seq(rdr, '{', '}'); map = types.HashMap(seq{:}); end function ast = read_form(rdr) %fprintf('in read_form\n'); token = rdr.peek(); switch token case '''' rdr.next(); ast = types.List(types.Symbol('quote'), ... reader.read_form(rdr)); case '`' rdr.next(); ast = types.List(types.Symbol('quasiquote'), ... reader.read_form(rdr)); case '~' rdr.next(); ast = types.List(types.Symbol('unquote'), ... reader.read_form(rdr)); case '~@' rdr.next(); ast = types.List(types.Symbol('splice-unquote'), ... reader.read_form(rdr)); case '^' rdr.next(); meta = reader.read_form(rdr); ast = types.List(types.Symbol('with-meta'), ... reader.read_form(rdr), meta); case '@' rdr.next(); ast = types.List(types.Symbol('deref'), ... reader.read_form(rdr)); case ')' error('unexpected '')'''); case '(' ast = reader.read_list(rdr); case ']' error('unexpected '']'''); case '[' ast = reader.read_vector(rdr); case '}' error('unexpected ''}'''); case '{' ast = reader.read_hash_map(rdr); otherwise ast = reader.read_atom(rdr); end end function ast = read_str(str) %fprintf('in read_str\n'); tokens = reader.tokenize(str); %disp(tokens); rdr = types.Reader(tokens); ast = reader.read_form(rdr); end end end ================================================ FILE: impls/matlab/run ================================================ #!/bin/sh args= for x; do args="$args${args:+, }'$x'" done case "$matlab_MODE" in matlab) options='-nodisplay -nosplash -nodesktop -nojvm -r' ;; octave) options='-q --no-gui --no-history --eval' ;; *) echo "Bad matlab_MODE: $matlab_MODE" exit 1 ;; esac exec $matlab_MODE $options "${STEP:-stepA_mal}($args);quit;" ================================================ FILE: impls/matlab/step0_repl.m ================================================ function step0_repl(varargin), main(varargin), end % read function ret = READ(str) ret = str; end % eval function ret = EVAL(ast, env) ret = ast; end % print function ret = PRINT(ast) ret = ast; end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) while (true) line = input('user> ', 's'); fprintf('%s\n', rep(line, '')); end end ================================================ FILE: impls/matlab/step1_read_print.m ================================================ function step1_read_print(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) ret = ast; end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, '')); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step2_eval.m ================================================ function step2_eval(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) % fprintf('EVAL: %s\n', printer.pr_str(ast, true)); switch class(ast) case 'types.Symbol' ret = env(ast.name); return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end ret = f(args.data{:}); end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) if exist('OCTAVE_VERSION', 'builtin') ~= 0 repl_env = Dict(); else repl_env = containers.Map(); end repl_env('+') = @(a,b) a+b; repl_env('-') = @(a,b) a-b; repl_env('*') = @(a,b) a*b; repl_env('/') = @(a,b) floor(a/b); %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step3_env.m ================================================ function step3_env(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end ret = EVAL(ast.get(3), let_env); otherwise f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end ret = f(args.data{:}); end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); repl_env.set(types.Symbol('+'), @(a,b) a+b); repl_env.set(types.Symbol('-'), @(a,b) a-b); repl_env.set(types.Symbol('*'), @(a,b) a*b); repl_env.set(types.Symbol('/'), @(a,b) floor(a/b)); %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step4_if_fn_do.m ================================================ function step4_if_fn_do(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end ret = EVAL(ast.get(3), let_env); case 'do' for i=2:length(ast) ret = EVAL(ast.get(i), env); end case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ret = EVAL(ast.get(4), env); else ret = type_utils.nil; end else ret = EVAL(ast.get(3), env); end case 'fn*' ret = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); otherwise f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end ret = f(args.data{:}); end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step5_tco.m ================================================ function step5_tco(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step6_file.m ================================================ function step6_file(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); rest_args = args(2:end); repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); if ~isempty(args) rep(sprintf('(load-file "%s")', args{1}), repl_env); quit; end %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step7_quote.m ================================================ function step7_quote(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval 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) 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); otherwise ret = ast; end end function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'quote' ret = ast.get(2); return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); rest_args = args(2:end); repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); if ~isempty(args) rep(sprintf('(load-file "%s")', args{1}), repl_env); quit; end %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step8_macros.m ================================================ function step8_macros(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval 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) 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); otherwise ret = ast; end end function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'quote' ret = ast.get(2); return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); if isa(f,'types.Function') && f.is_macro ast = f.fn(ast.slice(2).data{:}); % TCO else args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); rest_args = args(2:end); repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); 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)))))))', repl_env); if ~isempty(args) rep(sprintf('(load-file "%s")', args{1}), repl_env); quit; end %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err fprintf('Error: %s\n', err.message); type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/step9_try.m ================================================ function step9_try(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval 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) 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); otherwise ret = ast; end end function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'quote' ret = ast.get(2); return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; case 'try*' try ret = EVAL(ast.get(2), env); return; catch e if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') if strcmp(e.identifier, 'MalException:object') if exist('OCTAVE_VERSION', 'builtin') ~= 0 global error_object; exc = error_object; else exc = e.obj; end else exc = e.message; end catch_env = Env({env}, types.List(ast.get(3).get(2)), ... types.List(exc)); ret = EVAL(ast.get(3).get(3), catch_env); return; else rethrow(e); end end case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); if isa(f,'types.Function') && f.is_macro ast = f.fn(ast.slice(2).data{:}); % TCO else args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); rest_args = args(2:end); repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); % core.mal: defined using the langauge itself rep('(def! not (fn* (a) (if a false true)))', repl_env); rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); 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)))))))', repl_env); if ~isempty(args) rep(sprintf('(load-file "%s")', args{1}), repl_env); quit; end %cleanObj = onCleanup(@() disp('*** here1 ***')); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err if strcmp('MalException:object', err.identifier) if exist('OCTAVE_VERSION', 'builtin') ~= 0 global error_object; fprintf('Error: %s\n', printer.pr_str(error_object, true)); else fprintf('Error: %s\n', printer.pr_str(err.obj, true)); end else fprintf('Error: %s\n', err.message); end type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/stepA_mal.m ================================================ function stepA_mal(varargin), main(varargin), end % read function ret = READ(str) ret = reader.read_str(str); end % eval 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) 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); otherwise ret = ast; end end function ret = EVAL(ast, env) while true dbgeval = env.get('DEBUG-EVAL'); if ~isequal(dbgeval, {}) ... && ~strcmp(class(dbgeval), 'types.Nil') ... && (~islogical(dbgeval) || dbgeval) fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end switch class(ast) case 'types.Symbol' ret = env.get(ast.name); if isequal(ret, {}) msg = sprintf('''%s'' not found', ast.name); if exist('OCTAVE_VERSION', 'builtin') ~= 0 error('ENV:notfound', msg); else throw(MException('ENV:notfound', msg)); end end return; case 'types.List' % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); for i=1:length(ks) k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end return; otherwise ret = ast; return; end % apply if length(ast) == 0 ret = ast; return; end if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else a1sym = '_@$fn$@_'; end switch (a1sym) case 'def!' ret = env.set(ast.get(2), EVAL(ast.get(3), env)); return; case 'let*' let_env = Env({env}); for i=1:2:length(ast.get(2)) let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env)); end env = let_env; ast = ast.get(3); % TCO case 'quote' ret = ast.get(2); return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; case 'try*' try ret = EVAL(ast.get(2), env); return; catch e if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*') if strcmp(e.identifier, 'MalException:object') if exist('OCTAVE_VERSION', 'builtin') ~= 0 global error_object; exc = error_object; else exc = e.obj; end else exc = e.message; end catch_env = Env({env}, types.List(ast.get(3).get(2)), ... types.List(exc)); ret = EVAL(ast.get(3).get(3), catch_env); return; else rethrow(e); end end case 'do' for i=2:(length(ast) -1) ret = EVAL(ast.get(i), env); end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... (islogical(cond) && cond == false) if length(ast) > 3 ast = ast.get(4); % TCO else ret = type_utils.nil; return; end else ast = ast.get(3); % TCO end case 'fn*' fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise f = EVAL(ast.get(1), env); if isa(f,'types.Function') && f.is_macro ast = f.fn(ast.slice(2).data{:}); % TCO else args = types.List(); for i=2:length(ast) args.append(EVAL(ast.get(i), env)); end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO else ret = f(args.data{:}); return end end end end end % print function ret = PRINT(ast) ret = printer.pr_str(ast, true); end % REPL function ret = rep(str, env) ret = PRINT(EVAL(READ(str), env)); end function main(args) repl_env = Env(); % core.m: defined using matlab ns = core.ns(); ks = ns.keys(); for i=1:length(ks) k = ks{i}; repl_env.set(types.Symbol(k), ns(k)); end repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env)); rest_args = args(2:end); repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:})); % core.mal: defined using the langauge itself rep('(def! *host-language* "matlab")', repl_env); rep('(def! not (fn* (a) (if a false true)))', repl_env); rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"', repl_env); 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)))))))', repl_env); if ~isempty(args) rep(sprintf('(load-file "%s")', args{1}), repl_env); quit; end %cleanObj = onCleanup(@() disp('*** here1 ***')); rep('(println (str "Mal [" *host-language* "]"))', repl_env); while (true) try line = input('user> ', 's'); catch err return end if strcmp(strtrim(line),''), continue, end try fprintf('%s\n', rep(line, repl_env)); catch err if strcmp('MalException:object', err.identifier) if exist('OCTAVE_VERSION', 'builtin') ~= 0 global error_object; fprintf('Error: %s\n', printer.pr_str(error_object, true)); else fprintf('Error: %s\n', printer.pr_str(err.obj, true)); end else fprintf('Error: %s\n', err.message); end type_utils.print_stack(err); end end end ================================================ FILE: impls/matlab/type_utils.m ================================================ classdef type_utils properties (Constant = true) nil = types.Nil(); end methods(Static) function ret = equal(a,b) ret = false; ota = class(a); otb = class(b); if ~(strcmp(ota,otb) || ... (type_utils.sequential_Q(a) && type_utils.sequential_Q(b))) return; end switch (ota) case {'types.List', 'types.Vector'} if ~(length(a) == length(b)) return; end for i=1:length(a) if ~(type_utils.equal(a.get(i), b.get(i))) return; end end ret = true; case 'types.HashMap' if ~(length(a) == length(b)) return; end ks1 = a.keys(); for i=1:length(ks1) k = ks1{i}; if ~(b.data.isKey(k)) return; end if ~(type_utils.equal(a.data(k), b.data(k))) return; end end ret = true; case 'char' ret = strcmp(a,b); otherwise ret = a == b; end end function ret = sequential_Q(obj) ret = strcmp(class(obj), 'types.List') || ... strcmp(class(obj), 'types.Vector'); end function ret = list_Q(obj) ret = strcmp(class(obj), 'types.List'); end function ret = vector_Q(obj) ret = strcmp(class(obj), 'types.Vector'); end function ret = hash_map_Q(obj) ret = strcmp(class(obj), 'types.HashMap'); end function ret = keyword(str) if type_utils.keyword_Q(str) ret = str; else ret = sprintf('%c%s', 255, str); end end function ret = keyword_Q(obj) ret = length(obj) > 1 && strcmp(obj(1), sprintf('%c', 255)); end function ret = string_Q(obj) ret = strcmp(class(obj), 'char') && ~type_utils.keyword_Q(obj); end function ret = number_Q(obj) ret = strcmp(class(obj), 'double'); end function ret = fn_Q(obj) ret = isa(obj,'function_handle') || ... (isa(obj,'types.Function') && ~obj.is_macro); end function ret = macro_Q(obj) ret = isa(obj,'types.Function') && obj.is_macro; end function print_stack(err) for i=1:numel(err.stack) stack = err.stack(i); if exist('OCTAVE_VERSION', 'builtin') ~= 0 fprintf(' %s at line %d column %d (%s)\n', ... stack.name, stack.line, stack.column, stack.file); else fprintf(' %s at line %d (%s)\n', ... stack.name, stack.line, stack.file); end end end end end ================================================ FILE: impls/miniMAL/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: miniMAL" ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # For building node modules RUN apt-get -y install g++ libreadline-dev nodejs npm ENV NPM_CONFIG_CACHE /mal/.npm # install miniMAL itself RUN npm install -g minimal-lisp@1.2.2 ================================================ FILE: impls/miniMAL/Makefile ================================================ SOURCES_BASE = node_readline.js miniMAL-core.json \ types.json reader.json printer.json SOURCES_LISP = env.json core.json stepA_mal.json SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) FFI_STEPS = step4_if_fn_do step5_tco step6_file \ step7_quote step8_macros step9_try stepA_mal all: node_modules node_modules: npm install $(foreach S,$(FFI_STEPS),$(S).json): node_modules dist: mal.json mal mal.json: $(filter-out %.js,$(SOURCES)) echo '["do",' >> $@ $(foreach f,$+,\ cat $(f) | egrep -v '^ *[[]"load-file"' >> $@; \ echo "," >> $@;) echo 'null]' >> $@ mal: mal.json echo '#!/usr/bin/env miniMAL' > $@ cat $< >> $@ chmod +x $@ clean: ================================================ FILE: impls/miniMAL/core.json ================================================ ["do", ["def", "_path", ["require", ["`", "path"]]], ["def", "_node_readline", ["require", [".", "_path", ["`", "resolve"], ["`", "."], ["`", "node_readline.js"]]]], ["def", "_string?", ["fn", ["s"], ["and", ["string?", "s"], ["not", ["=", ["`", "\u029e"], ["get", "s", 0]]]]]], ["def", "_function?", ["fn", ["a"], ["isa", "a", "Function"]]], ["def", "_number?", ["fn", ["a"], ["=", ["`", "[object Number]"], ["classOf", "a"]]]], ["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], ["def", "time-ms", ["fn", [], [".", ["new", "Date"], ["`", "getTime"]]]], ["def", "assoc", ["fn", ["src-hm", "&", "kvs"], ["let", ["hm", ["clone", "src-hm"]], ["assocs!", "hm", "kvs"]]]], ["def", "dissoc", ["fn", ["src-hm", "&", "ks"], ["let", ["hm", ["clone", "src-hm"]], ["do", ["map", ["fn", ["k"], ["del", "hm", "k"]], "ks"], "hm"]]]], ["def", "_get", ["fn", ["obj", "key"], ["if", ["null?", "obj"], null, ["if", ["contains?", "obj", "key"], ["get", "obj", "key"], null]]]], ["def", "_count", ["fn", ["a"], ["if", ["=", null, "a"], 0, ["count", "a"]]]], ["def", "_nth", ["fn", ["seq", "idx"], ["if", [">=", "idx", ["count", "seq"]], ["throw", "nth: index out of range"], ["nth", "seq", "idx"]]]], ["def", "_first", ["fn", ["seq"], ["if", ["empty?", "seq"], null, ["first", "seq"]]]], ["def", "_rest", ["fn", ["seq"], ["if", ["empty?", "seq"], ["`", []], ["rest", "seq"]]]], ["def", "_apply", ["fn", ["f", "&", "args"], ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], "fargs", ["concat", ["slice", "args", 0, ["-", ["count", "args"], 1]], ["nth", "args", ["-", ["count", "args"], 1]]]], ["apply", "fn", "fargs"]]]], ["def", "_map", ["fn", ["f", "seq"], ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"]], ["map", "fn", "seq"]]]], ["def", "_conj", ["fn", ["seq", "&", "a"], ["if", ["list?", "seq"], [".", [".", "a", ["`", "reverse"]], ["`", "concat"], "seq"], ["vectorl", [".", "seq", ["`", "concat"], "a"]]]]], ["def", "_seq", ["fn", ["obj"], ["if", ["list?", "obj"], ["if", [">", ["count", "obj"], 0], "obj", null], ["if", ["vector?", "obj"], ["if", [">", ["count", "obj"], 0], ["slice", "obj", 0], null], ["if", ["string?", "obj"], ["if", [">", ["count", "obj"], 0], [".", "obj", ["`", "split"], ["`", ""]], null], ["if", ["null?", "obj"], null, ["throw", "seq: called on non-sequence"] ]]]]]], ["def", "with_meta", ["fn", ["obj", "m"], ["let", ["new-obj", ["clone", "obj"]], ["do", ["set", "new-obj", ["`", "__meta__"], "m"], "new-obj"]]]], ["def", "meta", ["fn", ["obj"], ["if", ["or", ["sequential?", "obj"], ["map?", "obj"], ["malfunc?", "obj"]], ["if", ["contains?", "obj", ["`", "__meta__"]], ["get", "obj", ["`", "__meta__"]], null], null]]], ["def", "reset!", ["fn", ["atm", "val"], ["do", ["set", "atm", ["`", "val"], "val"], "val"]]], ["def", "swap!", ["fn", ["atm", "f", "&", "args"], ["let", ["fn", ["if", ["malfunc?", "f"], ["get", "f", ["`", "fn"]], "f"], "fargs", ["cons", ["get", "atm", ["`", "val"]], "args"], "val", ["apply", "fn", "fargs"]], ["do", ["set", "atm", ["`", "val"], "val"], "val"]]]], ["def", "core-ns", ["hash-map", ["`", "="], "equal?", ["`", "throw"], "throw", ["`", "nil?"], "null?", ["`", "true?"], "true?", ["`", "false?"], "false?", ["`", "string?"], "_string?", ["`", "symbol"], "symbol", ["`", "symbol?"], "symbol?", ["`", "keyword"], "keyword", ["`", "keyword?"], "keyword?", ["`", "number?"], "_number?", ["`", "fn?"], ["fn", ["a"], ["or", ["_function?", "a"], ["and", ["malfunc?", "a"], ["not", ["get", "a", ["`", "macro?"]]]]]], ["`", "macro?"], ["fn", ["a"], ["and", ["malfunc?", "a"], ["get", "a", ["`", "macro?"]]]], ["`", "pr-str"], ["fn", ["&", "a"], ["pr-list", "a", true, ["`", " "]]], ["`", "str"], ["fn", ["&", "a"], ["pr-list", "a", false, ["`", ""]]], ["`", "prn"], ["fn", ["&", "a"], ["do", ["println", ["pr-list", "a", true, ["`", " "]]], null]], ["`", "println"], ["fn", ["&", "a"], ["do", ["println", ["pr-list", "a", false, ["`", " "]]], null]], ["`", "read-string"], "read-str", ["`", "readline"], ["fn", ["p"], [".", "_node_readline", ["`", "readline"], "p"]], ["`", "slurp"], "slurp", ["`", "<"], "<", ["`", "<="], "<=", ["`", ">"], ">", ["`", ">="], ">=", ["`", "+"], "+", ["`", "-"], "-", ["`", "*"], "*", ["`", "/"], "div", ["`", "time-ms"], "time-ms", ["`", "list"], "list", ["`", "list?"], "list?", ["`", "vector"], "vector", ["`", "vector?"], "vector?", ["`", "hash-map"], "hash-map", ["`", "assoc"], "assoc", ["`", "dissoc"], "dissoc", ["`", "map?"], "map?", ["`", "get"], "_get", ["`", "contains?"], "contains?", ["`", "keys"], "keys", ["`", "vals"], "vals", ["`", "sequential?"], "sequential?", ["`", "cons"], "cons", ["`", "concat"], "concat", ["`", "vec"], "vectorl", ["`", "nth"], "_nth", ["`", "first"], "_first", ["`", "rest"], "_rest", ["`", "empty?"], "empty?", ["`", "count"], "_count", ["`", "apply"], "_apply", ["`", "map"], "_map", ["`", "conj"], "_conj", ["`", "seq"], "_seq", ["`", "with-meta"], "with_meta", ["`", "meta"], "meta", ["`", "atom"], "atom", ["`", "atom?"], "atom?", ["`", "deref"], ["fn", ["a"], ["get", "a", ["`", "val"]]], ["`", "reset!"], "reset!", ["`", "swap!"], "swap!"]], null] ================================================ FILE: impls/miniMAL/env.json ================================================ ["do", ["def", "env-bind", ["fn", ["env", "b", "e"], ["if", ["empty?", "b"], "env", ["if", ["=", ["`", "&"], ["get", ["first", "b"], ["`", "val"]]], ["assoc!", "env", ["get", ["nth", "b", 1], ["`", "val"]], "e"], ["env-bind", ["assoc!", "env", ["get", ["first", "b"], ["`", "val"]], ["first", "e"]], ["rest", "b"], ["rest", "e"]]]]]], ["def", "env-new", ["fn", ["&", "args"], ["let", ["env", ["hash-map", ["`", "__outer__"], ["first", "args"]]], ["if", ["<=", ["count", "args"], 1], "env", ["env-bind", "env", ["get", "args", 1], ["get", "args", 2]]]]]], ["def", "env-find", ["fn", ["env", "key"], ["let", ["k", ["get", "key", ["`", "val"]]], ["if", ["contains?", "env", "k"], "env", ["if", ["get", "env", ["`", "__outer__"]], ["env-find", ["get", "env", ["`", "__outer__"]], "key"], null]]]]], ["def", "env-get", ["fn", ["env", "key"], ["let", ["k", ["get", "key", ["`", "val"]], "e", ["env-find", "env", "key"]], ["if", "e", ["get", "e", "k"], ["throw", ["str", ["`", "'"], "k", ["`", "' not found"]]]]]]], ["def", "env-set", ["fn", ["env", "key", "val"], ["let", ["k", ["get", "key", ["`", "val"]]], ["do", ["assoc!", "env", "k", "val"], "val"]]]], null ] ================================================ FILE: impls/miniMAL/miniMAL-core.json ================================================ ["do", ["def", "repl", ["fn",["prompt", "rep"], ["let", ["readline", ["require", ["`", "readline"]], "opts", ["new", "Object"], "_", ["set", "opts", ["`", "input"], [".-", "process", ["`", "stdin"]]], "_", ["set", "opts", ["`", "output"], [".-", "process", ["`", "stdout"]]], "_", ["set", "opts", ["`", "terminal"], false], "rl", [".", "readline", ["`", "createInterface"], "opts"], "evl", ["fn", ["line"], ["do", ["println", ["rep", "line"]], [".", "rl", ["`", "prompt"]]]]], ["do", [".", "rl", ["`", "setPrompt"], "prompt"], [".", "rl", ["`", "prompt"]], [".", "rl", ["`", "on"], ["`", "line"], "evl"]]]]], null ] ================================================ FILE: impls/miniMAL/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL //var RL_LIB = "libedit.so.2"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var koffi = require('koffi'), fs = require('fs'); var rllib = null; try { rllib = koffi.load(RL_LIB); } catch (e) { console.error('ERROR loading RL_LIB:', RL_LIB, e); throw e; } var readlineFunc = rllib.func('char *readline(char *)'); var addHistoryFunc = rllib.func('int add_history(char *)'); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i"]], ["if", ["atom?", "exp"], ["str", ["`", "(atom "], ["get", "exp", ["`", "val"]], ["`", ")"]], ["str", ["`", "#"]]]]]]]]]]]]]]]], ["def", "pr-list", ["fn", ["lst", "print_readably", "sep"], [".", ["map", ["fn", ["s"], ["pr-str", "s", "print_readably"]], "lst"], ["`", "join"], "sep"]]], null ] ================================================ FILE: impls/miniMAL/reader.json ================================================ ["do", ["def", "rdr-new", ["fn", ["tokens"], ["hash-map", ["`", "tokens"], "tokens", ["`", "position"], 0]]], ["def", "rdr-next", ["fn", ["rdr"], ["let", ["pos", ["get", "rdr", ["`", "position"]], "val", ["get", ["get", "rdr", ["`", "tokens"]], "pos"]], ["do", ["assoc!", "rdr", ["`", "position"], ["+", 1, "pos"]], "val"]]]], ["def", "rdr-peek", ["fn", ["rdr"], ["let", ["pos", ["get", "rdr", ["`", "position"]]], ["get", ["get", "rdr", ["`", "tokens"]], "pos"]]]], ["def", "re-matches", ["fn", ["re", "strn", "acc"], ["let", ["match", [".", "re", ["`", "exec"], "strn"], "g1", ["get", "match", 1]], ["if", ["=", "g1", ["`", ""]], "acc", ["re-matches", "re", "strn", ["concat", "acc", "g1"]]]]]], ["def", "tokenize", ["fn", ["strn"], ["let", ["re-str", ["`", "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)"], "re", ["RegExp", "re-str", ["`", "g"]]], [".", ["re-matches", "re", "strn", ["`", []]], ["`", "filter"], ["fn", ["x"], ["not", ["=", ["get", "x", 0], ["`", ";"]]]]]]]], ["def", "read-atom", ["fn", ["rdr"], ["let", ["token", ["rdr-next", "rdr"]], ["if", [".", "token", ["`", "match"], ["RegExp", ["`", "^-?[0-9]+$"]]], ["parseInt", "token", 10], ["if", [".", "token", ["`", "match"], ["RegExp", ["`", "^\"(?:\\\\.|[^\\\\\"])*\"$"]]], [".", ["slice", "token", 1, ["-", ["count", "token"], 1]], ["`", "replace"], ["RegExp", ["`", "\\\\(.)"], ["`", "g"]], ["fn", ["_", "c"], ["if", ["=", "c", ["`", "n"]], ["`", "\n"], "c"]]], ["if", ["=", ["`", "\""], ["get", "token", 0]], ["throw", ["`", "expected '\"', got EOF"]], ["if", ["=", ["`", ":"], ["get", "token", 0]], ["keyword", ["slice", "token", 1]], ["if", ["=", ["`", "nil"], "token"], null, ["if", ["=", ["`", "true"], "token"], true, ["if", ["=", ["`", "false"], "token"], false, ["symbol", "token"]]]]]]]]]]], ["def", "read-list-entries", ["fn", ["rdr", "start", "end"], ["let", ["tok", ["rdr-peek", "rdr"]], ["if", "tok", ["if", ["=", "end", "tok"], ["`", []], ["cons", ["read-form", "rdr"], ["read-list-entries", "rdr", "start", "end"]]], ["throw", ["str", ["`", "expected "], "end", ["`", ", got EOF"]]]]]]], ["def", "read-list", ["fn", ["rdr", "start", "end"], ["let", ["token", ["rdr-next", "rdr"]], ["if", ["=", "start", "token"], ["let", ["lst", ["read-list-entries", "rdr", "start", "end"]], ["do", ["rdr-next", "rdr"], "lst"]], ["throw", ["str", ["`", "expected "], "start"]]]]]], ["def", "read-form", ["fn", ["rdr"], ["let", ["token", ["rdr-peek", "rdr"]], ["if", ["=", ["`", "'"], "token"], ["do", ["rdr-next", "rdr"], ["list", ["symbol", ["`", "quote"]], ["read-form", "rdr"]]], ["if", ["=", ["`", "`"], "token"], ["do", ["rdr-next", "rdr"], ["list", ["symbol", ["`", "quasiquote"]], ["read-form", "rdr"]]], ["if", ["=", ["`", "~"], "token"], ["do", ["rdr-next", "rdr"], ["list", ["symbol", ["`", "unquote"]], ["read-form", "rdr"]]], ["if", ["=", ["`", "~@"], "token"], ["do", ["rdr-next", "rdr"], ["list", ["symbol", ["`", "splice-unquote"]], ["read-form", "rdr"]]], ["if", ["=", ["`", "^"], "token"], ["do", ["rdr-next", "rdr"], ["let", ["meta", ["read-form", "rdr"]], ["list", ["symbol", ["`", "with-meta"]], ["read-form", "rdr"], "meta"]]], ["if", ["=", ["`", "@"], "token"], ["do", ["rdr-next", "rdr"], ["list", ["symbol", ["`", "deref"]], ["read-form", "rdr"]]], ["if", ["=", ["`", ")"], "token"], ["throw", ["`", "unexpected ')'"]], ["if", ["=", ["`", "("], "token"], ["read-list", "rdr", ["`", "("], ["`", ")"]], ["if", ["=", ["`", "]"], "token"], ["throw", ["`", "unexpected ']'"]], ["if", ["=", ["`", "["], "token"], ["vectorl", ["read-list", "rdr", ["`", "["], ["`", "]"]]], ["if", ["=", ["`", "}"], "token"], ["throw", ["`", "unexpected '}'"]], ["if", ["=", ["`", "{"], "token"], ["apply", "hash-map", ["read-list", "rdr", ["`", "{"], ["`", "}"]]], ["read-atom", "rdr"]]]]]]]]]]]]]]]], ["def", "read-str", ["fn", ["strn"], ["let", ["tokens", ["tokenize", "strn"], "rdr", ["rdr-new", "tokens"]], ["if", ["empty?", "tokens"], null, ["read-form", "rdr"]]]]], null ] ================================================ FILE: impls/miniMAL/run ================================================ #!/usr/bin/env bash cd $(dirname $0) exec miniMAL ./${STEP:-stepA_mal}.json "${@}" ================================================ FILE: impls/miniMAL/step0_repl.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["def", "READ", ["fn", ["strng"], "strng"]], ["def", "EVAL", ["fn", ["ast", "env"], "ast"]], ["def", "PRINT", ["fn", ["exp"], "exp"]], ["def", "rep", ["fn", ["strng"], ["PRINT", ["EVAL", ["READ", "strng"], null]]]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step1_read_print.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "EVAL", ["fn", ["ast", "env"], "ast"]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], null]], ["catch", "exc", ["str", ["`", "Error: "], "exc"]]]]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step2_eval.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "EVAL", ["fn", ["ast", "env"], ["if", ["symbol?", "ast"], ["let", ["sym", ["get", "ast", ["`", "val"]]], ["if", ["contains?", "env", "sym"], ["get", "env", "sym"], ["throw", ["str", ["`", "'"], "sym", ["`", "' not found"]]]]], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["apply", "f", "args"]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["hash-map", ["`", "+"], "+", ["`", "-"], "-", ["`", "*"], "*", ["`", "/"], ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step3_env.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["apply", "f", "args"]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["env-set", "repl-env", ["symbol", ["`", "+"]], "+"], ["env-set", "repl-env", ["symbol", ["`", "-"]], "-"], ["env-set", "repl-env", ["symbol", ["`", "*"]], "*"], ["def", "div", ["fn", ["a", "b"], ["parseInt", ["/", "a", "b"]]]], ["env-set", "repl-env", ["symbol", ["`", "/"]], "div"], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], [".", "exc", ["`", "toString"]]]]]]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step4_if_fn_do.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["rest", "ast"]]], ["nth", "el", ["-", ["count", "el"], 1]]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["apply", "f", "args"]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step5_tco.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], ["apply", "f", "args"]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["repl", ["`", "user> "], "rep"], null ] ================================================ FILE: impls/miniMAL/step6_file.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], ["apply", "f", "args"]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], ["if", ["not", ["empty?", "argv"]], ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["repl", ["`", "user> "], "rep"]], null ] ================================================ FILE: impls/miniMAL/step7_quote.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["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", ["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"], "ast"]]]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["el", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], "f", ["first", "el"], "args", ["rest", "el"]], ["if", ["malfunc?", "f"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], ["if", ["not", ["empty?", "argv"]], ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["repl", ["`", "user> "], "rep"]], null ] ================================================ FILE: impls/miniMAL/step8_macros.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["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", ["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"], "ast"]]]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["f", ["EVAL", ["first", "ast"], "env"], "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], ["if", ["get", "f", ["`", "macro?"]], ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], ["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], ["if", ["not", ["empty?", "argv"]], ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["repl", ["`", "user> "], "rep"]], null ] ================================================ FILE: impls/miniMAL/step9_try.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["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", ["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"], "ast"]]]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], ["let", ["func", ["EVAL", ["nth", "ast", 2], "env"]], ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], ["if", ["=", ["`", "try*"], "a0"], ["if", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], ["get", ["nth", ["nth", "ast", 2], 0], ["`", "val"]]]], ["try", ["EVAL", ["nth", "ast", 1], "env"], ["catch", "exc", ["EVAL", ["nth", ["nth", "ast", 2], 2], ["env-new", "env", ["list", ["nth", ["nth", "ast", 2], 1]], ["list", "exc"]]]]], ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["f", ["EVAL", ["first", "ast"], "env"], "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], ["if", ["get", "f", ["`", "macro?"]], ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], ["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], ["if", ["not", ["empty?", "argv"]], ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["repl", ["`", "user> "], "rep"]], null ] ================================================ FILE: impls/miniMAL/stepA_mal.json ================================================ ["do", ["load", ["`", "miniMAL-core.json"]], ["load", ["`", "types.json"]], ["load", ["`", "reader.json"]], ["load", ["`", "printer.json"]], ["load", ["`", "env.json"]], ["load", ["`", "core.json"]], ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], ["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", ["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"], "ast"]]]]], ["def", "LET", ["fn", ["env", "args"], ["if", [">", ["count", "args"], 0], ["do", ["env-set", "env", ["nth", "args", 0], ["EVAL", ["nth", "args", 1], "env"]], ["LET", "env", ["rest", ["rest", "args"]]]]]]], ["def", "EVAL", ["fn", ["ast", "env"], ["do", ["let", ["debug-eval-sym", ["symbol", ["`", "DEBUG-EVAL"]], "debug-eval-env", ["env-find", "env", "debug-eval-sym"]], ["if", ["not", ["=", "debug-eval-env", null]], ["let", ["debug-eval", ["env-get", "debug-eval-env", "debug-eval-sym"]], ["if", ["not", ["or", ["=", "debug-eval", null], ["=", "debug-eval", false]]], ["println", ["`", "EVAL:"], ["pr-str", "ast", true]]]]]], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], ["let", ["new-hm", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["set", "new-hm", "k", ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], ["if", ["not", ["list?", "ast"]], "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], ["if", ["=", ["`", "def!"], "a0"], ["env-set", "env", ["nth", "ast", 1], ["EVAL", ["nth", "ast", 2], "env"]], ["if", ["=", ["`", "let*"], "a0"], ["let", ["let-env", ["env-new", "env"]], ["do", ["LET", "let-env", ["nth", "ast", 1]], ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], ["let", ["func", ["_clone", ["EVAL", ["nth", "ast", 2], "env"]]], ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], ["if", ["=", ["`", "try*"], "a0"], ["if", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], ["get", ["nth", ["nth", "ast", 2], 0], ["`", "val"]]]], ["try", ["EVAL", ["nth", "ast", 1], "env"], ["catch", "exc", ["EVAL", ["nth", ["nth", "ast", 2], 2], ["env-new", "env", ["list", ["nth", ["nth", "ast", 2], 1]], ["list", "exc"]]]]], ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["or", ["=", "cond", null], ["=", "cond", false]], ["if", [">", ["count", "ast"], 3], ["EVAL", ["nth", "ast", 3], "env"], null], ["EVAL", ["nth", "ast", 2], "env"]]], ["if", ["=", ["`", "fn*"], "a0"], ["malfunc", ["fn", ["&", "args"], ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], ["let", ["f", ["EVAL", ["first", "ast"], "env"], "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], ["if", ["get", "f", ["`", "macro?"]], ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], ["def", "repl-env", ["env-new"]], ["def", "rep", ["fn", ["strng"], ["try", ["PRINT", ["EVAL", ["READ", "strng"], "repl-env"]], ["catch", "exc", ["str", ["`", "Error: "], ["if", ["isa", "exc", "Error"], [".", "exc", ["`", "toString"]], ["pr-str", "exc", true]]]]]]], ["`", "core.mal: defined using miniMAL"], ["map", ["fn", ["k"], ["env-set", "repl-env", ["symbol", "k"], ["get", "core-ns", "k"]]], ["keys", "core-ns"]], ["env-set", "repl-env", ["symbol", ["`", "eval"]], ["fn", ["ast"], ["EVAL", "ast", "repl-env"]]], ["env-set", "repl-env", ["symbol", ["`", "*ARGV*"]], ["slice", "argv", 1]], ["`", "core.mal: defined using mal itself"], ["rep", ["`", "(def! *host-language* \"miniMAL\")"]], ["rep", ["`", "(def! not (fn* (a) (if a false true)))"]], ["rep", ["`", "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"]], ["rep", ["`", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"]], ["if", ["not", ["empty?", "argv"]], ["rep", ["str", ["`", "(load-file \""], ["get", "argv", 0], ["`", "\")"]]], ["do", ["rep", ["`", "(println (str \"Mal [\" *host-language* \"]\"))"]], ["repl", ["`", "user> "], "rep"]]], null ] ================================================ FILE: impls/miniMAL/tests/step5_tco.mal ================================================ ;; miniMAL skipping non-TCO recursion ;; Reason: Unrecoverable stack overflow at 10,000 ================================================ FILE: impls/miniMAL/types.json ================================================ ["do", ["`", "Utility Functions"], ["def", "_cmp_seqs", ["fn", ["a", "b"], ["if", ["not", ["=", ["count", "a"], ["count", "b"]]], false, ["if", ["empty?", "a"], true, ["if", ["equal?", ["get", "a", 0], ["get", "b", 0]], ["_cmp_seqs", ["rest", "a"], ["rest", "b"]], false]]]]], ["def", "_check_hash_map_keys", ["fn", ["ks", "a", "b"], ["if", ["empty?", "ks"], true, ["let", ["k", ["first", "ks"]], ["if", ["equal?", ["get", "a", "k"], ["get", "b", "k"]], ["_check_hash_map_keys", ["rest", "ks"], "a", "b"], false]]]]], ["def", "_cmp_hash_maps", ["fn", ["a", "b"], ["let", ["aks", ["keys", "a"]], ["if", ["not", ["=", ["count", "aks"], ["count", ["keys", "b"]]]], false, ["_check_hash_map_keys", "aks", "a", "b"]]]]], ["def", "equal?", ["fn", ["a", "b"], ["if", ["sequential?", "a"], ["if", ["sequential?", "b"], ["_cmp_seqs", "a", "b"], false], ["if", ["map?", "a"], ["if", ["map?", "b"], ["_cmp_hash_maps", "a", "b"], false], ["if", ["symbol?", "a"], ["if", ["symbol?", "b"], ["=", ["get", "a", ["`", "val"]], ["get", "b", ["`", "val"]]], false], ["=", "a", "b"]]]]]], ["def", "_clone", ["fn", ["obj"], ["if", ["list?", "obj"], ["slice", "obj", 0], ["if", ["vector?", "obj"], ["let", ["new-obj", ["slice", "obj", 0]], ["do", ["set", "new-obj", ["`", "__vector?__"], true], "new-obj"]], ["if", ["map?", "obj"], ["let", ["new-obj", ["hash-map"]], ["do", ["map", ["fn", ["k"], ["if", [".", "obj", ["`", "hasOwnProperty"], "k"], ["set", "new-obj", "k", ["get", "obj", "k"]], null]], ["keys", "obj"]], "new-obj"]], ["if", ["malfunc?", "obj"], ["let", ["new-obj", ["malfunc", ["get", "obj", ["`", "fn"]], ["get", "obj", ["`", "ast"]], ["get", "obj", ["`", "env"]], ["get", "obj", ["`", "params"]]]], ["do", ["set", "new-obj", ["`", "macro?"], ["get", "obj", ["`", "macro?"]]], ["set", "new-obj", ["`", "__meta__"], ["get", "obj", ["`", "__meta__"]]], "new-obj"]], ["throw", "clone of unsupported type"]]]]]]], ["def", "clone", ["fn", ["obj"], ["let", ["new-obj", ["_clone", "obj"]], ["do", [".", "Object", ["`", "defineProperty"], "new-obj", ["`", "__meta__"], {"enumerable": false, "writable": true}], "new-obj"]]]], ["def", "assoc!", ["fn", ["a", "b", "c"], ["do", ["set", "a", "b", "c"], "a"]]], ["def", "assocs!", ["fn", ["hm", "kvs"], ["if", ["empty?", "kvs"], "hm", ["do", ["assoc!", "hm", ["get", "kvs", 0], ["get", "kvs", 1]], ["assocs!", "hm", ["slice", "kvs", 2]]]]]], ["def", "Symbol", ["fn", [], null]], ["def", "symbol", ["fn", ["name"], ["assoc!", ["new", "Symbol"], ["`", "val"], "name"]]], ["def", "symbol?", ["fn", ["a"], ["isa", "a", "Symbol"]]], ["def", "keyword", ["fn", ["name"], ["if", ["keyword?", "name"], "name", ["str", ["`", "\u029e"], "name"]]]], ["def", "keyword?", ["fn", ["kw"], ["and", ["=", ["`", "[object String]"], ["classOf", "kw"]], ["=", ["`", "\u029e"], ["get", "kw", 0]]]]], ["`", "Override some list defs to account for Vectors"], ["def", "sequential?", ["fn", ["a"], [".", "Array", ["`", "isArray"], "a"]]], ["def", "list?", ["fn", ["a"], ["if", [".", "Array", ["`", "isArray"], "a"], ["if", [".-", "a", ["`", "__vector?__"]], false, true], false]]], ["def", "empty?", ["fn", ["a"], ["if", ["sequential?", "a"], ["if", ["=", 0, [".-", "a", ["`", "length"]]], true, false], ["=", "a", null]]]], ["def", "vectorl", ["fn", ["lst"], ["let", ["vec", ["slice", "lst", 0]], ["do", ["set", "vec", ["`", "__vector?__"], true], "vec"]]]], ["def", "vector", ["fn", ["&", "args"], ["vectorl", "args"]]], ["def", "vector?", ["fn", ["a"], ["if", [".", "Array", ["`", "isArray"], "a"], ["if", [".-", "a", ["`", "__vector?__"]], true, false], false]]], ["def", "HashMap", ["fn", [], null]], ["def", "hash-map", ["fn", ["&", "a"], ["assocs!", ["new", "HashMap"], "a"]]], ["def", "map?", ["fn", ["a"], ["isa", "a", "HashMap"]]], ["def", "MalFunc", ["fn", [], null]], ["def", "malfunc", ["fn", ["fn", "ast", "env", "params"], ["assocs!", ["new", "MalFunc"], ["list", ["`", "fn"], "fn", ["`", "ast"], "ast", ["`", "env"], "env", ["`", "params"], "params", ["`", "macro?"], false]]]], ["def", "malfunc?", ["fn", ["a"], ["isa", "a", "MalFunc"]]], ["def", "Atom", ["fn", [], null]], ["def", "atom", ["fn", ["a"], ["let", ["atm", ["new", "Atom"]], ["do", ["set", "atm", ["`", "val"], "a"], "atm"]]]], ["def", "atom?", ["fn", ["a"], ["isa", "a", "Atom"]]], null ] ================================================ FILE: impls/nasm/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Install nasm and ld RUN apt-get -y install nasm binutils ================================================ FILE: impls/nasm/Makefile ================================================ STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal COMPONENTS = env.asm core.asm reader.asm printer.asm types.asm system.asm exceptions.asm all: $(STEPS) %.o: %.asm $(COMPONENTS) nasm -felf64 $< %: %.o ld -o $@ $< .PHONY: clean clean: rm -f $(STEPS) $(STEPS:%=%.o) ================================================ FILE: impls/nasm/README.md ================================================ # x86_64 NASM implementation Notes and known issues: * No library dependencies, only Linux system calls * Simple readline implemented, just supporting backspace for editing * Reference counting used for memory management. No attempt is made to find circular references, so leaks are possible. In particular defining a function with def! creates a circular reference loop. * The exception/error handling just resets the stack and jumps to a handler, so does not release memory * Memory is allocated by two fixed-size allocators (`Cons` and `Array` objects) which have limits specified in types.asm. If more memory is needed then this must currently be done at compile-time, but adding sys_brk calls could be done. * The hash map implementation is just a list of key-value pairs. Moving symbols around in the core environment makes a significant difference (20-30%) to the performance test. A simple optimisation could be to move items when found to the start of the list so that frequently searched keys are nearer the front. * `conj` function not yet implemented * `*env*` symbol evaluates to current Environment. ================================================ FILE: impls/nasm/core.asm ================================================ ;; Core functions ;; ;; %include "macros.mac" section .data ;; Symbols for comparison static core_add_symbol, db "+" static core_sub_symbol, db "-" static core_mul_symbol, db "*" static core_div_symbol, db "/" static core_listp_symbol, db "list?" static core_emptyp_symbol, db "empty?" static core_equal_symbol, db "=" static core_gt_symbol, db ">" static core_lt_symbol, db "<" static core_ge_symbol, db ">=" static core_le_symbol, db "<=" static core_count_symbol, db "count" static core_keys_symbol, db "keys" static core_vals_symbol, db "vals" static core_list_symbol, db "list" static core_pr_str_symbol, db "pr-str" static core_prn_symbol, db "prn" static core_str_symbol, db "str" static core_println_symbol, db "println" static core_read_string_symbol, db "read-string" static core_slurp_symbol, db "slurp" static core_eval_symbol, db "eval" static core_atom_symbol, db "atom" static core_deref_symbol, db "deref" static core_atomp_symbol, db "atom?" static core_reset_symbol, db "reset!" static core_swap_symbol, db "swap!" 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" static core_nth_symbol, db "nth" static core_nilp_symbol, db "nil?" static core_truep_symbol, db "true?" static core_falsep_symbol, db "false?" static core_numberp_symbol, db "number?" static core_symbolp_symbol, db "symbol?" static core_stringp_symbol, db "string?" static core_fnp_symbol, db "fn?" static core_macrop_symbol, db "macro?" static core_keywordp_symbol, db "keyword?" static core_containsp_symbol, db "contains?" static core_get_symbol, db "get" static core_vectorp_symbol, db "vector?" static core_mapp_symbol, db "map?" static core_sequentialp_symbol, db "sequential?" static core_throw_symbol, db "throw" static core_map_symbol, db "map" static core_apply_symbol, db "apply" static core_symbol_symbol, db "symbol" static core_vector_symbol, db "vector" static core_hashmap_symbol, db "hash-map" static core_keyword_symbol, db "keyword" static core_assoc_symbol, db "assoc" static core_dissoc_symbol, db "dissoc" static core_readline_symbol, db "readline" static core_meta_symbol, db "meta" static core_with_meta_symbol, db "with-meta" static core_time_ms_symbol, db "time-ms" static core_seq_symbol, db "seq" ;; Strings static core_arith_missing_args, db "integer arithmetic missing arguments" static core_arith_not_int, db "non-integer argument to integer arithmetic" static core_emptyp_error_string, db "empty? expects a list, vector or map",10 static core_count_error_string, db "count expects a list or vector",10 static core_keys_not_map, db "keys expects a map as first argument" static core_vals_not_map, db "vals expects a map as first argument" static core_numeric_expect_ints, db "comparison operator expected two numbers",10 static core_deref_not_atom, db "Error: argument to deref is not an atom" static core_reset_not_atom, db "Error: argument to reset is not an atom" static core_reset_no_value, db "Error: missing value argument to reset" static core_swap_not_atom, db "Error: swap! expects atom as first argument" static core_swap_no_function, db "Error: swap! expects function as second argument" static core_cons_missing_arg, db "Error: missing argument to cons" static core_cons_not_vector, db "Error: cons expects a list or vector" 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" static core_rest_missing_arg, db "Error: missing argument to rest" static core_rest_not_list, db "Error: rest expects a list or vector" static core_nth_missing_arg, db "Error: missing argument to nth" static core_nth_not_list, db "Error: nth expects a list or vector as first argument" static core_nth_not_int, db "Error: nth expects an integer as second argument" static core_nth_out_of_range, db "Error: nth index out of range" static core_value_p_missing_args, db "Error: value predicate (nil/true/false) missing args" static core_containsp_not_map, db "Error: contains? expects map as first argument" static core_containsp_no_key, db "Error: contains? missing key argument" static core_get_not_map, db "Error: get expects map as first argument" static core_get_no_key, db "Error: get missing key argument" static core_map_missing_args, db "Error: map expects two arguments (function, list/vector)" static core_map_not_function, db "Error: map expects a ufunction for first argument" static core_map_not_seq, db "Error: map expects a list or vector as second argument" static core_apply_not_function, db "Error: apply expects function as first argument" static core_apply_missing_args, db "Error: apply missing arguments" static core_apply_not_seq, db "Error: apply last argument must be list or vector" static core_symbol_not_string, db "Error: symbol expects a string argument" static core_keyword_not_string, db "Error: keyword expects a string or keyword argument" static core_list_not_seq, db "Error: list expects a list or vector" static core_assoc_not_map, db "Error: assoc expects a map as first argument" static core_assoc_missing_value, db "Error: assoc missing value" static core_dissoc_not_map, db "dissoc expects a map as first argument" static core_dissoc_missing_value, db "Missing value in map passed to dissoc" static core_with_meta_no_function, db "with-meta expects a function as first argument" static core_with_meta_no_value, db "with-meta expects a value as second argument" static core_seq_missing_arg, db "seq missing argument" static core_seq_wrong_type, db "seq expects a list, vector, string or nil" section .text ;; Add a native function to the core environment ;; This is used in core_environment %macro core_env_native 2 push rsi ; environment mov rsi, %1 mov edx, %1.len call raw_to_symbol ; Symbol in RAX push rax mov rsi, %2 call native_function ; Function in RAX mov rcx, rax ; value (function) pop rdi ; key (symbol) pop rsi ; environment call env_set %endmacro ;; Create an Environment with core functions ;; ;; Returns Environment in RAX ;; ;; core_environment: ; Create the top-level environment xor rsi, rsi ; Set outer to nil call env_new mov rsi, rax ; Environment in RSI 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 core_env_native core_nth_symbol, core_nth core_env_native core_add_symbol, core_add core_env_native core_sub_symbol, core_sub core_env_native core_mul_symbol, core_mul core_env_native core_div_symbol, core_div core_env_native core_listp_symbol, core_listp core_env_native core_emptyp_symbol, core_emptyp core_env_native core_count_symbol, core_count core_env_native core_equal_symbol, core_equalp core_env_native core_gt_symbol, core_gt core_env_native core_lt_symbol, core_lt core_env_native core_ge_symbol, core_ge core_env_native core_le_symbol, core_le core_env_native core_keys_symbol, core_keys core_env_native core_vals_symbol, core_vals core_env_native core_list_symbol, core_list core_env_native core_pr_str_symbol, core_pr_str core_env_native core_prn_symbol, core_prn core_env_native core_str_symbol, core_str core_env_native core_println_symbol, core_println core_env_native core_read_string_symbol, core_read_string core_env_native core_slurp_symbol, core_slurp core_env_native core_eval_symbol, core_eval core_env_native core_atom_symbol, core_atom core_env_native core_deref_symbol, core_deref core_env_native core_atomp_symbol, core_atomp core_env_native core_reset_symbol, core_reset core_env_native core_swap_symbol, core_swap core_env_native core_nilp_symbol, core_nilp core_env_native core_truep_symbol, core_truep core_env_native core_falsep_symbol, core_falsep core_env_native core_numberp_symbol, core_numberp core_env_native core_symbolp_symbol, core_symbolp core_env_native core_stringp_symbol, core_stringp core_env_native core_fnp_symbol, core_fnp core_env_native core_macrop_symbol, core_macrop core_env_native core_keywordp_symbol, core_keywordp core_env_native core_containsp_symbol, core_containsp core_env_native core_get_symbol, core_get core_env_native core_vectorp_symbol, core_vectorp core_env_native core_mapp_symbol, core_mapp core_env_native core_sequentialp_symbol, core_sequentialp core_env_native core_throw_symbol, core_throw core_env_native core_map_symbol, core_map core_env_native core_apply_symbol, core_apply core_env_native core_symbol_symbol, core_symbol core_env_native core_vector_symbol, core_vector core_env_native core_hashmap_symbol, core_hashmap core_env_native core_keyword_symbol, core_keyword core_env_native core_assoc_symbol, core_assoc core_env_native core_dissoc_symbol, core_dissoc core_env_native core_readline_symbol, core_readline core_env_native core_meta_symbol, core_meta core_env_native core_with_meta_symbol, core_with_meta core_env_native core_time_ms_symbol, core_time_ms core_env_native core_seq_symbol, core_seq ; ----------------- ; Put the environment in RAX mov rax, rsi ret ;; ---------------------------------------------------- ;; Jumped to from many core functions, with ;; string address in RSI and length in EDX core_throw_str: call raw_to_string mov rsi, rax jmp error_throw ;; ---------------------------------------------------- ;; Integer arithmetic operations ;; ;; Adds a list of numbers, address in RSI ;; Returns the sum as a number object with address in RAX ;; Since most of the code is common to all operators, ;; RBX is used to jump to the required instruction core_add: mov rbx, core_arithmetic.do_addition jmp core_arithmetic core_sub: mov rbx, core_arithmetic.do_subtraction jmp core_arithmetic core_mul: mov rbx, core_arithmetic.do_multiply jmp core_arithmetic core_div: mov rbx, core_arithmetic.do_division ; Fall through to core_arithmetic core_arithmetic: ; Check that the first object is a number mov cl, BYTE [rsi] mov ch, cl and ch, block_mask cmp ch, block_cons jne .missing_args mov ch, cl and ch, content_mask cmp ch, content_empty je .missing_args cmp ch, content_int jne .not_int ; Put the starting value in rax mov rax, [rsi + Cons.car] .add_loop: ; Fetch the next value mov cl, [rsi + Cons.typecdr] cmp cl, content_pointer jne .finished ; Nothing let mov rsi, [rsi + Cons.cdr] ; Get next cons ; Check that it is an integer mov cl, BYTE [rsi] and cl, content_mask cmp cl, content_int jne .not_int ; Jump to the required operation, address in RBX jmp rbx .do_addition: add rax, [rsi + Cons.car] jmp .add_loop .do_subtraction: sub rax, [rsi + Cons.car] jmp .add_loop .do_multiply: imul rax, [rsi + Cons.car] jmp .add_loop .do_division: cqo ; Sign extend RAX into RDX mov rcx, [rsi + Cons.car] idiv rcx jmp .add_loop .finished: ; Value in rbx push rax ; Get a Cons object to put the result into call alloc_cons pop rbx mov [rax], BYTE maltype_integer mov [rax + Cons.car], rbx ret .missing_args: load_static core_arith_missing_args jmp core_throw_str .not_int: load_static core_arith_not_int jmp core_throw_str ;; compare objects for equality core_equalp: ; Check that rsi contains a list mov cl, BYTE [rsi] cmp cl, maltype_empty_list je .error and cl, block_mask + container_mask cmp cl, block_cons + container_list jne .error ; Check that the list has a second pointer mov cl, BYTE [rsi + Cons.typecdr] cmp cl, content_pointer jne .error ; move second pointer into rdi mov rdi, [rsi + Cons.cdr] ; Remove next pointers mov cl, BYTE [rsi + Cons.typecdr] mov [rsi + Cons.typecdr], BYTE 0 mov bl, BYTE [rdi + Cons.typecdr] mov [rdi + Cons.typecdr], BYTE 0 push rbx push rcx ; Compare the objects recursively call compare_objects_rec ; Restore next pointers pop rcx pop rbx mov [rsi + Cons.typecdr], BYTE cl mov [rdi + Cons.typecdr], BYTE bl je .true .false: call alloc_cons mov [rax], BYTE maltype_false ret .true: call alloc_cons mov [rax], BYTE maltype_true ret .error: push rsi print_str_mac error_string ; print 'Error: ' pop rsi jmp error_throw ;; ----------------------------------------------------------------- ;; Numerical comparisons core_gt: mov rcx, core_compare_num.gt jmp core_compare_num core_lt: mov rcx, core_compare_num.lt jmp core_compare_num core_ge: mov rcx, core_compare_num.ge jmp core_compare_num core_le: mov rcx, core_compare_num.le ;jmp core_compare_num core_compare_num: ; The first argument should be an int mov al, BYTE [rsi] and al, content_mask cmp al, maltype_integer jne .error ; Check that there's a second argument mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .error mov rax, [rsi + Cons.car] mov rdi, [rsi + Cons.cdr] ; The second arg should also be an int mov bl, BYTE [rdi] and bl, content_mask cmp bl, maltype_integer jne .error mov rbx, [rdi + Cons.car] cmp rax, rbx jmp rcx ; Address set above .gt: jg .true jmp .false .lt: jl .true jmp .false .ge: jge .true jmp .false .le: jle .true ;jmp .false .false: call alloc_cons mov [rax], BYTE maltype_false ret .true: call alloc_cons mov [rax], BYTE maltype_true ret .error: push rsi print_str_mac error_string ; print 'Error: ' print_str_mac core_numeric_expect_ints pop rsi jmp error_throw ;; Test if a given object is a list ;; Input list in RSI ;; Returns true or false in RAX core_listp: mov bl, (block_cons + container_list) jmp core_container_p core_vectorp: mov bl, (block_cons + container_vector) jmp core_container_p core_mapp: mov bl, (block_cons + container_map) ;jmp core_container_p core_container_p: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .false ; Should be a pointer to a list mov rax, [rsi + Cons.car] mov al, BYTE [rax] and al, (block_mask + container_mask) cmp al, bl jne .false ; Is a list, return true call alloc_cons mov [rax], BYTE maltype_true ret .false: call alloc_cons mov [rax], BYTE maltype_false ret ;; Return true if vector or list core_sequentialp: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .false ; Should be a pointer mov rax, [rsi + Cons.car] mov al, BYTE [rax] and al, (block_mask + container_mask) cmp al, container_list je .true cmp al, container_vector jne .false .true: ; Is a list or vector, return true call alloc_cons mov [rax], BYTE maltype_true ret .false: call alloc_cons mov [rax], BYTE maltype_false ret ;; Test if the given list, vector or map is empty core_emptyp: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .error ; Expected a container mov rax, [rsi + Cons.car] mov al, BYTE [rax] cmp al, maltype_empty_list je .true cmp al, maltype_empty_vector je .true cmp al, maltype_empty_map je .true ; false call alloc_cons mov [rax], BYTE maltype_false ret .true: call alloc_cons mov [rax], BYTE maltype_true ret .error: push rsi print_str_mac error_string print_str_mac core_emptyp_error_string pop rsi jmp error_throw ;; Count the number of elements in given list or vector core_count: mov al, BYTE [rsi] and al, content_mask cmp al, content_nil je .zero cmp al, content_pointer jne .error ; Expected a container mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] mov ah, al and ah, (block_mask + container_mask) cmp ah, (block_cons + container_list) je .start_count cmp ah, (block_cons + container_vector) je .start_count jmp .error ; Not a list or vector .start_count: xor rbx,rbx mov ah, al and ah, content_mask cmp ah, content_empty je .done ; Empty list or vector .loop: inc rbx ; Check if there's another mov al, [rsi + Cons.typecdr] cmp al, content_pointer jne .done mov rsi, [rsi + Cons.cdr] jmp .loop .zero: ; Return zero count mov rbx, 0 .done: ; Count is in RBX push rbx call alloc_cons pop rbx mov [rax], BYTE maltype_integer mov [rax + Cons.car], rbx ret .error: push rsi print_str_mac error_string print_str_mac core_count_error_string pop rsi jmp error_throw ;; Given a map, returns a list of keys ;; Input: List in RSI with one Map element ;; Returns: List in RAX core_keys: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_map mov rsi, [rsi + Cons.car] call map_keys ret .not_map: load_static core_keys_not_map jmp core_throw_str ;; Get a list of values from a map core_vals: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_map mov rsi, [rsi + Cons.car] call map_vals ret .not_map: load_static core_vals_not_map jmp core_throw_str ;; Given a map and a key, return true if the key is in the map ;; core_containsp: ; Check the type of the first argument mov bl, BYTE [rsi] and bl, content_mask cmp bl, content_pointer jne .not_map mov rcx, [rsi + Cons.car] ; Map in RCX mov bl, BYTE [rcx] and bl, (block_mask + container_mask) cmp bl, container_map jne .not_map ; Check second argument mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .no_key mov rsi, [rsi + Cons.cdr] mov dl, BYTE [rsi] and dl, content_mask cmp dl, content_pointer jne .key_value ; Pointer, so put into RDI mov rdi, [rsi + Cons.car] jmp .find .key_value: ; A value mov [rsi], BYTE dl mov rdi, rsi ; Value in RDI .find: mov rsi, rcx ; Map call map_find je .true ; false call alloc_cons mov [rax], BYTE maltype_false ret .true: call alloc_cons mov [rax], BYTE maltype_true ret .not_map: load_static core_containsp_not_map jmp core_throw_str .no_key: load_static core_containsp_no_key jmp core_throw_str ;; Given a map and a key, return the value in the map ;; or nil if not found ;; core_get: ; Check the type of the first argument mov bl, BYTE [rsi] and bl, content_mask cmp bl, content_nil je .not_found cmp bl, content_pointer jne .not_map mov rcx, [rsi + Cons.car] ; Map in RCX mov bl, BYTE [rcx] and bl, (block_mask + container_mask) cmp bl, container_map jne .not_map ; Check second argument mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .no_key mov rsi, [rsi + Cons.cdr] mov dl, BYTE [rsi] and dl, content_mask cmp dl, content_pointer jne .key_value ; Pointer, so put into RDI mov rdi, [rsi + Cons.car] jmp .find .key_value: ; A value mov [rsi], BYTE dl mov rdi, rsi ; Value in RDI .find: mov rsi, rcx ; Map call map_get ; Value in RAX je .found .not_found: ; Not found call alloc_cons mov [rax], BYTE maltype_nil ret .found: ret .not_map: load_static core_get_not_map jmp core_throw_str .no_key: load_static core_get_no_key jmp core_throw_str ;; Return arguments as a list ;; core_list: call incref_object mov rax, rsi ret ;; Convert arguments into a vector core_vector: ; Copy first element and mark as vector call alloc_cons ; in RAX mov bl, BYTE [rsi] and bl, content_mask mov bh, bl ; store content for comparison or bl, container_vector mov [rax], BYTE bl ; Set type mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx ; Set content ; Check if the first element is a pointer cmp bh, content_pointer jne .done_car ; A pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .done_car: ; Copy the CDR type and content mov bl, [rsi + Cons.typecdr] mov [rax + Cons.typecdr], bl mov rdx, [rsi + Cons.cdr] mov [rax + Cons.cdr], rdx cmp bl, content_pointer jne .done ; A pointer mov bx, WORD [rdx + Cons.refcount] inc bx mov [rdx + Cons.refcount], WORD bx .done: ret ;; Convert arguments into a map core_hashmap: ; Copy first element and mark as map call alloc_cons ; in RAX mov bl, BYTE [rsi] and bl, content_mask mov bh, bl ; store content for comparison or bl, container_map mov [rax], BYTE bl ; Set type mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx ; Set content ; Check if the first element is a pointer cmp bh, content_pointer jne .done_car ; A pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .done_car: ; Copy the CDR type and content mov bl, [rsi + Cons.typecdr] mov [rax + Cons.typecdr], bl mov rdx, [rsi + Cons.cdr] mov [rax + Cons.cdr], rdx cmp bl, content_pointer jne .done ; A pointer mov bx, WORD [rdx + Cons.refcount] inc bx mov [rdx + Cons.refcount], WORD bx .done: ret ;; ------------------------------------------------ ;; String functions ;; Convert arguments to a readable string, separated by a space ;; core_pr_str: mov rdi, 3 ; print_readably & separator jmp core_str_functions core_str: xor rdi, rdi jmp core_str_functions core_str_sep: mov rdi, 2 ; separator core_str_functions: mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_empty je .empty ; Nothing to print xor r8, r8 ; Return string in r8 .loop: cmp ah, content_pointer je .got_pointer ; A value. Remove list container xchg ah, al mov [rsi], BYTE al xchg ah, al push rsi push rax push r8 call pr_str pop r8 pop rbx pop rsi mov [rsi], BYTE bl ; restore type jmp .got_string .got_pointer: push rsi push r8 mov rsi, [rsi + Cons.car] ; Address pointed to call pr_str pop r8 pop rsi .got_string: ; String now in rax cmp r8, 0 jne .append ; first string. Since this string will be ; appended to, it needs to be a copy push rsi ; input push rax ; string to copy mov rsi, rax call string_copy ; New string in RAX pop rsi ; copied string push rax ; the copy call release_object ; release the copied string pop r8 ; the copy pop rsi ; input jmp .next .append: push r8 push rsi push rax mov rsi, r8 ; Output string mov rdx, rax ; String to be copied call string_append_string pop rsi ; Was in rax, temporary string call release_array ; Release the string pop rsi ; Restore input pop r8 ; Output string .next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .done ; More inputs mov rsi, [rsi + Cons.cdr] ; pointer test rdi, 2 ; print_readably jz .end_append_char ; No separator ; Add separator push r8 push rsi mov rsi, r8 mov cl, ' ' call string_append_char pop rsi pop r8 .end_append_char: ; Get the type in ah for comparison at start of loop mov al, BYTE [rsi] mov ah, al and ah, content_mask jmp .loop .done: ; No more input, so return mov rax, r8 ret .empty: call string_new ; An empty string ret ;; Print arguments readably, return nil core_prn: call core_pr_str jmp core_prn_functions core_println: call core_str_sep core_prn_functions: mov rsi, rax ; Put newline at the end push rsi mov cl, 10 ; newline call string_append_char pop rsi ; print the string push rsi ; Save the string address call print_string pop rsi call release_array ; Release the string ; Return nil call alloc_cons mov [rax], BYTE maltype_nil ret ;; Given a string, calls read_str to get an AST core_read_string: mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer jne .no_string mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] cmp al, maltype_string jne .no_string call read_str ret .no_string: ; Didn't get a string input call alloc_cons mov [rax], BYTE maltype_nil ret ;; Reads a file into a string core_slurp: mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer jne .no_string mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] cmp al, maltype_string jne .no_string call read_file ret .no_string: ; Didn't get a string input call alloc_cons mov [rax], BYTE maltype_nil ret ;; Evaluate an expression in the REPL environment ;; core_eval: mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .pointer ; Just a value, so return it call incref_object mov al, BYTE [rsi] and al, content_mask mov [rsi], BYTE al ; Removes list mov rax, rsi ret .pointer: ; A pointer, so need to eval mov rdi, [rsi + Cons.car] mov rsi, [repl_env] ; Environment call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ret ;; Create an atom core_atom: push rsi call alloc_cons ; To hold the pointer pop rsi mov [rax], BYTE maltype_atom ; Check the type of the first argument mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer je .pointer ; A value ; make a copy push rax push rsi push rbx call alloc_cons pop rbx mov bl, bh mov [rax], BYTE bl ; Set type mov rbx, rax pop rsi pop rax mov rcx, [rsi + Cons.car] mov [rbx + Cons.car], rcx ; Set value ; Set the atom to point to it mov [rax + Cons.car], rbx ret .pointer: mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx push rax mov rsi, rbx call incref_object ; Storing in atom pop rax ret ;; Get the value from the atom core_deref: ; Check the type of the first argument mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer jne .not_atom ; Get the atom mov rsi, [rsi + Cons.car] mov bl, BYTE [rsi] cmp bl, maltype_atom jne .not_atom ; Return what it points to mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi ret .not_atom: ; Not an atom, so throw an error mov rsi, core_deref_not_atom mov edx, core_deref_not_atom.len call raw_to_symbol mov rsi, rax jmp error_throw ;; Test if given object is an atom core_atomp: mov al, maltype_atom jmp core_pointer_type_p core_symbolp: mov al, maltype_symbol jmp core_pointer_type_p core_stringp: mov al, maltype_string jmp core_pointer_type_p core_fnp: mov al, maltype_function jmp core_pointer_type_p core_macrop: mov al, maltype_macro jmp core_pointer_type_p core_pointer_type_p: mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer jne .false mov rsi, [rsi + Cons.car] mov bl, BYTE [rsi] cmp bl, al jne .false ; Check for keyword (not symbol) cmp al, maltype_symbol jne .true mov al, BYTE [rsi + Array.data] cmp al, ':' je .false ; a keyword .true: ; Return true call alloc_cons mov [rax], BYTE maltype_true ret .false: call alloc_cons mov [rax], BYTE maltype_false ret ;; Tests if argument is a keyword core_keywordp: mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer jne .false mov rsi, [rsi + Cons.car] mov bl, BYTE [rsi] cmp bl, maltype_symbol jne .false ; Check if first character is ':' mov bl, BYTE [rsi + Array.data] cmp bl, ':' jne .false ; Return true call alloc_cons mov [rax], BYTE maltype_true ret .false: call alloc_cons mov [rax], BYTE maltype_false ret ;; Change the value of an atom core_reset: ; Check the type of the first argument mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer jne .not_atom ; Get the atom mov rax, [rsi + Cons.car] ; Atom in RAX mov bl, BYTE [rax] cmp bl, maltype_atom jne .not_atom ; Get the next argument mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .no_value mov rsi, [rsi + Cons.cdr] ; Got something in RSI ; release the current value of the atom push rax push rsi mov rsi, [rax + Cons.car] ; The value the atom points to call release_object pop rsi pop rax ; Check the type of the first argument mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer je .pointer ; A value ; make a copy push rax push rsi push rbx call alloc_cons pop rbx mov bl, bh mov [rax], BYTE bl ; Set type mov rbx, rax pop rsi pop rax mov rcx, [rsi + Cons.car] mov [rbx + Cons.car], rcx ; Set value ; Set the atom to point to it mov [rax + Cons.car], rbx ; Increment refcount since return value will be released mov rsi, rbx call incref_object mov rax, rsi ret .pointer: mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx mov rsi, rbx call incref_object ; Storing in atom call incref_object ; Returning mov rax, rsi ret .not_atom: ; Not an atom, so throw an error mov rsi, core_reset_not_atom mov edx, core_reset_not_atom.len call raw_to_symbol mov rsi, rax jmp error_throw .no_value: ; No value given mov rsi, core_reset_no_value mov edx, core_reset_no_value.len call raw_to_symbol mov rsi, rax jmp error_throw ;; Applies a function to an atom, along with optional arguments ;; ;; In RSI should be a list consisting of ;; [ atom, pointer->Function , args...] ;; ;; The atom is dereferenced, and inserted into the list: ;; ;; [ pointer->Function , atom value , args...] ;; ;; This is then passed to eval.list_exec ;; which executes the function ;; core_swap: ; Check the type of the first argument (an atom) mov bl, BYTE [rsi] mov bh, bl and bh, content_mask cmp bh, content_pointer jne .not_atom ; Get the atom mov r9, [rsi + Cons.car] ; Atom in R9 mov bl, BYTE [r9] cmp bl, maltype_atom jne .not_atom ; Get the second argument (a function) mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .no_function mov rsi, [rsi + Cons.cdr] ; List with function first mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .no_function mov r8, [rsi + Cons.car] ; Function in R8 mov al, BYTE [r8] cmp al, maltype_function jne .no_function ; Get a new Cons ; containing the value in the atom call alloc_cons ; In RAX ; Prepend to the list mov bl, BYTE [rsi + Cons.typecdr] mov [rax + Cons.typecdr], bl cmp bl, content_pointer jne .done_prepend ; A pointer to more args, mov rcx, [rsi + Cons.cdr] mov [rax + Cons.cdr], rcx ; increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .done_prepend: ; Now get the value in the atom mov rdx, [r9 + Cons.car] ; The object pointed to ; Check what it is mov bl, BYTE [rdx] mov bh, bl and bh, (block_mask + container_mask) jz .atom_value ; Just a value ; Not a simple value, so point to it mov [rax + Cons.car], rdx mov [rax], BYTE (container_list + content_pointer) ; Since the list will be released after eval ; we need to increment the reference count mov bx, WORD [rdx + Cons.refcount] inc bx mov [rdx + Cons.refcount], WORD bx jmp .run .atom_value: ; Copy the value mov rcx, [rdx + Cons.car] mov [rax + Cons.car], rcx and bl, content_mask ; keep just the content or bl, container_list ; mark as part of a list mov [rax], BYTE bl .run: mov rsi, rax ; Here have function in R8, args in RSI ; Check whether the function is built-in or user mov rax, [r8 + Cons.car] cmp rax, apply_fn je .user_function ; A built-in function push r9 ; atom push rsi ; Args call rax ; Result in RAX pop rsi pop r9 push rax call release_object ; Release arguments pop rax jmp .got_return .user_function: ; a user-defined function, so need to evaluate ; RSI - Args mov rdi, r8 ; Function in RDI mov rdx, rsi ; Release args after binding mov rsi, r15 ; Environment call incref_object ; Released by eval call incref_object ; also released from R13 mov r13, r15 mov rsi, rdx push r9 call apply_fn ; Result in RAX pop r9 .got_return: ; Have a return result in RAX ; release the current value of the atom push rax ; The result mov rsi, [r9 + Cons.car] call release_object pop rax ; Put into atom mov [r9 + Cons.car], rax ; Increase reference of new object ; because when it is returned it will be released mov bx, WORD [rax + Cons.refcount] inc bx mov [rax + Cons.refcount], WORD bx ret .not_atom: load_static core_swap_not_atom jmp core_throw_str .no_function: load_static core_swap_no_function jmp core_throw_str ;; Takes two arguments, and prepends the first argument onto the second ;; The second argument can be a list or a vector, but the return is always ;; a list core_cons: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .missing_args mov r8, rsi ; The object to prepend ; Check if there's a second argument mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .missing_args mov rsi, [rsi + Cons.cdr] ; Check that the second argument is a list or vector mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_vector mov r9, [rsi + Cons.car] ; Should be a list or vector mov al, BYTE [r9] and al, container_mask cmp al, container_list je .got_args cmp al, container_vector je .got_args jmp .not_vector .got_args: ; Got an object in R8 and list/vector in R9 call alloc_cons ; new Cons in RAX ; Mark as the same content in a list container mov bl, BYTE [r8] and bl, content_mask mov bh, bl ; Save content in BH for checking if pointer later or bl, block_cons + container_list mov [rax], BYTE bl ; Copy the content mov rcx, [r8 + Cons.car] ; Content in RCX mov [rax + Cons.car], rcx ; Check if R9 is empty mov dl, BYTE [r9] and dl, content_mask cmp dl, content_empty je .end_append ; Don't append the list ; Put the list into CDR mov [rax + Cons.cdr], r9 ; mark CDR as a pointer mov [rax + Cons.typecdr], BYTE content_pointer ; Increment reference count push rax mov rsi, r9 call incref_object pop rax .end_append: ; Check if the new Cons contains a pointer mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .done ; A pointer, so increment number of references push rax mov rsi, rcx call incref_object pop rax .done: ret .missing_args: load_static core_cons_missing_arg jmp core_throw_str .not_vector: load_static core_cons_not_vector jmp core_throw_str ;; Concatenate lists, returning a new list ;; ;; Notes: ;; * The last list does not need to be copied, but all others do ;; core_concat: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .missing_args cmp al, content_pointer jne .not_list ; Check if there is only one argument mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer je .start_loop ; Start copy loop ; Only one input. mov rsi, [rsi + Cons.car] ; Check if it's a list or vector mov al, BYTE [rsi] mov cl, al and al, container_mask cmp al, (block_cons + container_list) je .single_list cmp al, (block_cons + container_vector) jne .not_list ; not a list or vector ; A vector. Need to create a new Cons ; for the first element, to mark it as a list call alloc_cons and cl, content_mask or cl, container_list mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; Set content ; Check if CAR is a pointer cmp cl, (container_list + content_pointer) jne .single_done_car ; a pointer, so increment reference count mov cx, WORD [rbx + Cons.refcount] inc cx mov [rbx + Cons.refcount], WORD cx .single_done_car: mov dl, BYTE [rsi + Cons.typecdr] mov [rax + Cons.typecdr], BYTE dl ; CDR type mov rbx, [rsi + Cons.cdr] mov [rax + Cons.cdr], rbx ; Set CDR content ; Check if CDR is a pointer cmp dl, content_pointer je .single_vector_incref ; not a pointer, just return ret .single_vector_incref: ; increment the reference count of object pointed to mov r12, rax ; The return Cons mov rsi, rbx ; The object address call incref_object mov rax, r12 ret .single_list: ; Just increment reference count and return call incref_object mov rax, rsi ret .start_loop: ; Have at least two inputs xor r11, r11 ; Head of list. Start in R12 .loop: ; Check the type mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_list ; Check if this is the last mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .last ; Check if the list is empty mov rbx, [rsi + Cons.car] ; The list mov al, BYTE [rbx] and al, content_mask cmp al, content_empty ; If empty list or vector je .next ; Skip to next ; not the last list, so need to copy push rsi mov rsi, rbx ; The list call cons_seq_copy ; Copy in RAX, last Cons in RBX pop rsi ; Check if this is the first test r11, r11 jnz .append ; First list mov r11, rbx ; Last Cons in list mov r12, rax ; Output list jmp .next .append: ; End of previous list points to start of new list mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer ; Put end of new list into R11 mov r11, rbx .next: mov rsi, [rsi + Cons.cdr] jmp .loop .last: ; last list, so can just append mov rsi, [rsi + Cons.car] ; Check if the list is empty mov al, BYTE [rsi] mov ah, al and al, content_mask cmp al, content_empty ; If empty list or vector je .done ; Omit the empty list call incref_object mov [r11 + Cons.cdr], rsi mov [r11 + Cons.typecdr], BYTE content_pointer .done: ; Check there is anything to return test r11, r11 jz .empty_list ; Make sure that return is a list mov bl, BYTE [r12] and bl, content_mask or bl, container_list mov [r12], BYTE bl mov rax, r12 ; output list ret .empty_list: call alloc_cons mov [rax], BYTE maltype_empty_list ret .missing_args: ; Return empty list call alloc_cons mov [rax], BYTE maltype_empty_list ret .not_list: ; Got an argument which is not a list mov rsi, core_concat_not_list mov edx, core_concat_not_list.len .throw: call raw_to_string 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 ;; core_first: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .missing_args cmp al, content_nil je .return_nil cmp al, content_pointer jne .not_list ; Get the list mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] ; Check for nil cmp al, maltype_nil je .return_nil mov ah, al and ah, (block_mask + container_mask) cmp ah, container_list je .got_list cmp ah, container_vector jne .not_list ; Not a list or vector .got_list: ; Check if list is empty and al, content_mask cmp al, content_empty je .return_nil cmp al, content_pointer je .return_pointer ; Returning a value, so need to copy mov cl, al call alloc_cons mov [rax], BYTE cl ; Set type ; Copy value mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx ret .return_pointer: mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi ret .return_nil: call alloc_cons mov [rax], BYTE maltype_nil ret .missing_args: mov rsi, core_first_missing_arg mov edx, core_first_missing_arg.len jmp .throw .not_list: mov rsi, core_first_not_list mov edx, core_first_not_list.len .throw: call raw_to_string mov rsi, rax jmp error_throw ;; Return a list with the first element removed core_rest: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .missing_args cmp al, content_nil je .empty_list cmp al, content_pointer jne .not_list ; Get the list mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] ; Check for nil cmp al, maltype_nil je .return_nil mov ah, al and ah, (block_mask + container_mask) cmp ah, container_list je .got_list cmp ah, container_vector jne .not_list ; Not a list or vector .got_list: ; Check if list or vector is empty and al, content_mask cmp al, content_empty je .empty_list ; Check if there is more in the list mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer je .return_rest ; No more list, so return empty list .empty_list: call alloc_cons mov [rax], BYTE maltype_empty_list ret .return_rest: mov rsi, [rsi + Cons.cdr] ; Check if this is a list or a vector mov cl, BYTE [rsi] mov ch, cl and ch, container_mask cmp ch, container_list je .return_list ; Need to allocate a new Cons to replace this first element call alloc_cons and cl, content_mask mov ch, cl ; Save CAR content type in ch or cl, container_list ; Keep content type, set container type to list mov [rax], BYTE cl mov dl, BYTE [rsi + Cons.typecdr] ; CDR type in DL mov [rax + Cons.typecdr], BYTE dl ; Copy content of CAR mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; Check if car contains a pointer cmp ch, content_pointer jne .check_cdr ; CAR contains a pointer, so increment reference count mov r8, rax ; Save return Cons mov r9, rsi ; Save input list mov rsi, rbx ; Content of CAR call incref_object mov rax, r8 ; Restore return Cons mov rsi, r9 ; Restore input list .check_cdr: ; Copy content of CDR mov rcx, [rsi + Cons.cdr] mov [rax + Cons.cdr], rcx ; Note: Might be pointer ; Check if cdr contains a pointer cmp dl, content_pointer jne .return ; Not a pointer, so just return ; A pointer, so increment its reference count mov rbx, rax ; Save the return Cons mov rsi, rcx ; The pointer in CDR call incref_object mov rax, rbx ; Restore the return Cons ret .return_list: call incref_object mov rax, rsi .return: ret .return_nil: call alloc_cons mov [rax], BYTE maltype_nil ret .missing_args: mov rsi, core_rest_missing_arg mov edx, core_rest_missing_arg.len jmp .throw .not_list: mov rsi, core_rest_not_list mov edx, core_rest_not_list.len .throw: call raw_to_string mov rsi, rax jmp error_throw ;; Return the nth element of a list or vector core_nth: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .missing_args cmp al, content_nil je .return_nil cmp al, content_pointer jne .not_list ; Get the list into R8 mov r8, [rsi + Cons.car] ; Check if we have a second argument mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .missing_args mov r9, [rsi + Cons.cdr] ; Check that it is a number mov al, BYTE [r9] and al, content_mask cmp al, content_int jne .not_int ; Get the number in RBX mov rbx, [r9 + Cons.car] ; Now loop through the list, moving along n elements .loop: test rbx, rbx ; Test if zero jz .done ; Move along next element mov al, BYTE [r8 + Cons.typecdr] cmp al, content_pointer jne .out_of_range ; No element mov r8, [r8 + Cons.cdr] dec rbx jmp .loop .done: ; Take the head of the list in R8 mov al, BYTE [r8] and al, content_mask cmp al, content_pointer je .return_pointer ; Copy a value mov cl, al call alloc_cons mov [rax], BYTE cl mov rcx, [r8 + Cons.car] mov [rax + Cons.car], rcx ret .return_pointer: mov rsi, [r8 + Cons.car] call incref_object mov rax, rsi ret .return_nil: call alloc_cons mov [rax], BYTE maltype_nil ret .missing_args: mov rsi, core_nth_missing_arg mov edx, core_nth_missing_arg.len jmp .throw .not_list: mov rsi, core_nth_not_list mov edx, core_nth_not_list.len jmp .throw .not_int: mov rsi, core_nth_not_int mov edx, core_nth_not_int.len jmp .throw .out_of_range: mov rsi, core_nth_out_of_range mov edx, core_nth_out_of_range.len .throw: call raw_to_string mov rsi, rax jmp error_throw ;; Check if the argument is a given value type core_nilp: mov al, BYTE content_nil jmp core_value_type_p core_truep: mov al, BYTE content_true jmp core_value_type_p core_falsep: mov al, BYTE content_false jmp core_value_type_p core_numberp: mov al, BYTE content_int ;; predicates for nil, true, false and number jump here core_value_type_p: mov bl, BYTE [rsi] and bl, content_mask cmp bl, content_empty je .missing_args cmp al, bl je .true ; false call alloc_cons mov [rax], BYTE maltype_false ret .true: call alloc_cons mov [rax], BYTE maltype_true ret .missing_args: mov rsi, core_value_p_missing_args mov edx, core_value_p_missing_args.len call raw_to_string mov rsi, rax jmp error_throw ;; Throws an exception core_throw: mov al, BYTE [rsi] and al, content_mask cmp al, content_empty je .throw_nil ; No arguments cmp al, content_pointer je .throw_pointer ; A value. Remove list content type mov [rsi], BYTE al jmp error_throw .throw_pointer: mov rsi, [rsi + Cons.car] jmp error_throw .throw_nil: call alloc_cons mov [rax], BYTE maltype_nil mov rsi, rax jmp error_throw ;; Applies a function to a list or vector ;; ;; Uses registers ;; R8 - function ;; R9 - Input list/vector ;; R10 - Current end of return list (for appending) core_map: xor r10,r10 ; Zero, signal no list ; First argument should be a function mov bl, BYTE [rsi] and bl, content_mask cmp bl, content_empty je .missing_args ; Check the first argument is a pointer cmp bl, content_pointer jne .not_function mov r8, [rsi + Cons.car] ; Function in R8 mov bl, BYTE [r8] cmp bl, maltype_function jne .not_function ; Check for second argument mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .missing_args mov rsi, [rsi + Cons.cdr] ; Should be a pointer to a list or vector mov bl, BYTE [rsi] and bl, content_mask cmp bl, content_pointer jne .not_seq mov r9, [rsi + Cons.car] ; List or vector in R9 mov bl, BYTE [r9] mov bh, bl and bh, content_mask cmp bh, content_empty je .empty_list and bl, (block_mask + container_mask) cmp bl, container_list je .start cmp bl, container_vector je .start ; not list or vector jmp .not_seq .start: ; Got function in R8, list or vector in R9 mov cl, BYTE [r9] and cl, content_mask mov ch, cl or cl, container_list call alloc_cons mov [rax], BYTE cl ; set content type mov rbx, [r9 + Cons.car] mov [rax + Cons.car], rbx ; Copy content mov rsi, rax cmp ch, content_pointer jne .run ; A pointer, so increment ref count mov rcx, rsi mov rsi, rbx call incref_object mov rsi, rcx .run: ; Here have function in R8, args in RSI ; Check whether the function is built-in or user mov rax, [r8 + Cons.car] cmp rax, apply_fn je .user_function ; A built-in function push r8 ; function push r9 ; input list/vector push r10 ; End of return list push rsi call rax ; Result in RAX pop rsi pop r10 pop r9 pop r8 push rax call release_object ; Release arguments pop rax jmp .got_return .user_function: ; a user-defined function, so need to evaluate ; RSI - Args mov rdi, r8 ; Function in RDI mov rdx, rsi ; Release args after binding mov rsi, r15 ; Environment call incref_object ; Released by eval call incref_object ; also released from R13 mov r13, r15 mov rsi, rdx push r8 push r9 push r10 push r15 call apply_fn ; Result in RAX pop r15 pop r10 pop r9 pop r8 .got_return: ; Have a return result in RAX ; Check if it's a value type mov bl, BYTE [rax] mov bh, bl and bl, (block_mask + container_mask) jz .return_value ; A more complicated type, point to it mov rcx, rax call alloc_cons ; Create a Cons for address mov [rax], BYTE (container_list + content_pointer) mov [rax + Cons.car], rcx jmp .update_return .return_value: ; Check if this value is shared (e.g. in an atom) mov cx, WORD [rax + Cons.refcount] dec cx jz .return_value_modify ; If reference count is 1 ; Need to copy to avoid modifying push rsi mov rsi, rax ; Original in RSI mov cl, bh ; Type call alloc_cons and cl, content_mask or cl, container_list mov [rax], BYTE cl ; mark as a list mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy content ; Release original push rax call release_object pop rax pop rsi jmp .update_return .return_value_modify: ; Only one reference, ; so can change the container type to list. ; Original type in bh mov bl, bh and bl, content_mask or bl, container_list mov [rax], BYTE bl .update_return: ; Now append to result list test r10,r10 jnz .append ; First value mov r10, rax ; End of list push r10 ; popped before return jmp .next .append: mov [r10 + Cons.cdr], rax ; Point to new Cons mov [r10 + Cons.typecdr], BYTE content_pointer mov r10, rax .next: ; Check if there is another value mov al, [r9 + Cons.typecdr] cmp al, content_pointer jne .done ; no more mov r9, [r9 + Cons.cdr] ; next jmp .start .done: pop rax ; Pushed in .update_return ret .empty_list: ; Got an empty list, so return an empty list call alloc_cons mov [rax], BYTE maltype_empty_list ret .missing_args: ; Either zero or one args, expect two load_static core_map_missing_args jmp core_throw_str .not_function: ; First argument not a function load_static core_map_not_function jmp core_throw_str .not_seq: ; Second argument not list or vector load_static core_map_not_seq jmp core_throw_str ;; Applies a function to a list of arguments, concatenated with ;; a final list of args ;; (function, ..., []) core_apply: ; First argument should be a function mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_function mov r8, [rsi + Cons.car] ; function in R8 mov al, BYTE [r8] cmp al, maltype_function je .function_or_macro cmp al, maltype_macro jne .not_function .function_or_macro: mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .missing_args xor r9,r9 ; Optional args, followed by final list/vector .loop: mov rsi, [rsi + Cons.cdr] ; Check if this is the last mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .last ; Not the last, so copy call alloc_cons ; New Cons in RAX mov bl, BYTE [rsi] mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx and bl, content_mask cmp bl, content_pointer jne .got_value ; A pointer, so increment reference mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .got_value: ; Now append this Cons to the list test r9,r9 jnz .append ; First mov r9, rax ; Start of the list mov r10, rax ; End of the list jmp .loop .append: mov [r10 + Cons.typecdr], BYTE content_pointer mov [r10 + Cons.cdr], rax mov r10, rax jmp .loop .last: ; Check that it's a list or vector mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_seq mov rsi, [rsi + Cons.car] ; Vector/list in RSI mov al, BYTE [rsi] and al, container_mask cmp al, container_list je .last_seq cmp al, container_vector jne .not_seq .last_seq: ; Check if there were any previous args test r9, r9 jnz .last_append ; R9 is zero, so no previous args ; check that this is a list ; and convert vector to list mov r9, rsi ; Check if R9 is a list mov al, BYTE [r9] mov cl, al and al, container_mask cmp al, container_list jne .last_convert_to_list ; Already a list, just increment reference count mov rsi, r9 call incref_object jmp .run .last_convert_to_list: ; Convert vector to list by copying first element call alloc_cons and cl, content_mask or cl, container_list mov [rax], BYTE cl mov rdx, [r9 + Cons.car] mov [rax + Cons.car], rdx ; check if contains a pointer cmp cl, (container_list + content_pointer) jne .copy_cdr ; A pointer, so increment reference mov bx, WORD [rdx + Cons.refcount] inc bx mov [rdx + Cons.refcount], WORD bx .copy_cdr: mov bl, BYTE [r9 + Cons.typecdr] mov rcx, [r9 + Cons.cdr] mov [rax + Cons.typecdr], BYTE bl mov [rax + Cons.cdr], rcx ; Replace R9 with this new element mov r9, rax cmp bl, content_pointer jne .run ; A pointer, so increment reference mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx jmp .run .last_append: ; Append RSI to the end of the list [R9]...[R10] mov [r10 + Cons.typecdr], BYTE content_pointer mov [r10 + Cons.cdr], rsi call incref_object .run: ; Have arguments list in R9 mov rsi, r9 ; Here have function in R8, args in RSI ; Check whether the function is built-in or user mov rax, [r8 + Cons.car] cmp rax, apply_fn je .user_function ; A built-in function push r8 ; function push r9 ; input list/vector push r10 ; End of return list push rsi call rax ; Result in RAX pop rsi pop r10 pop r9 pop r8 push rax call release_object ; Release arguments pop rax ret .user_function: ; a user-defined function, so need to evaluate ; RSI - Args mov rdi, r8 ; Function in RDI mov rdx, rsi ; Release args after binding mov rsi, r15 ; Environment call incref_object ; Released by eval call incref_object ; also released from R13 mov r13, r15 mov rsi, rdx push r8 push r9 push r10 call apply_fn ; Result in RAX pop r10 pop r9 pop r8 ret .not_function: load_static core_apply_not_function jmp core_throw_str .missing_args: load_static core_apply_missing_args jmp core_throw_str .not_seq: load_static core_apply_not_seq jmp core_throw_str ;; Converts a string to a symbol core_symbol: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_string mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] cmp al, maltype_string jne .not_string ; Copy the string call string_copy ; result in RAX mov [rax], BYTE maltype_symbol ret .not_string: load_static core_symbol_not_string jmp core_throw_str ;; Converts a string to a keyword core_keyword: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .error mov r8, [rsi + Cons.car] ; String in R8 mov al, BYTE [r8] cmp al, maltype_string jne .not_string call string_new ; String in RAX mov rsi, rax mov cl, ':' call string_append_char ; Puts ':' first mov rdx, r8 call string_append_string ; append ; Mark as keyword mov [rsi], BYTE maltype_symbol mov rax, rsi ret .not_string: cmp al, maltype_symbol jne .error ; Check if first character is ':' mov al, BYTE [r8 + Array.data] cmp al, ':' jne .error ;; This is already a keyword, return it unchanged. mov rsi, r8 call incref_object mov rax, rsi ret .error: load_static core_keyword_not_string jmp core_throw_str ;; Sets values in a map core_assoc: ; check first arg mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_map mov r8, [rsi + Cons.car] ; map in R8 mov al, BYTE [r8] and al, container_mask cmp al, container_map jne .not_map mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer je .start ; No keys to set, so just increment and return mov rsi, r8 call incref_object mov rax, rsi ret .start: mov r11, [rsi + Cons.cdr] ; List of keys/values in R11 ; Copy the original list mov rsi, r8 call map_copy mov rsi, rax ; new map in RSI .loop: ; Get key then value from R11 list mov cl, BYTE [r11] and cl, content_mask cmp cl, content_pointer je .key_pointer ; Key is a value, so copy into a Cons call alloc_cons mov [rax], BYTE cl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx mov rdi, rax ; Key in RDI jmp .get_value .key_pointer: mov rdi, [r11 + Cons.car] ; increment reference count because the key will be ; released after setting (to allow value Cons to be ; freed) mov bx, WORD [rdi + Cons.refcount] inc bx mov [rdi + Cons.refcount], WORD bx .get_value: mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .missing_value mov r11, [r11 + Cons.cdr] ; Check if value is a pointer mov cl, BYTE [r11] and cl, content_mask cmp cl, content_pointer je .value_pointer ; Value is a value, so copy into a Cons call alloc_cons mov [rax], BYTE cl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx mov rcx, rax ; Key in RCX jmp .set_pair .value_pointer: mov rcx, [r11 + Cons.car] ; increment reference count because the value will be ; released after setting (to allow value Cons to be ; freed) mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .set_pair: ; Here have: ; map in RSI ; key in RDI ; value in RCX call map_set mov r8, rsi ; map mov rsi, rdi ; key call release_object mov rsi, rcx ; value call release_object mov rsi, r8 ; map ; Check if there's another pair mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .done ; got another pair mov r11, [r11 + Cons.cdr] jmp .loop .done: mov rax, rsi ; new map ret .not_map: load_static core_assoc_not_map jmp core_throw_str .missing_value: load_static core_assoc_missing_value jmp core_throw_str ;; Removes keys from a map by making ;; a copy of a map without the given keys core_dissoc: ; Check that the first argument is a map mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .not_map mov r8, [rsi + Cons.car] ; Map in R8 mov al, BYTE [r8] mov ah, al and al, container_mask cmp al, container_map jne .not_map ; Check if the map is empty cmp ah, maltype_empty_map je .inc_and_return ; Now check if there are other arguments mov al, [rsi + Cons.typecdr] cmp al, content_pointer je .start .inc_and_return: ; No keys to remove ; just increment the map reference count and return mov rsi, r8 call incref_object mov rax, rsi ret .start: ; Some keys to remove mov r9, [rsi + Cons.cdr] ; R9 now contains a list of keys ; R8 contains the map to copy xor r11, r11 ; Head of list to return ; R12 contains tail .loop: ; Check the key in R8 against the list in R9 mov r10, r9 ; point in list being searched ; loop through the list in R10 ; comparing each element against R8 .search_loop: mov rsi, r8 mov rdi, r10 call compare_objects test rax, rax jz .found ; objects are equal ; Not found so check next in list mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .not_found ; End of list mov r10, [r10 + Cons.cdr] ; next jmp .search_loop .found: ; Removing this key, so skip mov al, BYTE [r8 + Cons.typecdr] cmp al, content_pointer jne .missing_value mov r8, [r8 + Cons.cdr] ; now a value jmp .next .not_found: ; Key not in list, so keeping ; Create a Cons to copy call alloc_cons mov bl, [r8] mov rcx, [r8 + Cons.car] mov [rax], BYTE bl mov [rax + Cons.car], rcx ; Check if a pointer or value and bl, content_mask cmp bl, content_pointer jne .done_key ; A value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .done_key: ; append to list test r11, r11 jnz .key_append ; First one mov r11, rax mov r12, rax jmp .copy_value .key_append: mov [r12 + Cons.typecdr], BYTE content_pointer mov [r12 + Cons.cdr], rax mov r12, rax .copy_value: ; Check there is a value mov al, BYTE [r8 + Cons.typecdr] cmp al, content_pointer jne .missing_value mov r8, [r8 + Cons.cdr] ; Value ; Same as for key; create a Cons and copy call alloc_cons mov bl, [r8] mov rcx, [r8 + Cons.car] mov [rax], BYTE bl mov [rax + Cons.car], rcx ; Check if a pointer or value and bl, content_mask cmp bl, content_pointer jne .done_value ; A value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .done_value: ; append to list mov [r12 + Cons.typecdr], BYTE content_pointer mov [r12 + Cons.cdr], rax mov r12, rax .next: ; Here R8 contains a value ; Check if there's another key mov al, [r8 + Cons.typecdr] cmp al, content_pointer jne .done ; Still more mov r8, [r8 + Cons.cdr] jmp .loop .done: ; Check if the map is empty test r11, r11 jz .return_empty ; not empty, so return mov rax, r11 ret .return_empty: call alloc_cons mov [rax], BYTE maltype_empty_map ret .not_map: load_static core_dissoc_not_map jmp core_throw_str .missing_value: load_static core_dissoc_missing_value jmp core_throw_str ;; Takes a string prompt for the user, and returns ;; a string or nil core_readline: ; Check the input mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .no_prompt mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] cmp al, maltype_string jne .no_prompt ; Got a string in RSI call print_string .no_prompt: ; Get string from user call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .return_nil ; return the string in RAX ret .return_nil: ; release string in RAX mov rsi, rax call release_array call alloc_cons mov [rax], BYTE maltype_nil ret ;; Return the meta data associated with a given function core_meta: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .return_nil mov rsi, [rsi + Cons.car] mov al, BYTE [rsi] cmp al, (block_cons + container_function + content_function) jne .return_nil ; Here got a function mov rsi, [rsi + Cons.cdr] ; RSI should now contain the meta data mov cl, BYTE [rsi] and cl, content_mask cmp cl, content_pointer je .pointer ; A value, so copy call alloc_cons mov [rax], BYTE cl mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ret .pointer: ; A pointer, so increment reference count and return mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi ret .return_nil: call alloc_cons mov [rax], BYTE maltype_nil ret ;; Associates a value with a function (native or user) core_with_meta: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .no_function mov r8, [rsi + Cons.car] ; Function in R8 mov al, BYTE [r8] cmp al, (block_cons + container_function + content_function) jne .no_function mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .no_value mov rsi, [rsi + Cons.cdr] ; Function in R8, new value in RSI call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) ; Type mov rbx, [r8 + Cons.car] mov [rax + Cons.car], rbx ; Function address mov r10, rax ; Return address ; Copy the meta data mov r8, [r8 + Cons.cdr] ; R8 now old meta data (not used) call alloc_cons mov cl, BYTE [rsi] and cl, content_mask mov ch, cl or cl, container_function mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; Copy value ; append to function mov [r10 + Cons.typecdr], BYTE content_pointer mov [r10 + Cons.cdr], rax mov r11, rax ; Check if meta is a value or pointer cmp ch, content_pointer jne .copy_rest ; increment reference count of meta mov cx, WORD [rbx + Cons.refcount] inc cx mov [rbx + Cons.refcount], WORD cx .copy_rest: ; Copy remainder of function (if any) ; If a user function, has (env binds body) mov al, [r8 + Cons.typecdr] cmp al, content_pointer jne .done ; Still more to copy mov r8, [r8 + Cons.cdr] call alloc_cons mov bl, BYTE [r8] mov [rax], BYTE bl ; Copy type mov rcx, [r8 + Cons.car] mov [rax + Cons.car], rcx ; Copy value ; append mov [r11 + Cons.typecdr], BYTE content_pointer mov [r11 + Cons.cdr], rax mov r11, rax ; Check if it's a pointer and bl, content_mask cmp bl, content_pointer jne .copy_rest ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx jmp .copy_rest .done: mov rax, r10 ret .no_function: load_static core_with_meta_no_function jmp core_throw_str .no_value: load_static core_with_meta_no_value jmp core_throw_str ;; Returns the current time in ms core_time_ms: call clock_time_ms mov rsi, rax call alloc_cons mov [rax], BYTE maltype_integer mov [rax + Cons.car], rsi ret ;; Convert sequences, including strings, into lists core_seq: mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer je .pointer cmp al, content_empty je .missing_arg cmp al, content_nil jne .wrong_type .return_nil: call alloc_cons mov [rax], BYTE maltype_nil ret .pointer: mov r8, [rsi + Cons.car] mov al, BYTE [r8] cmp al, maltype_string je .string mov ah, al and ah, (block_mask + content_mask) cmp ah, (block_cons + content_empty) je .return_nil and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .list cmp al, (block_cons + container_vector) jne .wrong_type ; Convert vector to list by replacing the first Cons call alloc_cons mov bl, BYTE [r8] and bl, content_mask or bl, container_list mov [rax], BYTE bl ; Set type mov rcx, [r8 + Cons.car] mov [rax + Cons.car], rcx ; Check if it's a pointer cmp bl, (container_list + content_pointer) jne .copy_cdr ; Increment reference count mov bx, WORD [rcx + Cons.refcount] ; Same for Array inc bx mov [rcx + Cons.refcount], WORD bx .copy_cdr: mov rcx, [r8 + Cons.cdr] mov [rax + Cons.cdr], rcx mov bl, [r8 + Cons.typecdr] mov [rax + Cons.typecdr], bl cmp bl, content_pointer jne .return ; Increment reference count mov bx, WORD [rcx + Cons.refcount] ; Same for Array inc bx mov [rcx + Cons.refcount], WORD bx .return: ret .list: ; Return list unchanged mov rsi, r8 call incref_object mov rax, r8 ret .string: ; Split a string into characters ; Input string in R8 mov ebx, DWORD [r8 + Array.length] test ebx,ebx jz .return_nil ; empty string ; Not empty, so allocate first Cons call alloc_cons mov r9, rax ; Return Cons in R9 mov r10, rax ; End of list in R10 .loop: mov ebx, DWORD [r8 + Array.length] mov r11, r8 add r11, Array.data ; Start of string data in R11 mov r12, r11 add r12, rbx ; End of string data in R12 .inner_loop: ; Get a new string call string_new ; in RAX mov bl, BYTE [r11] ; Get the next character mov [rax + Array.data], BYTE bl mov [rax + Array.length], DWORD 1 ; Put string into Cons at end of list mov [r10 + Cons.car], rax ; Set type mov [r10], BYTE (container_list + content_pointer) inc r11 cmp r11, r12 je .inner_done ; more characters, so allocate another Cons call alloc_cons mov [r10 + Cons.typecdr], BYTE content_pointer mov [r10 + Cons.cdr], rax mov r10, rax jmp .inner_loop .inner_done: ; No more characters in this Array ; check if there are more mov r8, QWORD [r8 + Array.next] ; Get the next Array address test r8, r8 ; Test if it's null jz .string_finished ; Another chunk in the string call alloc_cons mov [r10 + Cons.typecdr], BYTE content_pointer mov [r10 + Cons.cdr], rax mov r10, rax jmp .loop .string_finished: mov rax, r9 ret .missing_arg: ; No arguments load_static core_seq_missing_arg jmp core_throw_str .wrong_type: ; Not a list, vector, string or nil load_static core_seq_wrong_type jmp core_throw_str ================================================ FILE: impls/nasm/env.asm ================================================ %include "macros.mac" ;; ------------------------------------------------------------ ;; Environment type ;; ;; These are lists of maps. The head of the list is the ;; current environment, and CDR points to the outer environment ;; ;; ( {} {} ... ) section .data ;; Symbols used for comparison static_symbol env_symbol, '*env*' static_symbol ampersand_symbol, '&' ;; Error message strings static env_binds_error_string, db "Env expecting symbol in binds list",10 static env_binds_missing_string, db "Env missing expression in bind",10 static env_missing_symbol_after_amp_string, db "Env missing symbol after &",10 section .text ;; Create a new Environment ;; ;; Input: outer Environment in RSI. ;; - If zero, then nil outer. ;; - If not zero, increments reference count ;; ;; Return a new Environment type in RAX ;; ;; Modifies registers: ;; RAX ;; RBX env_new: call map_new ; map in RAX push rax call alloc_cons ; Cons in RAX pop rbx ; map in RBX mov [rax], BYTE (block_cons + container_list + content_pointer) ; CDR type already set to nil in alloc_cons mov [rax + Cons.car], rbx cmp rsi, 0 jne .set_outer ret ; No outer, just return .set_outer: mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi ; increment reference counter of outer mov rbx, rax ; because incref_object modifies rax call incref_object mov rax, rbx ret ;; Create a new environment using a binding list ;; ;; Input: RSI - Outer environment ;; RDI - Binds, a list of symbols ;; RCX - Exprs, a list of values to bind each symbol to ;; ;; Modifies registers ;; RBX ;; RDX ;; R8 ;; R9 ;; R10 ;; R11 ;; R12 ;; R13 env_new_bind: mov r11, rdi ; binds list in R11 mov r12, rcx ; expr list in R12 call env_new mov r13, rax ; New environment in R13 .bind_loop: ; Check the type in the bind list mov bl, BYTE [r11] and bl, content_mask cmp bl, content_empty je .done ; No bindings cmp bl, content_pointer jne .bind_not_symbol mov rdi, [r11 + Cons.car] ; Symbol object? mov bl, BYTE [rdi] cmp bl, maltype_symbol jne .bind_not_symbol ; RDI now contains a symbol ; Check if it is '&' mov rsi, ampersand_symbol push rdi call compare_char_array ; Compares RSI and RDI pop rdi cmp rax, 0 je .variadic ; Bind rest of args to following symbol ; Check the type in expr mov bl, BYTE [r12] mov bh, bl and bh, content_mask cmp bh, content_empty je .bind_missing_expr ; No expression cmp bh, content_pointer je .value_pointer ; A value. Need to remove the container type xchg bl,bh mov [r12], BYTE bl xchg bl,bh mov rcx, r12 ; Value mov rsi, r13 ; Env push rbx call env_set pop rbx ; Restore original type mov [r12], BYTE bl jmp .next .value_pointer: ; A pointer to something, so just pass address to env_set mov rcx, [r12 + Cons.car] mov rsi, r13 call env_set ; Fall through to next .next: ; Check if there is a next symbol mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .done ; Got another symbol mov r11, [r11 + Cons.cdr] ; Next symbol ; Check if there's an expression to bind to mov bl, BYTE [r12 + Cons.typecdr] cmp bl, content_pointer jne .next_no_expr ; No expr, but symbol could be & mov r12, [r12 + Cons.cdr] ; Next expression jmp .bind_loop .next_no_expr: call alloc_cons mov [rax], BYTE maltype_empty_list mov r12, rax jmp .bind_loop .done: mov rax, r13 ; Env ret .variadic: ; R11 Cons contains '&' symbol ; Bind next symbol to the rest of the list in R12 mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .missing_symbol_after_amp mov r11, [r11 + Cons.cdr] mov bl, BYTE [r11] and bl, content_mask cmp bl, content_pointer jne .bind_not_symbol mov rdi, [r11 + Cons.car] ; Symbol object? mov bl, BYTE [rdi] cmp bl, maltype_symbol jne .bind_not_symbol ; Bind symbol in RDI to R12 mov rcx, r12 ; Value mov rsi, r13 ; Env call env_set jmp .done .missing_symbol_after_amp: push r12 ; Release the environment mov rsi, r13 call release_object print_str_mac error_string ; print 'Error: ' print_str_mac env_missing_symbol_after_amp_string pop rsi jmp error_throw .bind_not_symbol: ; Expecting a symbol push r11 ; Binds list ; Release the environment mov rsi, r13 call release_object print_str_mac error_string ; print 'Error: ' print_str_mac env_binds_error_string pop rsi ; Throw binds list jmp error_throw .bind_missing_expr: ; Have a symbol, but no expression. push r11 ; Binds list ; Release the environment mov rsi, r13 call release_object print_str_mac error_string ; print 'Error: ' print_str_mac env_binds_missing_string pop rsi ; Throw binds list jmp error_throw ;; Environment set ;; ;; Sets a key-value pair in an environment ;; ;; Inputs: RSI - env [not modified] ;; RDI - key [not modified] ;; RCX - value [not modified] ;; ;; Increments reference counts of key and value ;; if pointers to them are created ;; ;; Modifies registers: ;; R8 ;; R9 ;; R10 env_set: push rsi ; Get the first CAR, which should be a map mov rsi, [rsi + Cons.car] call map_set pop rsi ret ;; Environment get ;; ;; Get a value from an environment, incrementing the reference count ;; of the object returned ;; ;; Inputs: RSI - environment ;; RDI - key ;; ;; Returns: If found, Zero Flag is set and address in RAX ;; If not found, Zero Flag cleared env_get: push rsi ; Check special variable *env* mov rsi, env_symbol call compare_char_array pop rsi cmp rax, 0 jne .not_env_symbol ; Env symbol, so return this environment call incref_object lahf ; flags in AH or ah, 64 ; set zero flag sahf mov rax, rsi ret .not_env_symbol: push rsi ; Get the map in CAR mov rsi, [rsi + Cons.car] call map_get pop rsi je .found ; Not found, so try outer mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .not_found mov rsi, [rsi + Cons.cdr] ; outer jmp env_get .found: ret .not_found: lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ret ================================================ FILE: impls/nasm/exceptions.asm ================================================ ;; ---------------------------------------------- ;; ;; Error handling ;; ;; A handler consists of: ;; - A stack pointer address to reset to ;; - An address to jump to ;; - An optional data structure to pass ;; ;; When jumped to, an error handler will be given: ;; - the object thrown in RSI ;; - the optional data structure in RDI ;; section .bss ;; Error handler list error_handler: resq 1 section .text ;; Add an error handler to the front of the list ;; ;; Input: RSI - Stack pointer ;; RDI - Address to jump to ;; RCX - Data structure. Set to zero for none. ;; If not zero, reference count incremented ;; ;; Modifies registers: ;; RAX ;; RBX error_handler_push: call alloc_cons ; car will point to a list (stack, addr, data) ; cdr will point to the previous handler mov [rax], BYTE (block_cons + container_list + content_pointer) mov rbx, [error_handler] cmp rbx, 0 ; Check if previous handler was zero je .create_handler ; Zero, so leave null ; Not zero, so create pointer to it mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rbx ; note: not incrementing reference count, since ; we're replacing one reference with another .create_handler: mov [error_handler], rax ; new error handler mov rdx, rax call alloc_cons mov [rdx + Cons.car], rax ; Store stack pointer mov [rax], BYTE (block_cons + container_list + content_function) mov [rax + Cons.car], rsi ; stack pointer mov rdx, rax call alloc_cons mov [rdx + Cons.typecdr], BYTE content_pointer mov [rdx + Cons.cdr], rax ; Store function pointer to jump to ; Note: This can't use content_pointer or release ; will try to release this memory address mov [rax], BYTE (block_cons + container_list + content_function) mov [rax + Cons.car], rdi ; Check if there is an object to pass to handler cmp rcx, 0 je .done ; Set the final CDR to point to the object mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rcx mov rsi, rcx call incref_object .done: ret ;; Removes an error handler from the list ;; ;; Modifies registers: ;; RSI ;; RAX ;; RCX error_handler_pop: ; get the address mov rsi, [error_handler] cmp rsi, 0 je .done ; Nothing to remove push rsi mov rsi, [rsi + Cons.cdr] ; next handler mov [error_handler], rsi ;call incref_object ; needed because releasing soon pop rsi ; handler being removed mov [rsi + Cons.typecdr], BYTE 0 call release_cons .done: ret ;; Throw an error ;; Object to pass to handler should be in RSI error_throw: ; Get the next error handler mov rax, [error_handler] cmp rax, 0 je .no_handler ; Got a handler mov rax, [rax + Cons.car] ; handler mov rbx, [rax + Cons.car] ; stack pointer mov rax, [rax + Cons.cdr] mov rcx, [rax + Cons.car] ; function mov rdi, [rax + Cons.cdr] ; data structure ; Reset stack mov rsp, rbx ; Jump to the handler jmp rcx .no_handler: ; Print the object in RSI then quit cmp rsi, 0 je .done ; nothing to print mov rdi, 1 ; print_readably call pr_str mov rsi, rax call print_string .done: jmp quit_error ================================================ FILE: impls/nasm/macros.mac ================================================ ;; Some useful macros %ifndef MACROS_MAC %define MACROS_MAC ;; Define a static data value ;; ;; static label value ;; %macro static 2+ %1: %2 %1.len: equ $ - %1 %endmacro ;; Puts address of data in RSI, length in EDX %macro load_static 1 mov rsi, %1 mov edx, %1.len %endmacro ;; Define a symbol which can be compared against ;; ;; static_symbol name, string ;; ;; Example: ;; ;; static_symbol def_symbol, 'def!' ;; %macro static_symbol 2 %strlen slen %2 ; length of string %1: ISTRUC Array AT Array.type, db maltype_symbol AT Array.refcount, dw 1 AT Array.length, dd slen AT Array.data, db %2 IEND %endmacro ;; Macro for printing raw string ;; %macro print_str_mac 1 mov rsi, %1 ; String address mov rdx, %1.len ; Length of string call print_rawstring %endmacro %endif ================================================ FILE: impls/nasm/printer.asm ================================================ ;;; Turns forms (lists, values/atoms) into strings ;;; ;;; %include "macros.mac" section .data ; Constant strings for printing static unknown_type_string, db "#" static unknown_value_string, db "#" static function_type_string, db "#" static macro_type_string, db "#" static nil_value_string, db "nil" static true_value_string, db "true" static false_value_string, db "false" section .text ;; Input: Address of object in RSI ;; print_readably in RDI. First bit set to zero for false ;; ;; Output: Address of string in RAX ;; ;; Modifies: ;; RCX ;; R8 ;; R12 ;; R13 ;; R14 ;; Calls: raw_to_string, ;; ;; pr_str: ; Get the type mov cl, BYTE [rsi] ; Check if it's already a string cmp cl, maltype_string jne .not_string ; --------------------------- ; Handle string test rdi, 1 jz .string_not_readable ; printing readably, so escape characters call string_new ; Output string in rax mov r12, rax add r12, Array.data ; Output data mov r13, rsi add r13, Array.data ; Input data mov r14d, DWORD [rsi + Array.length] add r14, Array.data add r14, rsi ; End of input data ; Put " at start of output string mov [r12], BYTE '"' inc r12 ; Loop through the input string, escaping characters .string_loop: cmp r13, r14 je .string_finished mov cl, BYTE [r13] ; Get next character inc r13 cmp cl, '"' ; je .string_escape_char cmp cl, 92 ; Escape '\' je .string_escape_char cmp cl, 10 ; Newline je .string_newline ; No special case, just copy the byte mov [r12], BYTE cl inc r12 jmp .string_loop .string_newline: mov cl, 'n' ;jmp .string_escape_char .string_escape_char: ; Add a '\' before char in cl mov [r12], BYTE 92 ; Escape '\' inc r12 mov [r12], BYTE cl inc r12 jmp .string_loop .string_finished: mov [r12], BYTE '"' ; At the end inc r12 ; Calculate length of string sub r12, rax sub r12, Array.data mov [rax + Array.length], DWORD r12d ret .string_not_readable: ; Just return the string call incref_object mov rax, rsi ret ; ---------------------------- .not_string: ; Now test the container type (value, list, map, vector) mov ch, cl and ch, container_mask jz .value cmp ch, container_list je .list cmp ch, container_symbol je .symbol cmp ch, container_map je .map cmp ch, container_vector je .vector cmp ch, container_function je .function_or_macro cmp ch, container_atom je .atom ; Unknown mov rsi, unknown_type_string mov edx, unknown_type_string.len call raw_to_string ; Puts a String in RAX ret ; -------------------------------- .value: mov ch, cl and ch, content_mask jz .value_nil cmp ch, content_int je .value_int cmp ch, content_true je .value_true cmp ch, content_false je .value_false mov rsi, unknown_value_string mov edx, unknown_value_string.len call raw_to_string ; Puts a String in RAX ret ; -------------------------------- .value_nil: mov rsi, nil_value_string mov edx, nil_value_string.len call raw_to_string ret .value_true: mov rsi, true_value_string mov edx, true_value_string.len call raw_to_string ret .value_false: mov rsi, false_value_string mov edx, false_value_string.len call raw_to_string ret ; -------------------------------- .value_int: mov rax, [rsi + Cons.car] call itostring ret ; -------------------------------- .list: mov r12, rsi ; Input list call string_new ; String in rax mov r13, rax ; Output string in r13 ; Put '(' onto string mov rsi, rax mov cl, '(' call string_append_char ; loop through list .list_loop: ; Extract values and print mov rsi, r12 mov cl, BYTE [rsi] ; Get type ; Check if it's a pointer (address) mov ch, cl and ch, content_mask cmp ch, content_pointer je .list_loop_pointer cmp ch, content_empty je .list_check_end ; A value (nil, int etc. or function) mov ch, cl ; Save type, container and cl, content_mask ; Remove list type -> value mov BYTE [rsi], cl push rcx push r13 push r12 call pr_str ; String in rax pop r12 pop r13 pop rcx mov cl, ch ; Restore list type mov BYTE [r12], cl jmp .list_loop_got_str .list_loop_pointer: mov rsi, [rsi + Cons.car] ; Address of object push r13 push r12 call pr_str ; String in rax pop r12 pop r13 .list_loop_got_str: ; concatenate strings in rax and rsi mov rsi, r13 ; Output string mov rdx, rax ; String to be copied push rsi ; Save output string push rax ; save temporary string call string_append_string ; Release the string pop rsi ; Was in rax, temporary string call release_array pop rsi ; restore output string .list_check_end: ; Check if this is the end of the list mov cl, BYTE [r12 + Cons.typecdr] cmp cl, content_pointer jne .list_finished ; More left in the list ; Add space between values mov cl, ' ' mov rsi, r13 call string_append_char ; Get next Cons mov r12, [r12 + Cons.cdr] jmp .list_loop .list_finished: ; put ')' at the end of the string mov cl, ')' mov rsi, r13 call string_append_char mov rax, rsi ret ; -------------------------------- .symbol: ; Make a copy of the string call string_new ; in rax mov ebx, DWORD [rsi + Array.length] mov [rax + Array.length], ebx mov rcx, rsi add rcx, Array.data ; Start of input data mov rdx, rsi add rdx, Array.size ; End of input data mov r12, rax add r12, Array.data ; Start of output data .symbol_copy_loop: ; Copy [rax] -> [r12] mov rbx, [rcx] mov [r12], rbx add rcx, 8 ; Next 64 bits of input cmp rcx, rdx je .symbol_finished add r12, 8 ; Next 64 bits of output jmp .symbol_copy_loop .symbol_finished: ret ; -------------------------------- .map: mov r12, rsi ; Input map call string_new ; String in rax mov r13, rax ; Output string in r13 ; Put '{' onto string mov rsi, rax mov cl, '{' call string_append_char ; loop through map .map_loop: ; Extract values and print mov rsi, r12 mov cl, BYTE [rsi] ; Get type ; Check if it's a pointer (address) mov ch, cl and ch, content_mask cmp ch, content_pointer je .map_loop_pointer cmp ch, content_empty je .map_check_end ; A value (nil, int etc. or function) xchg ch, cl mov [rsi], BYTE cl ; Remove map type -> value xchg ch, cl push rcx push r13 push r12 call pr_str ; String in rax pop r12 pop r13 pop rcx mov cl, BYTE [r12] ; Restore map type jmp .map_loop_got_str .map_loop_pointer: mov rsi, [rsi + Cons.car] ; Address of object push r13 push r12 call pr_str ; String in rax pop r12 pop r13 .map_loop_got_str: ; concatenate strings in rax and rsi mov rsi, r13 ; Output string mov rdx, rax ; String to be copied push rsi ; Save output string push rax ; save temporary string call string_append_string ; Release the string pop rsi ; Was in rax, temporary string call release_array pop rsi ; restore output string .map_check_end: ; Check if this is the end of the map mov cl, BYTE [r12 + Cons.typecdr] cmp cl, content_nil je .map_finished ; More left in the map ; Add space between values mov cl, ' ' mov rsi, r13 call string_append_char ; Get next Cons mov r12, [r12 + Cons.cdr] jmp .map_loop .map_finished: ; put '}' at the end of the string mov cl, '}' mov rsi, r13 call string_append_char mov rax, rsi ret ; -------------------------------- .vector: mov r12, rsi ; Input vector call string_new ; String in rax mov r13, rax ; Output string in r13 ; Put '[' onto string mov rsi, rax mov cl, '[' call string_append_char ; loop through vector .vector_loop: ; Extract values and print mov rsi, r12 mov cl, BYTE [rsi] ; Get type ; Check if it's a pointer (address) mov ch, cl and ch, content_mask cmp ch, content_pointer je .vector_loop_pointer cmp ch, content_empty je .vector_check_end ; A value (nil, int etc. or function) mov ch, cl ; Save type, container and cl, content_mask ; Remove vector type -> value mov BYTE [rsi], cl push rcx push r13 push r12 call pr_str ; String in rax pop r12 pop r13 pop rcx mov cl, ch ; Restore vector type mov BYTE [r12], cl jmp .vector_loop_got_str .vector_loop_pointer: mov rsi, [rsi + Cons.car] ; Address of object push r13 push r12 call pr_str ; String in rax pop r12 pop r13 .vector_loop_got_str: ; concatenate strings in rax and rsi mov rsi, r13 ; Output string mov rdx, rax ; String to be copied push rsi ; Save output string push rax ; save temporary string call string_append_string ; Release the string pop rsi ; Was in rax, temporary string call release_array pop rsi ; restore output string .vector_check_end: ; Check if this is the end of the vector mov cl, BYTE [r12 + Cons.typecdr] cmp cl, content_pointer jne .vector_finished ; More left in the vector ; Add space between values mov cl, ' ' mov rsi, r13 call string_append_char ; Get next Cons mov r12, [r12 + Cons.cdr] jmp .vector_loop .vector_finished: ; put ']' at the end of the string mov cl, ']' mov rsi, r13 call string_append_char mov rax, rsi ret ; -------------------------------- .function_or_macro: cmp cl, maltype_macro je .macro ; a function mov rsi, function_type_string mov edx, function_type_string.len call raw_to_string ; Puts a String in RAX ret .macro: mov rsi, macro_type_string mov edx, macro_type_string.len call raw_to_string ; Puts a String in RAX ret ; -------------------------------- .atom: mov rsi, [rsi + Cons.car] ; What the atom points to call string_new ; String in rax ; Start string with '(atom' mov rbx, '(atom ' mov [rax + Array.data], rbx mov [rax + Array.length], DWORD 6 push rax call pr_str mov rdx, rax ; string to be copied pop rsi ; Output string call string_append_string ; closing bracket mov cl, ')' call string_append_char mov rax, rsi ret ================================================ FILE: impls/nasm/reader.asm ================================================ %include "macros.mac" section .data ;; Reader macro strings static quote_symbol_string, db "quote" static quasiquote_symbol_string, db "quasiquote" static unquote_symbol_string, db "unquote" static splice_unquote_symbol_string, db "splice-unquote" static deref_symbol_string, db "deref" static with_meta_symbol_string, db "with-meta" ;; Error message strings static error_string_unexpected_end, db "Error: Unexpected end of input (EOF). Could be a missing ) or ]", 10 static error_string_bracket_not_brace, db "Error: Expecting '}' but got ')'" ;; Symbols for comparison static_symbol nil_symbol, 'nil' static_symbol true_symbol, 'true' static_symbol false_symbol, 'false' section .text ;; Read a string into memory as a form (nested lists and atoms) ;; Note: In this implementation the tokenizer is not done separately ;; ;; Input: Address of string (char array) in RSI ;; ;; Output: Address of object in RAX ;; ;; Uses registers: ;; R12 Address of the start of the current list (starts 0) ;; R13 Address of the current list tail ;; R14 Stack pointer at start. Used for unwinding on error ;; R15 Address of first list. Used for unwinding on error ;; ;; In addition, the tokenizer uses ;; ;; RAX (object return) ;; RBX ;; RCX (character return in CL) ;; RDX ;; R8 ** State must be preserved ;; R9 ** ;; R10 ** ;; R12 ;; R13 ;; R14 Original stack pointer on call ;; R15 Top-level list, so all can be released on error ;; read_str: ; Initialise tokenizer call tokenizer_init ; Set current list to zero mov r12, 0 ; Set first list to zero mov r15, 0 ; Save stack pointer for unwinding mov r14, rsp .read_loop: call tokenizer_next cmp cl, 0 jne .got_token ; Unexpected end of tokens mov rdx, error_string_unexpected_end.len mov rsi, error_string_unexpected_end jmp .error .got_token: cmp cl, 'i' ; An integer. Cons object in RAX je .finished cmp cl, '"' ; A string. Array object in RAX je .finished cmp cl, 's' ; A symbol je .symbol cmp cl, '(' je .list_start cmp cl, ')' je .return_nil ; Note: if reading a list, cl will be tested in the list reader cmp cl, '{' je .map_start cmp cl, '}' ; cl tested in map reader je .return_nil cmp cl, '[' je .vector_start cmp cl, ']' ; cl tested in vector reader je .return_nil cmp cl, 39 ; quote ' je .handle_quote cmp cl, '`' je .handle_quasiquote cmp cl, '~' je .handle_unquote cmp cl, 1 je .handle_splice_unquote cmp cl, '@' je .handle_deref cmp cl, '^' je .handle_with_meta ; Unknown jmp .return_nil ; -------------------------------- .list_start: ; Get the first value ; Note that we call rather than jmp because the first ; value needs to be treated differently. There's nothing ; to append to yet... call .read_loop ; rax now contains the first object cmp cl, ')' ; Check if it was end of list jne .list_has_contents mov cl, 0 ; so ')' doesn't propagate to nested lists ; Set list to empty mov [rax], BYTE maltype_empty_list ret ; Returns 'nil' given "()" .list_has_contents: ; If this is a Cons then use it ; If not, then need to allocate a Cons mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .list_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new list push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .list_is_value: ; Cons in RAX ; Make sure it's marked as a list mov cl, BYTE [rax] or cl, container_list mov [rax], BYTE cl mov r12, rax ; Start of current list mov r13, rax ; Set current list cmp r15, 0 ; Test if first list jne .list_read_loop mov r15, rax ; Save the first, for unwinding .list_read_loop: ; Repeatedly get the next value in the list ; (which may be other lists) ; until we get a ')' token push r12 push r13 call .read_loop ; object in rax pop r13 pop r12 cmp cl, ')' ; Check if it was end of list je .list_done ; Have nil object in rax ; Test if this is a Cons value mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .list_loop_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new list push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .list_loop_is_value: ; Cons in RAX ; Make sure it's marked as a list mov cl, BYTE [rax] or cl, container_list mov [rax], BYTE cl ; Append to r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Set current list jmp .list_read_loop .list_done: ; Release nil object in rax mov rsi, rax call release_cons ; Terminate the list mov [r13 + Cons.typecdr], BYTE content_nil mov QWORD [r13 + Cons.cdr], QWORD 0 mov rax, r12 ; Start of current list ret ; -------------------------------- .map_start: ; Get the first value ; Note that we call rather than jmp because the first ; value needs to be treated differently. There's nothing ; to append to yet... call .read_loop ; rax now contains the first object cmp cl, '}' ; Check if it was end of map jne .map_has_contents mov cl, 0 ; so '}' doesn't propagate to nested maps ; Set map to empty mov [rax], BYTE maltype_empty_map ret ; Returns 'nil' given "()" .map_has_contents: ; If this is a Cons then use it ; If not, then need to allocate a Cons mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .map_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new map push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_map + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .map_is_value: ; Cons in RAX ; Make sure it's marked as a map mov cl, BYTE [rax] or cl, container_map mov [rax], BYTE cl mov r12, rax ; Start of current map mov r13, rax ; Set current map cmp r15, 0 ; Test if first map jne .map_read_loop mov r15, rax ; Save the first, for unwinding .map_read_loop: ; Repeatedly get the next value in the map ; (which may be other maps) ; until we get a '}' token push r12 push r13 call .read_loop ; object in rax pop r13 pop r12 cmp cl, '}' ; Check if it was end of map je .map_done ; Have nil object in rax ; Test if this is a Cons value mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .map_loop_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new map push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_map + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .map_loop_is_value: ; Cons in RAX ; Make sure it's marked as a map mov cl, BYTE [rax] or cl, container_map mov [rax], BYTE cl ; Append to r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Set current map jmp .map_read_loop .map_done: ; Release nil object in rax mov rsi, rax call release_cons ; Terminate the map mov [r13 + Cons.typecdr], BYTE content_nil mov QWORD [r13 + Cons.cdr], QWORD 0 mov rax, r12 ; Start of current map ret ; -------------------------------- .vector_start: ; Get the first value ; Note that we call rather than jmp because the first ; value needs to be treated differently. There's nothing ; to append to yet... call .read_loop ; rax now contains the first object cmp cl, ']' ; Check if it was end of vector jne .vector_has_contents mov cl, 0 ; so ']' doesn't propagate to nested vectors ; Set vector to empty mov [rax], BYTE maltype_empty_vector ret ; Returns 'nil' given "()" .vector_has_contents: ; If this is a Cons then use it ; If not, then need to allocate a Cons mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .vector_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new vector push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_vector + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .vector_is_value: ; Cons in RAX ; Make sure it's marked as a vector mov cl, BYTE [rax] or cl, container_vector mov [rax], BYTE cl mov r12, rax ; Start of current vector mov r13, rax ; Set current vector cmp r15, 0 ; Test if first vector jne .vector_read_loop mov r15, rax ; Save the first, for unwinding .vector_read_loop: ; Repeatedly get the next value in the vector ; (which may be other vectors) ; until we get a ']' token push r12 push r13 call .read_loop ; object in rax pop r13 pop r12 cmp cl, ']' ; Check if it was end of vector je .vector_done ; Have nil object in rax ; Test if this is a Cons value mov cl, BYTE [rax] mov ch, cl and ch, (block_mask + container_mask) ; Tests block and container type jz .vector_loop_is_value ; If here then not a simple value, so need to allocate ; a Cons object ; Start new vector push rax call alloc_cons ; Address in rax pop rbx mov [rax], BYTE (block_cons + container_vector + content_pointer) mov [rax + Cons.car], rbx ; Now have Cons in RAX, containing pointer to object as car .vector_loop_is_value: ; Cons in RAX ; Make sure it's marked as a vector mov cl, BYTE [rax] or cl, container_vector mov [rax], BYTE cl ; Append to r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Set current vector jmp .vector_read_loop .vector_done: ; Release nil object in rax mov rsi, rax call release_cons ; Terminate the vector mov [r13 + Cons.typecdr], BYTE content_nil mov QWORD [r13 + Cons.cdr], QWORD 0 mov rax, r12 ; Start of current vector ret ; -------------------------------- .handle_quote: ; Turn 'a into (quote a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "quote" push r8 push r9 mov rsi, quote_symbol_string mov edx, quote_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 .wrap_next_object: mov [rax], BYTE maltype_symbol mov [r12], BYTE (block_cons + container_list + content_pointer) mov [r12 + Cons.car], rax ; Get the next object push r12 call .read_loop ; object in rax pop r12 mov r13, rax ; Put object to be quoted in r13 call alloc_cons ; Address in rax mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r13 mov [rax + Cons.typecdr], BYTE content_nil ; Cons object in rax. Append to object in r12 mov [r12 + Cons.typecdr], BYTE content_pointer mov [r12 + Cons.cdr], rax mov rax, r12 ret ; -------------------------------- .handle_quasiquote: ; Turn `a into (quasiquote a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "quasiquote" push r8 push r9 mov rsi, quasiquote_symbol_string mov edx, quasiquote_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 jmp .wrap_next_object ; From there the same as handle_quote ; -------------------------------- .handle_unquote: ; Turn ~a into (unquote a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "unquote" push r8 push r9 mov rsi, unquote_symbol_string mov edx, unquote_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 jmp .wrap_next_object ; From there the same as handle_quote ; -------------------------------- .handle_splice_unquote: ; Turn ~@a into (unquote a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "unquote" push r8 push r9 mov rsi, splice_unquote_symbol_string mov edx, splice_unquote_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 jmp .wrap_next_object ; From there the same as handle_quote ; -------------------------------- .handle_deref: ; Turn @a into (deref a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "deref" push r8 push r9 mov rsi, deref_symbol_string mov edx, deref_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 jmp .wrap_next_object ; From there the same as handle_quote ; -------------------------------- .handle_with_meta: ; Turn ^ a b into (with-meta b a) call alloc_cons ; Address in rax mov r12, rax ; Get a symbol "with-meta" push r8 push r9 mov rsi, with_meta_symbol_string mov edx, with_meta_symbol_string.len call raw_to_string ; Address in rax pop r9 pop r8 mov [rax], BYTE maltype_symbol mov [r12], BYTE (block_cons + container_list + content_pointer) mov [r12 + Cons.car], rax ; Get the next two objects push r12 call .read_loop ; object in rax pop r12 push rax push r12 call .read_loop ; in RAX pop r12 mov r13, rax call alloc_cons ; Address in rax mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r13 ; Cons object in rax. Append to object in r12 mov [r12 + Cons.typecdr], BYTE content_pointer mov [r12 + Cons.cdr], rax mov r13, rax call alloc_cons ; Address in rax mov [rax], BYTE (block_cons + container_list + content_pointer) pop rdi ; First object mov [rax + Cons.car], rdi ; Append to object in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov rax, r12 ret ; -------------------------------- .symbol: ; symbol is in RAX ; Some symbols are have their own type ; - nil, true, false ; mov rsi, rax mov rdi, nil_symbol push rsi call compare_char_array pop rsi cmp rax, 0 je .symbol_nil mov rdi, true_symbol push rsi call compare_char_array pop rsi cmp rax, 0 je .symbol_true mov rdi, false_symbol push rsi call compare_char_array pop rsi cmp rax, 0 je .symbol_false ; not a special symbol, so return mov rax, rsi ret .symbol_nil: ; symbol in rsi not needed call release_array call alloc_cons mov [rax], BYTE maltype_nil ; a nil type ret .symbol_true: call release_array call alloc_cons mov [rax], BYTE maltype_true ret .symbol_false: call release_array call alloc_cons mov [rax], BYTE maltype_false ret ; -------------------------------- .finished: ret .error: ; Jump here on error with raw string in RSI ; and string length in rdx push r14 push r15 call print_rawstring pop r15 pop r14 ; fall through to unwind .unwind: ; Jump to here cleans up mov rsp, r14 ; Rewind stack pointer cmp r15, 0 ; Check if there is a list je .return_nil mov rsi, r15 call release_cons ; releases everything recursively ; fall through to return_nil .return_nil: ; Allocates a new Cons object with nil and returns ; Cleanup should happen before jumping here push rcx call alloc_cons pop rcx mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ;; Initialise the tokenizer ;; ;; Input: Address of string in RSI ;; ;; NOTE: This uses RSI, RAX and RBX, and expects these to be preserved ;; between calls to tokenizer_next_char ;; ;; R9 Address of string ;; R10 Position in data array ;; R11 End of data array ;; tokenizer_init: ; Save string to r9 mov r9, rsi ; Put start of data array into r10 mov r10, rsi add r10, Array.data ; Put end of data array into r11 mov r11d, [rsi + Array.length] ; Length of array, zero-extended add r11, r10 ret ;; Move onto the next chunk of the array ;; This is needed because strings are not stored in one ;; contiguous block of memory, but may use multiple Array ;; objects in a linked list ;; ;; If no chunks are left, then R10 = R11 tokenizer_next_chunk: mov r10, [r9 + Array.next] cmp r10, 0 je .no_more ; More chunks left push rsi ; Because symbol reading uses RSI (tokenizer_next.handle_symbol) mov rsi, r10 call tokenizer_init pop rsi ret .no_more: ; No more chunks left. R10 is zero mov r11, r10 ret ;; Moves the next char into CL ;; If no more, puts 0 into CL tokenizer_next_char: ; Check if we have reached the end of this chunk cmp r10, r11 jne .chars_remain ; Hit the end. See if there is another chunk call tokenizer_next_chunk cmp r10, r11 jne .chars_remain ; Success, got another ; No more chunks mov cl, 0 ; Null char signals end ret .chars_remain: mov cl, BYTE [r10] inc r10 ; point to next byte ret ;; Get the next token ;; Token code is in CL register. Could be: ;; - 0 : Nil, finished ;; - Characters ()[]()'`~^@ ;; - Pair '~@', represented by code 1 ;; - A string: " in CL, and address in RAX ;; - An integer: 'i' in CL ;; - A symbol: 's' in CL, address in RAX ;; ;; Address of object in RAX ;; ;; May use registers: ;; RBX ;; RCX ;; RDX ;; tokenizer_next: .next_char: ; Fetch the next char into CL call tokenizer_next_char cmp cl, 0 je .found ; End, no more tokens ; Here expect to have: ; - The current character in CL ; - Address of next data in r10 ; - Address of data end in r11 ; Skip whitespace or commas cmp cl, ' ' ; Space je .next_char cmp cl, ',' ; Comma je .next_char cmp cl, 9 ; Tab je .next_char cmp cl, 10 ; Line Feed je .next_char cmp cl, 13 ; Carriage Return je .next_char ; Special characters. These are returned in CL as-is cmp cl, '(' je .found cmp cl, ')' je .found cmp cl, '[' je .found cmp cl, ']' je .found cmp cl, '{' je .found cmp cl, '}' je .found cmp cl, 39 ; character ' je .found cmp cl, 96 ; character ` je .found cmp cl, '^' je .found cmp cl, '@' je .found cmp cl, '~' ; Could be followed by '@' je .handle_tilde cmp cl, ';' ; Start of a comment je .comment cmp cl, 34 ; Opening string quotes je .handle_string ; Could be number or symbol cmp cl, '-' ; Minus sign je .handle_minus mov ch, 0 ; Check for a character 0-9 cmp cl, '0' jl .handle_symbol cmp cl, '9' jg .handle_symbol ; Here an integer jmp .handle_integer .comment: ; Start of a comment. Keep reading until a new line or end ; Fetch the next char into CL call tokenizer_next_char cmp cl, 0 je .found ; End, no more tokens cmp cl, 10 je .next_char ; Next line, start reading again jmp .comment .handle_minus: ; Push current state of the tokenizer push r9 push r10 push r11 ; Get the next character call tokenizer_next_char ; Check if it is a number cmp cl, '0' jl .minus_not_number cmp cl, '9' jg .minus_not_number ; Here is a number mov ch, '-' ; Put '-' in ch for later ; Discard old state by moving stack pointer add rsp, 24 ; 3 * 8 bytes jmp .handle_integer .minus_not_number: ; Restore state pop r11 pop r10 pop r9 mov cl, '-' ; Put back jmp .handle_symbol .handle_integer: ; Start integer ; accumulate in EDX xor edx, edx .integer_loop: ; Here have a char 0-9 in CL sub cl, '0' ; Convert to number between 0 and 9 movzx ebx, cl add edx, ebx ; Push current state of the tokenizer push r9 push r10 push r11 ; Peek at next character call tokenizer_next_char ; Next char in CL cmp cl, '0' jl .integer_finished cmp cl, '9' jg .integer_finished ; Discard old state by moving stack pointer add rsp, 24 ; 3 * 8 bytes imul edx, 10 jmp .integer_loop .integer_finished: ; Next char not an int ; Restore state of the tokenizer pop r11 pop r10 pop r9 push rdx ; Save the integer ; Get a Cons object to put the result into call alloc_cons pop rdx ; Restore integer ; Check if the number should be negative cmp ch, '-' jne .integer_store neg rdx .integer_store: ; Address of Cons now in RAX mov [rax], BYTE maltype_integer mov [rax + Cons.car], rdx mov cl, 'i' ; Mark as an integer ret ; ------------------------------------------- .handle_symbol: ; Read characters until reaching whitespace, special character or end call string_new mov rsi, rax ; Output string in rsi .symbol_loop: ; Put the current character into the array call string_append_char ; Push current state of the tokenizer push r9 push r10 push r11 call tokenizer_next_char cmp cl, 0 ; End of characters je .symbol_finished cmp cl, ' ' ; Space je .symbol_finished cmp cl, ',' ; Comma je .symbol_finished cmp cl, 9 ; Tab je .symbol_finished cmp cl, 10 ; Line Feed je .symbol_finished cmp cl, 13 ; Carriage Return je .symbol_finished cmp cl, '(' je .symbol_finished cmp cl, ')' je .symbol_finished cmp cl, '[' je .symbol_finished cmp cl, ']' je .symbol_finished cmp cl, '{' je .symbol_finished cmp cl, '}' je .symbol_finished cmp cl, 39 ; character ' je .symbol_finished cmp cl, 96 ; character ` je .symbol_finished cmp cl, '^' je .symbol_finished cmp cl, '@' je .symbol_finished cmp cl, '~' je .symbol_finished cmp cl, ';' ; Start of a comment je .symbol_finished cmp cl, 34 ; Opening string quotes je .symbol_finished ; Keeping current character ; Discard old state by moving stack pointer add rsp, 24 ; 3 * 8 bytes jmp .symbol_loop ; Append to array .symbol_finished: ; Not keeping current character ; Restore state of the tokenizer pop r11 pop r10 pop r9 mov rax, rsi mov [rax], BYTE maltype_symbol ; Mark as a symbol mov cl, 's' ; used by read_str ret ; -------------------------------------------- .handle_string: ; Get an array to put the string into call string_new ; Array in RAX ; Put start of data array into rbx mov rbx, rax add rbx, Array.data ; Put end of data array into rdx mov edx, DWORD [rax + Array.length] ; Length of array, zero-extended add rdx, rbx ; Now read chars from input string and push into output .string_loop: call tokenizer_next_char cmp cl, 0 ; End of characters je .error cmp cl, 34 ; Finishing '"' je .string_done ; Leave '"' in CL cmp cl, 92 ; Escape '\' jne .end_string_escape ; Current character is a '\' call tokenizer_next_char cmp cl, 0 ; End of characters je .error cmp cl, 'n' ; \n, newline je .insert_newline ; Whatever is in cl is now put into string ; including '"' jmp .end_string_escape .insert_newline: mov cl, 10 jmp .end_string_escape .end_string_escape: ; Put CL onto result array ; NOTE: this doesn't handle long strings (multiple memory blocks) mov [rbx], cl inc rbx jmp .string_loop .string_done: ; Calculate the length from rbx sub rbx, Array.data sub rbx, rax mov [rax+Array.length], DWORD ebx ret ; --------------------------------- .handle_tilde: ; Could have '~' or '~@'. Need to peek at the next char ; Push current state of the tokenizer push r9 push r10 push r11 call tokenizer_next_char ; Next char in CL cmp cl, '@' jne .tilde_no_amp ; Just '~', not '~@' ; Got '~@' mov cl, 1 ; Signals '~@' ; Discard old state by moving stack pointer add rsp, 24 ; 3 * 8 bytes ret .tilde_no_amp: mov cl, '~' ; Restore state of the tokenizer pop r11 pop r10 pop r9 ; fall through to .found .found: ret .error: ret ================================================ FILE: impls/nasm/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/nasm/step0_repl.asm ================================================ ;; ;; nasm -felf64 step0_repl.asm && ld step0_repl.o && ./a.out ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "system.asm" ; System calls %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt section .text ;; Takes a string as input and processes it into a form read: mov rax, rsi ; Return the input ret ;; ---------------------------------------------- ;; Evaluates a form eval: mov rax, rsi ; Return the input ret ;; Prints the result print: mov rax, rsi ; Return the input ret ;; Read-Eval-Print in sequence rep_seq: ; ------------- ; Read call read ; ------------- ; Eval mov rsi, rax ; Output of read into input of eval call eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print call print ret _start: ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd mov rsi, rax ; Put into input of print_string call print_string jmp .mainLoop .mainLoopEnd: jmp quit ================================================ FILE: impls/nasm/step1_read_print.asm ================================================ ;; ;; nasm -felf64 step1_read_print.asm && ld step1_read_print.o && ./a.out ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt section .text ;; Takes a string as input and processes it into a form read: jmp read_str ; In reader.asm ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; eval: mov rax, rsi ; Return the input ret ;; Prints the result print: mov rdi, 1 ; print readably jmp pr_str ;; Read-Eval-Print in sequence rep_seq: ; ------------- ; Read call read push rax ; Save form ; ------------- ; Eval mov rsi, rax ; Output of read into input of eval call eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print call print ; String in RAX mov r8, rax ; Save output pop rsi ; Form returned by read call release_object mov rax, r8 ret _start: ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit ================================================ FILE: impls/nasm/step2_eval.asm ================================================ ;; ;; nasm -felf64 step2_eval.asm && ld step2_eval.o && ./a.out ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static core_add_symbol, db "+" static core_sub_symbol, db "-" static core_mul_symbol, db "*" static core_div_symbol, db "/" section .text ;; Integer arithmetic operations ;; ;; Adds a list of numbers, address in RSI ;; Returns the sum as a number object with address in RAX ;; Since most of the code is common to all operators, ;; RBX is used to jump to the required instruction core_add: mov rbx, core_arithmetic.do_addition jmp core_arithmetic core_sub: mov rbx, core_arithmetic.do_subtraction jmp core_arithmetic core_mul: mov rbx, core_arithmetic.do_multiply jmp core_arithmetic core_div: mov rbx, core_arithmetic.do_division ; Fall through to core_arithmetic core_arithmetic: ; Check that the first object is a number mov cl, BYTE [rsi] mov ch, cl and ch, block_mask cmp ch, block_cons jne .missing_args mov ch, cl and ch, content_mask cmp ch, content_empty je .missing_args cmp ch, content_int jne .not_int ; Put the starting value in rax mov rax, [rsi + Cons.car] .add_loop: ; Fetch the next value mov cl, [rsi + Cons.typecdr] cmp cl, content_pointer jne .finished ; Nothing let mov rsi, [rsi + Cons.cdr] ; Get next cons ; Check that it is an integer mov cl, BYTE [rsi] and cl, content_mask cmp cl, content_int jne .not_int ; Jump to the required operation, address in RBX jmp rbx .do_addition: add rax, [rsi + Cons.car] jmp .add_loop .do_subtraction: sub rax, [rsi + Cons.car] jmp .add_loop .do_multiply: imul rax, [rsi + Cons.car] jmp .add_loop .do_division: cqo ; Sign extend RAX into RDX mov rcx, [rsi + Cons.car] idiv rcx jmp .add_loop .finished: ; Value in rbx push rax ; Get a Cons object to put the result into call alloc_cons pop rbx mov [rax], BYTE maltype_integer mov [rax + Cons.car], rbx ret .missing_args: .not_int: jmp quit ;; Add a native function to the core environment ;; This is used in core_environment %macro core_env_native 2 push rsi ; environment mov rsi, %1 mov edx, %1.len call raw_to_symbol ; Symbol in RAX push rax mov rsi, %2 call native_function ; Function in RAX mov rcx, rax ; value (function) pop rdi ; key (symbol) pop rsi ; environment call map_set %endmacro ;; Takes a string as input and processes it into a form read: jmp read_str ; In reader.asm ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; eval_ast: ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; look in environment mov rdi, rsi ; symbol is the key mov rsi, [repl_env] ; Environment call map_get je .done ; result in RAX ; Not found, should raise an error ; Return nil call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 mov rsi, [rsi + Cons.car] ; Get the address call eval ; Evaluate it, result in rax pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_append ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result mov rsi, [r10 + Cons.car] ; Get the address call eval ; Evaluate it, result in rax pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 mov rsi, [rsi + Cons.car] ; Get the address call eval ; Evaluate it, result in rax pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_append_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_append_value: or bl, container_vector mov [rax], BYTE bl .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate ;; ;; Returns: Result in RAX ;; eval: ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast ret ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX push rsi ; Compare against def! mov rsi, rbx mov rdi, def_symbol call compare_char_array pop rsi cmp rax, 0 je .def_symbol push rsi mov rdi, let_symbol call compare_char_array pop rsi cmp rax, 0 je .let_symbol ; Unrecognised jmp .list_eval .def_symbol: ; Define a new symbol in current environment jmp .list_not_function .let_symbol: ; Create a new environment jmp .list_not_function .list_eval: call eval_ast ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Call the function with the rest of the list in RSI push rax mov rsi, [rax + Cons.cdr] ; Rest of list mov rdi, rbx ; Function object in RDI call [rbx + Cons.car] ; Call function ; Result in rax pop rsi ; eval'ed list push rax call release_cons pop rax ret .list_not_function: ; Not a function. Probably an error ret .empty_list: mov rax, rsi ret ;; Prints the result print: mov rdi, 1 ; print readably jmp pr_str ;; Read-Eval-Print in sequence rep_seq: ; ------------- ; Read call read push rax ; Save form ; ------------- ; Eval mov rsi, rax ; Output of read into input of eval call eval push rax ; Save result ; ------------- ; Print mov rsi, rax ; Output of eval into input of print call print ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object pop rsi ; Form returned by read call release_object mov rax, r8 ret _start: ; Create and print the core environment call map_new ; Environment in RAX mov [repl_env], rax ; store in memory mov rsi, rax ; Environment ; Add +,-,*,/ to environment core_env_native core_add_symbol, core_add core_env_native core_sub_symbol, core_sub core_env_native core_mul_symbol, core_mul core_env_native core_div_symbol, core_div ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit ================================================ FILE: impls/nasm/step3_env.asm ================================================ ;; ;; nasm -felf64 step3_env.asm && ld step3_env.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static core_add_symbol, db "+" static core_sub_symbol, db "-" static core_mul_symbol, db "*" static core_div_symbol, db "/" section .text ;; Integer arithmetic operations ;; ;; Adds a list of numbers, address in RSI ;; Returns the sum as a number object with address in RAX ;; Since most of the code is common to all operators, ;; RBX is used to jump to the required instruction core_add: mov rbx, core_arithmetic.do_addition jmp core_arithmetic core_sub: mov rbx, core_arithmetic.do_subtraction jmp core_arithmetic core_mul: mov rbx, core_arithmetic.do_multiply jmp core_arithmetic core_div: mov rbx, core_arithmetic.do_division ; Fall through to core_arithmetic core_arithmetic: ; Check that the first object is a number mov cl, BYTE [rsi] mov ch, cl and ch, block_mask cmp ch, block_cons jne .missing_args mov ch, cl and ch, content_mask cmp ch, content_empty je .missing_args cmp ch, content_int jne .not_int ; Put the starting value in rax mov rax, [rsi + Cons.car] .add_loop: ; Fetch the next value mov cl, [rsi + Cons.typecdr] cmp cl, content_pointer jne .finished ; Nothing let mov rsi, [rsi + Cons.cdr] ; Get next cons ; Check that it is an integer mov cl, BYTE [rsi] and cl, content_mask cmp cl, content_int jne .not_int ; Jump to the required operation, address in RBX jmp rbx .do_addition: add rax, [rsi + Cons.car] jmp .add_loop .do_subtraction: sub rax, [rsi + Cons.car] jmp .add_loop .do_multiply: imul rax, [rsi + Cons.car] jmp .add_loop .do_division: cqo ; Sign extend RAX into RDX mov rcx, [rsi + Cons.car] idiv rcx jmp .add_loop .finished: ; Value in rbx push rax ; Get a Cons object to put the result into call alloc_cons pop rbx mov [rax], BYTE maltype_integer mov [rax + Cons.car], rbx ret .missing_args: .not_int: jmp quit ;; Add a native function to the core environment ;; This is used in core_environment %macro core_env_native 2 push rsi ; environment mov rsi, %1 mov edx, %1.len call raw_to_symbol ; Symbol in RAX push rax mov rsi, %2 call native_function ; Function in RAX mov rcx, rax ; value (function) pop rdi ; key (symbol) pop rsi ; environment call env_set %endmacro ;; Takes a string as input and processes it into a form read: jmp read_str ; In reader.asm ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate ;; RDI Environment ;; ;; Returns: Result in RAX ;; eval: mov r15, rdi ; Env ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast ret ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol ; Unrecognised jmp .list_eval .def_symbol: ; Define a new symbol in current environment ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 call eval mov rsi, rax pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx ; Return the value ret .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, [r12 + Cons.car] ; Get the address mov rdi, r14 call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to mov rdi, r14 ; New environment push r14 call eval pop r14 .let_done: ; Release the environment mov rsi, r14 push rax call release_object pop rax ret .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Call the function with the rest of the list in RSI push rax push r15 mov rsi, [rax + Cons.cdr] ; Rest of list mov rdi, rbx ; Function object in RDI call [rbx + Cons.car] ; Call function ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax ret .list_not_function: ; Not a function. Probably an error ret .empty_list: mov rax, rsi ret ;; Prints the result print: mov rdi, 1 ; print readably jmp pr_str ;; Read-Eval-Print in sequence rep_seq: ; ------------- ; Read call read push rax ; Save form ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment call eval push rax ; Save result ; ------------- ; Print mov rsi, rax ; Output of eval into input of print call print ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object pop rsi ; Form returned by read call release_object mov rax, r8 ret _start: ; Create and print the core environment call env_new ; Environment in RAX mov [repl_env], rax ; store in memory mov rsi, rax ; Environment ; Add +,-,*,/ to environment core_env_native core_add_symbol, core_add core_env_native core_sub_symbol, core_sub core_env_native core_mul_symbol, core_mul core_env_native core_div_symbol, core_div ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt ================================================ FILE: impls/nasm/step4_if_fn_do.asm ================================================ ;; ;; nasm -felf64 step4_if_fn_do.asm && ld step4_if_fn_do.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(def! not (fn* (a) (if a false true)))" section .text ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate ;; RDI Environment ;; ;; Returns: Result in RAX ;; eval: mov r15, rdi ; Env ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast ret ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .def_symbol: ; Define a new symbol in current environment ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 call eval mov rsi, rax pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx ; Return the value ret .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, [r12 + Cons.car] ; Get the address mov rdi, r14 call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to mov rdi, r14 ; New environment push r14 call eval pop r14 .let_done: ; Release the environment mov rsi, r14 push rax call release_object pop rax ret .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body mov r11, [r11 + Cons.cdr] .do_symbol_loop: ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value ; A pointer, so evaluate push r15 push r11 mov rsi, [r11 + Cons.car] ; Form mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Check if there is another form mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_done ; No more, so finished ; Another form. Discard the result of the last eval mov rsi, rax call release_object .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_done: ret ; Return result in RAX .do_body_value: ; Got a value in R11. ; If this is the last form then return, ; but if not then can ignore mov bl, BYTE [r11 + Cons.typecdr] and bl, block_mask + content_mask cmp bl, content_pointer jne .do_body_value_return ; Not the last, so ignore jmp .do_next .do_body_value_return: ; Got a value as last form. Copy and return push rax call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ret .do_no_body: ; No expressions to evaluate. Return nil call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, [r11 + Cons.car] ; Form mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ret .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form mov rdi, r15 ; Env call eval ret .if_no_condition: ; just (if) without a condition call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 ret .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx call alloc_cons mov [rax], BYTE maltype_empty_list pop rbx mov rsi, rax jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI push rax push r15 mov rdi, rbx ; Function object in RDI call [rbx + Cons.car] ; Call function ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax ret .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi ret ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; ;; ;; Output: Result in RAX ;; apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed push rax mov rsi, rax call incref_object pop rax ret .bind: ; Create a new environment, binding arguments push rax call env_new_bind mov rdi, rax ; New environment in RDI pop rsi ; Body ; Evaluate the function body push rdi ; Environment call eval pop rsi ; Release the environment push rax call release_object pop rax ret ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str push rax ; Save form ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment call eval push rax ; Save result ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object pop rsi ; Form returned by read call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rsi ; AST push rsi mov rdi, [repl_env] ; Environment call eval pop rsi push rax call release_object ; AST pop rsi call release_object ; Return from eval ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt ================================================ FILE: impls/nasm/step5_tco.asm ================================================ ;; ;; nasm -felf64 step5_tco.asm && ld step5_tco.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(def! not (fn* (a) (if a false true)))" section .text ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate [ Released ] ;; RDI Environment [ Released ] ;; ;; Returns: Result in RAX ;; ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: mov r15, rdi ; Env push rsi ; AST pushed, must be popped before return ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast jmp .return ; Releases Env ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .def_symbol: ; Define a new symbol in current environment ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt ================================================ FILE: impls/nasm/step6_file.asm ================================================ ;; ;; nasm -felf64 step6_file.asm && ld step6_file.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol argv_symbol, '*ARGV*' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(do \ (def! not (fn* (a) (if a false true))) \ (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ )" ;; Command to run, appending the name of the script to run static run_script_string, db "(load-file ",34 section .text ;; ---------------------------------------------- ;; Evaluates a form ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate [ Released ] ;; RDI Environment [ Released ] ;; ;; Returns: Result in RAX ;; ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: mov r15, rdi ; Env push rsi ; AST pushed, must be popped before return ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast jmp .return ; Releases Env ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .def_symbol: ; Define a new symbol in current environment ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;; Read and eval read_eval: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval jmp eval ; This releases Env and Form/AST ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Check command-line arguments pop rax ; Number of arguments cmp rax, 1 ; Always have at least one, the path to executable jg run_script ; No extra arguments, so just set *ARGV* to an empty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov rcx, rax ; value (empty list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt run_script: ; Called with number of command-line arguments in RAX mov r8, rax pop rbx ; executable dec r8 pop rsi ; Address of first arg call cstring_to_string ; string in RAX mov r9, rax ; get the rest of the args xor r10, r10 ; Zero dec r8 jz .no_args ; Got some arguments .arg_loop: ; Got an argument left. pop rsi ; Address of C string call cstring_to_string ; String in RAX mov r12, rax ;Make a Cons to point to the string call alloc_cons ; in RAX mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r12 test r10, r10 jnz .append ; R10 zero, so first arg mov r10, rax ; Head of list mov r11, rax ; Tail of list jmp .next .append: ; R10 not zero, so append to list tail mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer mov r11, rax .next: dec r8 jnz .arg_loop jmp .got_args .no_args: ; No arguments. Create an emoty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov r10, rax .got_args: push r9 ; File name string mov rcx, r10 ; value (list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set mov rsi, run_script_string ; load-file function mov edx, run_script_string.len call raw_to_string ; String in RAX mov rsi, rax pop rdx ; File name string call string_append_string mov cl, 34 ; " call string_append_char mov cl, ')' call string_append_char ; closing brace ; Read-Eval "(load-file )" call read_eval jmp quit ================================================ FILE: impls/nasm/step7_quote.asm ================================================ ;; ;; nasm -felf64 step7_quote.asm && ld step7_quote.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol argv_symbol, '*ARGV*' 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 \ (def! not (fn* (a) (if a false true))) \ (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ )" ;; Command to run, appending the name of the script to run 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 ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate [ Released ] ;; RDI Environment [ Released ] ;; ;; Returns: Result in RAX ;; ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: mov r15, rdi ; Env push rsi ; AST pushed, must be popped before return ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast jmp .return ; Releases Env ; -------------------- .list: ; A list ; Check if the first element is a symbol mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol 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 ; Unrecognised jmp .list_eval ; ----------------------------- .def_symbol: ; Define a new symbol in current environment ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .quote_symbol: ; Just return the arguments in rsi cdr mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quote empty, so return nil mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi 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 mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quasiquote empty, so return nil mov r11, rsi ; Save original AST in R11 mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quasiquote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quasiquote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] push r15 ; Environment ; Original AST already on stack call quasiquote ; New AST in RAX pop rdi ; Environment pop rsi ; Old AST mov r11, rax ; New AST call release_object ; Release old AST mov rsi, r11 ; New AST in RSI jmp eval ; Tail call ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;;; Called by eval ;;; Original AST in RSI. ;;; Returns new AST in RAX quasiquote: ;; 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 .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 cmp cl, content_pointer ; and it is a pointer, jne qq_foldr 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 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 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] 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], 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: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval jmp eval ; This releases Env and Form/AST ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Check command-line arguments pop rax ; Number of arguments cmp rax, 1 ; Always have at least one, the path to executable jg run_script ; No extra arguments, so just set *ARGV* to an empty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov rcx, rax ; value (empty list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt run_script: ; Called with number of command-line arguments in RAX mov r8, rax pop rbx ; executable dec r8 pop rsi ; Address of first arg call cstring_to_string ; string in RAX mov r9, rax ; get the rest of the args xor r10, r10 ; Zero dec r8 jz .no_args ; Got some arguments .arg_loop: ; Got an argument left. pop rsi ; Address of C string call cstring_to_string ; String in RAX mov r12, rax ;Make a Cons to point to the string call alloc_cons ; in RAX mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r12 test r10, r10 jnz .append ; R10 zero, so first arg mov r10, rax ; Head of list mov r11, rax ; Tail of list jmp .next .append: ; R10 not zero, so append to list tail mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer mov r11, rax .next: dec r8 jnz .arg_loop jmp .got_args .no_args: ; No arguments. Create an emoty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov r10, rax .got_args: push r9 ; File name string mov rcx, r10 ; value (list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set mov rsi, run_script_string ; load-file function mov edx, run_script_string.len call raw_to_string ; String in RAX mov rsi, rax pop rdx ; File name string call string_append_string mov cl, 34 ; " call string_append_char mov cl, ')' call string_append_char ; closing brace ; Read-Eval "(load-file )" call read_eval jmp quit ================================================ FILE: impls/nasm/step8_macros.asm ================================================ ;; ;; nasm -felf64 step8_macros.asm && ld step8_macros.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static defmacro_expecting_function_string, db "defmacro expects function",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol defmacro_symbol, 'defmacro!' static_symbol macroexpand_symbol, 'macroexpand' static_symbol argv_symbol, '*ARGV*' 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 \ (def! not (fn* (a) (if a false true))) \ (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ )" ;; Command to run, appending the name of the script to run 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 ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error push rsi print_str_mac error_string ; print 'Error: ' pop rsi push rsi mov edx, [rsi + Array.length] add rsi, Array.data call print_rawstring ; print symbol print_str_mac not_found_string ; print ' not found' pop rsi jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate [ Released ] ;; RDI Environment [ Released ] ;; ;; Returns: Result in RAX ;; ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: mov r15, rdi ; Env push rsi ; AST pushed, must be popped before return ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast jmp .return ; Releases Env ; -------------------- .list: ; A list ; Macro expand pop rax ; Old AST, discard from stack call macroexpand ; Replaces RSI push rsi ; New AST ; Check if RSI is a list, and if ; the first element is a symbol mov al, BYTE [rsi] ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged mov ah, al and ah, container_mask cmp ah, container_list je .list_still_list ; Not a list, so call eval_ast on it mov rdi, r15 ; Environment call eval_ast jmp .return .list_still_list: and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol 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 eval_cmp_symbol defmacro_symbol ; defmacro! je .defmacro_symbol eval_cmp_symbol macroexpand_symbol ; macroexpand je .macroexpand_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .defmacro_symbol: mov r9, 1 jmp .def_common .def_symbol: xor r9, r9 ; Set R9 to 0 .def_common: ; Define a new symbol in current environment ; If R9 is set to 1 then defmacro ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy ; Test if this is defmacro! test r9, r9 jnz .defmacro_not_function push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env push r9 mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r9 ; If this is defmacro, and the object in RSI is a function, ; then change to a macro test r9, r9 jz .def_not_macro ; Not defmacro ; Check RSI mov al, BYTE [rsi] cmp al, maltype_function jne .defmacro_not_function ; Got a function, change to macro mov [rsi], BYTE maltype_macro .def_not_macro: pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .defmacro_not_function: mov rsi, defmacro_expecting_function_string mov rdx, defmacro_expecting_function_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .quote_symbol: ; Just return the arguments in rsi cdr mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quote empty, so return nil mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi 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 mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quasiquote empty, so return nil mov r11, rsi ; Save original AST in R11 mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quasiquote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quasiquote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] push r15 ; Environment ; Original AST already on stack call quasiquote ; New AST in RAX pop rdi ; Environment pop rsi ; Old AST mov r11, rax ; New AST call release_object ; Release old AST mov rsi, r11 ; New AST in RSI jmp eval ; Tail call ; ----------------------------- .macroexpand_symbol: ; Check if we have a second list element mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; No argument mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .macroexpand_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .macroexpand_pointer: mov rsi, [rsi + Cons.car] call incref_object ; Since RSI will be released call macroexpand ; May release and replace RSI mov rax, rsi jmp .return ; Releases original AST ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;;; Called by eval ;;; Original AST in RSI. ;;; Returns new AST in RAX quasiquote: ;; 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 .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 cmp cl, content_pointer ; and it is a pointer, jne qq_foldr 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 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 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] 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], 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 ;; Tests if an AST in RSI is a list containing ;; a macro defined in the ENV in R15 ;; ;; Inputs: AST in RSI (not modified) ;; ENV in R15 (not modified) ;; ;; Returns: Sets ZF if macro call. If set (true), ;; then the macro object is in RAX ;; ;; Modifies: ;; RAX ;; RBX ;; RCX ;; RDX ;; R8 ;; R9 is_macro_call: ; Test if RSI is a list which contains a pointer mov al, BYTE [rsi] cmp al, (block_cons + container_list + content_pointer) jne .false ; Test if this is a symbol mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .false ; Look up symbol in Env push rsi push r15 mov rdi, rbx ; symbol in RDI mov rsi, r15 ; Environment in RSI call env_get pop r15 pop rsi jne .false ; Not in environment ; Object in RAX ; If this is not a macro then needs to be released mov dl, BYTE [rax] cmp dl, maltype_macro je .true ; Not a macro, so release mov r8, rsi mov rsi, rax call release_object mov rsi, r8 .false: lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ret .true: mov rbx, rax ; Returning Macro object lahf ; flags in AH or ah, 64 ; set zero flag sahf mov rax, rbx ret ;; Expands macro calls ;; ;; Input: AST in RSI (released and replaced) ;; Env in R15 (not modified) ;; ;; Result: New AST in RSI macroexpand: push r15 call is_macro_call jne .done mov r13, rsi mov rdi, rax ; Macro in RDI ; Check the rest of the args mov cl, BYTE [rsi + Cons.typecdr] cmp cl, content_pointer je .got_args ; No arguments. Create an empty list call alloc_cons mov [rax], BYTE maltype_empty_list mov rdx, rax mov rsi, rdx ; Arguments (empty list) call incref_object jmp .macro_call .got_args: mov rsi, [rsi + Cons.cdr] ; Rest of list call incref_object mov rdx, rsi ; Released .macro_call: ; Here have: ; RSI - Arguments ; RDI - Macro object ; RDX - List to release ; R15 - Environment ; R13 - AST ; Increment reference for Environment ; since this will be released by apply_fn xchg rsi, r15 call incref_object xchg rsi, r15 call apply_fn mov rsi, rax ; Result in RSI pop r15 jmp macroexpand .done: pop r15 ret ;; Read and eval read_eval: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval jmp eval ; This releases Env and Form/AST ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Check command-line arguments pop rax ; Number of arguments cmp rax, 1 ; Always have at least one, the path to executable jg run_script ; No extra arguments, so just set *ARGV* to an empty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov rcx, rax ; value (empty list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt run_script: ; Called with number of command-line arguments in RAX mov r8, rax pop rbx ; executable dec r8 pop rsi ; Address of first arg call cstring_to_string ; string in RAX mov r9, rax ; get the rest of the args xor r10, r10 ; Zero dec r8 jz .no_args ; Got some arguments .arg_loop: ; Got an argument left. pop rsi ; Address of C string call cstring_to_string ; String in RAX mov r12, rax ;Make a Cons to point to the string call alloc_cons ; in RAX mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r12 test r10, r10 jnz .append ; R10 zero, so first arg mov r10, rax ; Head of list mov r11, rax ; Tail of list jmp .next .append: ; R10 not zero, so append to list tail mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer mov r11, rax .next: dec r8 jnz .arg_loop jmp .got_args .no_args: ; No arguments. Create an emoty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov r10, rax .got_args: push r9 ; File name string mov rcx, r10 ; value (list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set mov rsi, run_script_string ; load-file function mov edx, run_script_string.len call raw_to_string ; String in RAX mov rsi, rax pop rdx ; File name string call string_append_string mov cl, 34 ; " call string_append_char mov cl, ')' call string_append_char ; closing brace ; Read-Eval "(load-file )" call read_eval jmp quit ================================================ FILE: impls/nasm/step9_try.asm ================================================ ;; ;; nasm -felf64 step9_try.asm && ld step9_try.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static defmacro_expecting_function_string, db "defmacro expects function",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 static try_missing_catch, db "try* missing catch*" static catch_missing_symbol, db "catch* missing symbol" static catch_missing_form, db "catch* missing form" ;; Symbols used for comparison static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol defmacro_symbol, 'defmacro!' static_symbol macroexpand_symbol, 'macroexpand' static_symbol try_symbol, 'try*' static_symbol catch_symbol, 'catch*' static_symbol argv_symbol, '*ARGV*' 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 \ (def! not (fn* (a) (if a false true))) \ (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ )" ;; Command to run, appending the name of the script to run 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 ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; eval_ast: mov r15, rdi ; Save Env in r15 ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi ret .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error mov r11, rsi ; Symbol in R11 call string_new mov rsi, rax ; New string in RSI mov cl, 39 ; quote ' call string_append_char mov rdx, r11 ; symbol call string_append_string mov cl, 39 call string_append_char mov r11, rsi mov rsi, not_found_string mov edx, not_found_string.len call raw_to_string ; ' not found' mov r12, rax mov rdx, rax mov rsi, r11 call string_append_string mov r11, rsi mov rsi, r12 call release_array mov rsi, r11 jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi ret ; ------------------------------ .list: ; Evaluate each element of the list ; xor r8, r8 ; The list to return ; r9 contains head of list .list_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX cmp r8, 0 ; Check if this is the first je .list_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_next .list_first: mov r8, rax mov r9, rax ; fall through to .list_next .list_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list ret ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi ret .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 ret .map_error_missing_value: mov rax, r12 ret ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector ret ; --------------------- .done: ret ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ;; ---------------------------------------------------- ;; Evaluates a form ;; ;; Input: RSI AST to evaluate [ Released ] ;; RDI Environment [ Released ] ;; ;; Returns: Result in RAX ;; ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: mov r15, rdi ; Env push rsi ; AST pushed, must be popped before return ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, container_mask cmp al, container_list je .list ; Not a list. Evaluate and return call eval_ast jmp .return ; Releases Env ; -------------------- .list: ; A list ; Macro expand pop rax ; Old AST, discard from stack call macroexpand ; Replaces RSI push rsi ; New AST ; Check if RSI is a list, and if ; the first element is a symbol mov al, BYTE [rsi] ; Check type mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged mov ah, al and ah, container_mask cmp ah, container_list je .list_still_list ; Not a list, so call eval_ast on it mov rdi, r15 ; Environment call eval_ast jmp .return .list_still_list: and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol 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 eval_cmp_symbol defmacro_symbol ; defmacro! je .defmacro_symbol eval_cmp_symbol macroexpand_symbol ; macroexpand je .macroexpand_symbol eval_cmp_symbol try_symbol ; try* je .try_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .defmacro_symbol: mov r9, 1 jmp .def_common .def_symbol: xor r9, r9 ; Set R9 to 0 .def_common: ; Define a new symbol in current environment ; If R9 is set to 1 then defmacro ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy ; Test if this is defmacro! test r9, r9 jnz .defmacro_not_function push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env push r9 mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r9 ; If this is defmacro, and the object in RSI is a function, ; then change to a macro test r9, r9 jz .def_not_macro ; Not defmacro ; Check RSI mov al, BYTE [rsi] cmp al, maltype_function jne .defmacro_not_function ; Got a function, change to macro mov [rsi], BYTE maltype_macro .def_not_macro: pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .defmacro_not_function: mov rsi, defmacro_expecting_function_string mov rdx, defmacro_expecting_function_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .quote_symbol: ; Just return the arguments in rsi cdr mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quote empty, so return nil mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi 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 mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quasiquote empty, so return nil mov r11, rsi ; Save original AST in R11 mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quasiquote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quasiquote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] push r15 ; Environment ; Original AST already on stack call quasiquote ; New AST in RAX pop rdi ; Environment pop rsi ; Old AST mov r11, rax ; New AST call release_object ; Release old AST mov rsi, r11 ; New AST in RSI jmp eval ; Tail call ; ----------------------------- .macroexpand_symbol: ; Check if we have a second list element mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; No argument mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .macroexpand_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .macroexpand_pointer: mov rsi, [rsi + Cons.car] call incref_object ; Since RSI will be released call macroexpand ; May release and replace RSI mov rax, rsi jmp .return ; Releases original AST ; ----------------------------- .try_symbol: ; Should have the form ; ; (try* A (catch* B C)) ; ; where B is a symbol, A and C are forms to evaluate ; Check first arg A mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; No argument mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .try_pointer ; RSI contains a value. Copy and return mov cl, al call alloc_cons mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx jmp .return .try_pointer: mov r8, [rsi + Cons.car] ; form A in R8 ; Check second arg B mov al, BYTE [rsi + Cons.typecdr] ; If nil (catchless try) cmp al, content_nil je .catchless_try cmp al, content_pointer jne .try_missing_catch mov rsi, [rsi + Cons.cdr] mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .try_missing_catch mov r9, [rsi + Cons.car] ; (catch* B C) in R9 mov al, BYTE [r9] cmp al, (container_list + content_pointer) jne .try_missing_catch mov rsi, [r9 + Cons.car] ; Should be catch* symbol mov al, BYTE [rsi] cmp al, maltype_symbol jne .try_missing_catch mov rdi, catch_symbol call compare_char_array test rax, rax ; ZF set if rax = 0 (equal) jnz .try_missing_catch ; Check that B is a symbol mov al, [r9 + Cons.typecdr] cmp al, content_pointer jne .catch_missing_symbol mov r9, [r9 + Cons.cdr] ; (B C) in R9 mov al, BYTE [r9] and al, content_mask cmp al, content_pointer jne .catch_missing_symbol mov r10, [r9 + Cons.car] ; B in R10 mov al, BYTE [r10] cmp al, maltype_symbol jne .catch_missing_symbol mov al, BYTE [r9 + Cons.typecdr] cmp al, content_pointer jne .catch_missing_form mov r9, [r9 + Cons.cdr] ; C in R9 ; Now have extracted from (try* A (catch* B C)) ; A in R8 ; B in R10 ; C in R9 push R9 push R10 push r15 ; Env ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the form in R8 mov rsi, r15 call incref_object ; Env released by eval mov rdi, r15 ; Env in RDI mov rsi, r8 ; The form to evaluate (A) call incref_object ; AST released by eval call eval mov r8, rax ; Result in R8 pop r15 ; Environment ; Discard B and C ;add rsi, 8 ; pop R10 and R9 pop r10 pop r9 ; Remove error handler call error_handler_pop mov rax, r8 jmp .return .catchless_try: ;; Evaluate the form in R8 push r15 ; Environment mov rsi, r15 call incref_object ; Env released by eval mov rdi, r15 ; Env in RDI mov rsi, r8 ; The form to evaluate (A) call incref_object ; AST released by eval call eval ; Result in RAX pop r15 ; Environment jmp .return .catch: ; Jumps here on error ; Value thrown in RSI ; push rsi call error_handler_pop pop rsi pop r15 ; Env pop r12 ; B (symbol to bind) pop r13 ; C (form to evaluate) ; Check if C is a value or pointer mov cl, BYTE [r13] and cl, content_mask cmp cl, content_pointer je .catch_C_pointer ; A value, so copy and return call alloc_cons mov [rax], BYTE cl ; Set type mov rbx, [r13 + Cons.car] mov [rax + Cons.car], rbx ; Set value jmp .return .catch_C_pointer: mov r11, rsi ; Value thrown in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov rsi, rax ; New environment in RSI mov rdi, r12 ; key (symbol) mov rcx, r11 ; value call env_set mov rdi, rsi ; Env in RDI (will be released) mov rsi, [r13 + Cons.car] ; Form to evaluate call incref_object ; will be released push r15 call eval pop r15 jmp .return .try_missing_catch: load_static try_missing_catch call raw_to_string mov rsi, rax jmp error_throw .catch_missing_symbol: load_static catch_missing_symbol call raw_to_string mov rsi, rax jmp error_throw .catch_missing_form: load_static catch_missing_form call raw_to_string mov rsi, rax jmp error_throw ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 call eval_ast ; List of evaluated forms in RAX pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;;; Called by eval ;;; Original AST in RSI. ;;; Returns new AST in RAX quasiquote: ;; 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 .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 cmp cl, content_pointer ; and it is a pointer, jne qq_foldr 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 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 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] 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], 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 ;; Tests if an AST in RSI is a list containing ;; a macro defined in the ENV in R15 ;; ;; Inputs: AST in RSI (not modified) ;; ENV in R15 (not modified) ;; ;; Returns: Sets ZF if macro call. If set (true), ;; then the macro object is in RAX ;; ;; Modifies: ;; RAX ;; RBX ;; RCX ;; RDX ;; R8 ;; R9 is_macro_call: ; Test if RSI is a list which contains a pointer mov al, BYTE [rsi] cmp al, (block_cons + container_list + content_pointer) jne .false ; Test if this is a symbol mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .false ; Look up symbol in Env push rsi push r15 mov rdi, rbx ; symbol in RDI mov rsi, r15 ; Environment in RSI call env_get pop r15 pop rsi jne .false ; Not in environment ; Object in RAX ; If this is not a macro then needs to be released mov dl, BYTE [rax] cmp dl, maltype_macro je .true ; Not a macro, so release mov r8, rsi mov rsi, rax call release_object mov rsi, r8 .false: lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ret .true: mov rbx, rax ; Returning Macro object lahf ; flags in AH or ah, 64 ; set zero flag sahf mov rax, rbx ret ;; Expands macro calls ;; ;; Input: AST in RSI (released and replaced) ;; Env in R15 (not modified) ;; ;; Result: New AST in RSI macroexpand: push r15 call is_macro_call jne .done mov r13, rsi mov rdi, rax ; Macro in RDI ; Check the rest of the args mov cl, BYTE [rsi + Cons.typecdr] cmp cl, content_pointer je .got_args ; No arguments. Create an empty list call alloc_cons mov [rax], BYTE maltype_empty_list mov rdx, rax mov rsi, rdx ; Arguments (empty list) call incref_object jmp .macro_call .got_args: mov rsi, [rsi + Cons.cdr] ; Rest of list call incref_object mov rdx, rsi ; Released .macro_call: ; Here have: ; RSI - Arguments ; RDI - Macro object ; RDX - List to release ; R15 - Environment ; R13 - AST ; Increment reference for Environment ; since this will be released by apply_fn xchg rsi, r15 call incref_object xchg rsi, r15 call apply_fn mov rsi, rax ; Result in RSI pop r15 jmp macroexpand .done: pop r15 ret ;; Read and eval read_eval: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval jmp eval ; This releases Env and Form/AST ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Check command-line arguments pop rax ; Number of arguments cmp rax, 1 ; Always have at least one, the path to executable jg run_script ; No extra arguments, so just set *ARGV* to an empty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov rcx, rax ; value (empty list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print push rsi print_str_mac error_string ; print 'Error: ' pop rsi mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt run_script: ; Called with number of command-line arguments in RAX mov r8, rax pop rbx ; executable dec r8 pop rsi ; Address of first arg call cstring_to_string ; string in RAX mov r9, rax ; get the rest of the args xor r10, r10 ; Zero dec r8 jz .no_args ; Got some arguments .arg_loop: ; Got an argument left. pop rsi ; Address of C string call cstring_to_string ; String in RAX mov r12, rax ;Make a Cons to point to the string call alloc_cons ; in RAX mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r12 test r10, r10 jnz .append ; R10 zero, so first arg mov r10, rax ; Head of list mov r11, rax ; Tail of list jmp .next .append: ; R10 not zero, so append to list tail mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer mov r11, rax .next: dec r8 jnz .arg_loop jmp .got_args .no_args: ; No arguments. Create an emoty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov r10, rax .got_args: push r9 ; File name string mov rcx, r10 ; value (list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set mov rsi, run_script_string ; load-file function mov edx, run_script_string.len call raw_to_string ; String in RAX mov rsi, rax pop rdx ; File name string call string_append_string mov cl, 34 ; " call string_append_char mov cl, ')' call string_append_char ; closing brace ; Read-Eval "(load-file )" call read_eval jmp quit ================================================ FILE: impls/nasm/stepA_mal.asm ================================================ ;; ;; nasm -felf64 stepA_mal.asm && ld stepA_mal.o && ./a.out ;; ;; Calling convention: Address of input is in RSI ;; Address of return value is in RAX ;; global _start %include "types.asm" ; Data types, memory %include "env.asm" ; Environment type %include "system.asm" ; System calls %include "reader.asm" ; String -> Data structures %include "core.asm" ; Core functions %include "printer.asm" ; Data structures -> String %include "exceptions.asm" ; Error handling section .bss ;; Top-level (REPL) environment repl_env:resq 1 section .data ;; ------------------------------------------ ;; Fixed strings for printing static prompt_string, db 10,"user> " ; The string to print at the prompt static eval_debug_string, db "EVAL: " static eval_debug_cr, db 10 static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" static def_missing_arg_string, db "missing argument to def!",10 static def_expecting_symbol_string, db "expecting symbol as first argument to def!",10 static defmacro_expecting_function_string, db "defmacro expects function",10 static let_missing_bindings_string, db "let* missing bindings",10 static let_bindings_list_string, db "let* expected a list or vector of bindings",10 static let_bind_symbol_string, db "let* expected a symbol in bindings list",10 static let_bind_value_string, db "let* missing value in bindings list",10 static let_missing_body_string, db "let* missing body",10 static eval_list_not_function, db "list does not begin with a function",10 static if_missing_condition_string, db "missing condition in if expression",10 static try_missing_catch, db "try* missing catch*" static catch_missing_symbol, db "catch* missing symbol" static catch_missing_form, db "catch* missing form" ;; Symbols used for comparison static_symbol debug_eval, 'DEBUG-EVAL' static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol defmacro_symbol, 'defmacro!' static_symbol try_symbol, 'try*' static_symbol catch_symbol, 'catch*' static_symbol argv_symbol, '*ARGV*' static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' 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 \ (def! not (fn* (a) (if a false true))) \ (def! load-file (fn* (f) (eval (read-string (str ",34,"(do",34," (slurp f) ",34,10,"nil)",34," ))))) \ (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ",34,"odd number of forms to cond",34,")) (cons 'cond (rest (rest xs))))))) \ (def! *host-language* ",34,"nasm",34,")\ (def! conj nil)\ )" ;; Command to run, appending the name of the script to run static run_script_string, db "(load-file ",34 ;; Command to run at start of REPL 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 ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment ;; Returns: Result in RAX ;; Note: Both the form and environment will have their reference count ;; reduced by one (released). This is for tail call optimisation (Env), ;; quasiquote and macroexpand (AST) ;; eval: push rdi ; save environment mov r15, rsi ; save form mov rsi, rdi ; look for DEBUG-EVAL in environment mov rdi, debug_eval call env_get jne .debug_eval_finished mov bl, BYTE [rax] ; Get type of result mov cl, bl and cl, content_mask cmp cl, content_pointer je .debug_eval_release_pointer cmp bl, maltype_nil je .debug_eval_finished cmp bl, maltype_false je .debug_eval_finished print_str_mac eval_debug_string ; -> rsi, rdx -> mov rdi, 1 mov rsi, r15 ; ast call pr_str ; rdi, rsi -> rcx, r8, r12, r13, r14 -> rax mov rsi, rax call print_string ; rsi -> -> call release_array ; rsi -> [rsi], rax, rbx -> print_str_mac eval_debug_cr ; -> rsi, rdx -> jmp .debug_eval_finished .debug_eval_release_pointer: mov rsi, rax call release_object .debug_eval_finished: mov rsi, r15 ; restore form pop rdi ; restore environment mov r15, rdi ; Save Env in r15 push rsi ; AST pushed, must be popped before return ; Check the type mov al, BYTE [rsi] ; Check if this is a list mov ah, al and ah, container_mask cmp ah, container_list je .list cmp ah, container_map je .map cmp ah, container_vector je .vector ; Not a list, map or vector cmp ah, container_symbol je .symbol ; Not a symbol, list, map or vector call incref_object ; Increment reference count mov rax, rsi jmp .return .symbol: ; Check if first character of symbol is ':' mov al, BYTE [rsi + Array.data] cmp al, ':' je .keyword ; look in environment push rsi xchg rsi, rdi ; symbol is the key in rdi ; Environment in rsi call env_get pop rsi je .done ; result in RAX ; Not found, throw an error mov r11, rsi ; Symbol in R11 call string_new mov rsi, rax ; New string in RSI mov cl, 39 ; quote ' call string_append_char mov rdx, r11 ; symbol call string_append_string mov cl, 39 call string_append_char mov r11, rsi mov rsi, not_found_string mov edx, not_found_string.len call raw_to_string ; ' not found' mov r12, rax mov rdx, rax mov rsi, r11 call string_append_string mov r11, rsi mov rsi, r12 call release_array mov rsi, r11 jmp error_throw ; ------------------------------ .keyword: ; Just return keywords unaltered call incref_object mov rax, rsi jmp .return ; ------------------------------ .list_map_eval: ;; Some code is duplicated for the first element because ;; the iteration must stop if its evaluation products a macro, ;; else a new list must be constructed. ; Evaluate first element of the list mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer_first ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append_first .list_pointer_first: ; List element is a pointer to something push rsi push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] ;; If the evaluated first element is a macro, exit the loop. cmp bl, maltype_macro je macroexpand mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value_first ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append_first .list_eval_value_first: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append_first .list_append_first: ; In RAX ; r8 contains the head of the constructed list ; append to r9 mov r8, rax mov r9, rax .list_loop: ; Evaluate each element of the remaining list ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .list_done ; finished list mov rsi, [rsi + Cons.cdr] ; next in list mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .list_pointer ; A value in RSI, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_list) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .list_append .list_pointer: ; List element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rdi, [rsi + Cons.car] ; Get the address mov rsi, r15 call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call incref_object ; AST increment refs call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .list_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_list + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .list_append .list_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_list) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi ; Fall through to .list_append .list_append: ; In RAX ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .list_loop .list_done: mov rax, r8 ; Return the list jmp eval.return_from_list_map_eval ; --------------------- .map: ; Create a new map, evaluating all the values ; Check if the map is empty cmp al, maltype_empty_map jne .map_not_empty ; map empty. Just return it call incref_object mov rax, rsi jmp .return .map_not_empty: mov r10, rsi ; input in R10 xor r12, r12 ; New map in r12 ; Now loop through each key-value pair ; NOTE: This method relies on the implementation ; of map as a list .map_loop: ; Copy the key call alloc_cons ; New Cons in RAX mov bl, [r10 + Cons.typecar] ; Type in BL mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] ; Value in RCX mov [rax + Cons.car], rcx ; Check the type of the key and bl, content_mask cmp bl, content_pointer jne .map_got_key ; a value ; a pointer, so increment reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .map_got_key: cmp r12,0 jne .append_key ; First key mov r12, rax mov r13, rax jmp .map_value .append_key: ; Appending to previous value in r13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax .map_value: ; Check that we have a value mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_error_missing_value mov r10, [r10 + Cons.cdr] ; Now got value in r10 ; Check the type of the value mov bl, [r10 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .map_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r10 + Cons.typecar] mov [rax + Cons.typecar], bl mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx jmp .map_got_value .map_value_pointer: ; A pointer, so need to evaluate push r10 ; Input push r12 ; start of result push r13 ; Current head of result push r15 ; Env mov rsi, [r10 + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r13 pop r12 pop r10 ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) jne .map_eval_pointer ; A value, so just change the type to a map and bl, content_mask add bl, (block_cons + container_map) mov [rax], BYTE bl jmp .map_got_value .map_eval_pointer: ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_map + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx .map_got_value: ; Append RAX to list in R13 mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax mov r13, rax ; Check if there's another key mov al, BYTE [r10 + Cons.typecdr] cmp al, content_pointer jne .map_done ; finished map mov r10, [r10 + Cons.cdr] ; next in map jmp .map_loop .map_done: mov rax, r12 jmp .return .map_error_missing_value: mov rax, r12 jmp .return ; ------------------------------ .vector: ; Evaluate each element of the vector ; xor r8, r8 ; The vector to return ; r9 contains head of vector .vector_loop: mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask cmp ah, content_pointer je .vector_pointer ; A value, so copy call alloc_cons mov bl, BYTE [rsi] and bl, content_mask add bl, (block_cons + container_vector) mov [rax], BYTE bl ; set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; copy value ; Result in RAX jmp .vector_append .vector_pointer: ; Vector element is a pointer to something push rsi push r8 push r9 push r15 ; Env mov rsi, [rsi + Cons.car] ; Get the address mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi call incref_object call eval ; Evaluate it, result in rax pop r15 pop r9 pop r8 pop rsi ; Check the type it's evaluated to mov bl, BYTE [rax] mov bh, bl and bh, (block_mask + container_mask) cmp bh, (block_cons + container_value) je .vector_eval_value ; Not a value, so need a pointer to it push rax call alloc_cons mov [rax], BYTE (block_cons + container_vector + content_pointer) pop rbx ; Address to point to mov [rax + Cons.car], rbx jmp .vector_append .vector_eval_value: ; Got value in RAX, so copy push rax call alloc_cons ; Copy in RAX pop rbx ; Value to copy in RBX mov cl, BYTE [rbx] and cl, content_mask or cl, (block_cons + container_vector) mov [rax], BYTE cl ; set type mov rcx, [rbx + Cons.car] mov [rax + Cons.car], rcx ; copy value ; Release the value in RBX push rsi push rax mov rsi, rbx call release_cons pop rax pop rsi .vector_append: ; In RAX cmp r8, 0 ; Check if this is the first je .vector_first ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax jmp .vector_next .vector_first: mov r8, rax mov r9, rax ; fall through to .vector_next .vector_next: ; Check if there's another mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .vector_done ; finished vector mov rsi, [rsi + Cons.cdr] ; next in vector jmp .vector_loop .vector_done: mov rax, r8 ; Return the vector jmp .return ; --------------------- .done: jmp .return ; Releases Env ;; Comparison of symbols for eval function ;; Compares the symbol in RSI with specified symbol ;; Preserves RSI and RBX ;; Modifies RDI %macro eval_cmp_symbol 1 push rsi push rbx mov rsi, rbx mov rdi, %1 call compare_char_array pop rbx pop rsi test rax, rax ; ZF set if rax = 0 (equal) %endmacro ; -------------------- .list: ; A list ; Check if ; the first element is a symbol cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged and al, content_mask cmp al, content_pointer jne .list_eval mov rbx, [rsi + Cons.car] mov al, BYTE [rbx] cmp al, maltype_symbol jne .list_eval ; Is a symbol, address in RBX ; Compare against special form symbols eval_cmp_symbol def_symbol ; def! je .def_symbol eval_cmp_symbol let_symbol ; let* je .let_symbol eval_cmp_symbol do_symbol ; do je .do_symbol eval_cmp_symbol if_symbol ; if je .if_symbol eval_cmp_symbol fn_symbol ; fn je .fn_symbol eval_cmp_symbol quote_symbol ; quote je .quote_symbol eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol eval_cmp_symbol defmacro_symbol ; defmacro! je .defmacro_symbol eval_cmp_symbol try_symbol ; try* je .try_symbol ; Unrecognised jmp .list_eval ; ----------------------------- .defmacro_symbol: mov r9, 1 jmp .def_common .def_symbol: xor r9, r9 ; Set R9 to 0 .def_common: ; Define a new symbol in current environment ; If R9 is set to 1 then defmacro ; Next item should be a symbol mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Now should have a symbol mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer jne .def_error_expecting_symbol mov r8, [rsi + Cons.car] ; Symbol (?) mov al, BYTE [r8] cmp al, maltype_symbol jne .def_error_expecting_symbol ; R8 now contains a symbol ; expecting a value or pointer next mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .def_error_missing_arg mov rsi, [rsi + Cons.cdr] ; Check if this is a pointer mov al, BYTE [rsi] mov ah, al and ah, content_mask cmp ah, content_pointer je .def_pointer ; A value, so copy ; Test if this is defmacro! test r9, r9 jnz .defmacro_not_function push rax call alloc_cons pop rbx ; BL now contains type and bl, content_mask add bl, (block_cons + container_value) mov [rax], BYTE bl mov rcx, [rsi + Cons.car] mov [rax + Cons.car], rcx mov rsi, rax jmp .def_got_value .def_pointer: ; A pointer, so evaluate ; This may throw an error, so define a handler push r8 ; the symbol push r15 ; Env push r9 mov rsi, [rsi + Cons.car] ; Pointer mov rdi, r15 xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call incref_object ; AST increment refs call eval mov rsi, rax pop r9 ; If this is defmacro, and the object in RSI is a function, ; then change to a macro test r9, r9 jz .def_not_macro ; Not defmacro ; Check RSI mov al, BYTE [rsi] cmp al, maltype_function jne .defmacro_not_function ; Got a function, change to macro mov [rsi], BYTE maltype_macro .def_not_macro: pop r15 pop r8 .def_got_value: ; Symbol in R8, value in RSI mov rdi, r8 ; key (symbol) mov rcx, rsi ; Value mov rsi, r15 ; Environment call env_set mov rax, rcx jmp .return .def_error_missing_arg: mov rsi, def_missing_arg_string mov rdx, def_missing_arg_string.len jmp .def_handle_error .def_error_expecting_symbol: mov rsi, def_expecting_symbol_string mov rdx, def_expecting_symbol_string.len jmp .def_handle_error .defmacro_not_function: mov rsi, defmacro_expecting_function_string mov rdx, defmacro_expecting_function_string.len jmp .def_handle_error .def_handle_error: push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message xor rsi, rsi ; no object to throw jmp error_throw ; No return ; ----------------------------- .let_symbol: ; Create a new environment mov r11, rsi ; Let form in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov r14, rax ; New environment in R14 mov rsi, r15 call release_object ; Decrement R15 ref count ; Second element should be the bindings mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_bindings mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .let_error_bindings_list mov r12, [r11 + Cons.car] ; should be bindings list mov al, BYTE [r12] and al, (block_mask + container_mask) ; Can be either a list or vector cmp al, block_cons + container_list je .let_bind_loop cmp al, block_cons + container_vector je .let_bind_loop ; Not a list or vector jmp .let_error_bindings_list .let_bind_loop: ; R12 now contains a list with an even number of items ; The first should be a symbol, then a value to evaluate ; Get the symbol mov al, BYTE [r12] and al, content_mask cmp al, content_pointer jne .let_error_bind_symbol mov r13, [r12 + Cons.car] ; Symbol (?) mov al, BYTE [r13] cmp al, maltype_symbol jne .let_error_bind_symbol ; R13 now contains a symbol to bind ; The next item in the bindings list (R12) ; should be a value or expression to evaluate mov al, BYTE [r12 + Cons.typecdr] and al, content_mask cmp al, content_pointer jne .let_error_bind_value mov r12, [r12 + Cons.cdr] ; got value in R12 ; Check the type of the value mov bl, [r12 + Cons.typecar] ; Type in BL and bl, content_mask cmp bl, content_pointer je .let_value_pointer ; Not a pointer, so make a copy call alloc_cons mov bl, [r12 + Cons.typecar] and bl, content_mask ;or bl, (block_cons + container_value) ; 0 mov [rax + Cons.typecar], bl mov rcx, [r12 + Cons.car] mov [rax + Cons.car], rcx jmp .let_got_value .let_value_pointer: ; A pointer, so need to evaluate push r11 ; let* form list push r12 ; Position in bindings list push r13 ; symbol to bind push r14 ; new environment mov rsi, r14 call incref_object mov rdi, r14 mov rsi, [r12 + Cons.car] ; Get the address call incref_object ; Increment ref count of AST call eval ; Evaluate it, result in rax pop r14 pop r13 pop r12 pop r11 .let_got_value: mov rsi, r14 ; Env mov rdi, r13 ; key mov rcx, rax ; value call env_set ; Release the value mov rsi, rcx ; The value call release_object ; Check if there are more bindings mov al, BYTE [r12 + Cons.typecdr] cmp al, content_pointer jne .let_done_binding mov r12, [r12 + Cons.cdr] ; Next jmp .let_bind_loop .let_done_binding: ; Done bindings. ; Evaluate next item in let* form in new environment mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .let_error_missing_body mov r11, [r11 + Cons.cdr] ; Now contains value to evaluate ; Check type of the value mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer je .body_pointer ; Just a value, so copy call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl ; set type mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; copy value jmp .let_done .body_pointer: ; Evaluate using new environment mov rsi, [r11 + Cons.car] ; Object pointed to call incref_object ; will be released by eval mov r11, rsi ; save new AST pop rsi ; Old AST call release_object mov rsi, r11 ; New AST mov rdi, r14 ; New environment jmp eval ; Tail call ; Note: eval will release the new environment on return .let_done: ; Release the new environment push rax mov rsi, r14 call release_object pop rax ; Release the AST pop rsi push rax call release_object pop rax ret ; already released env .let_error_missing_bindings: mov rsi, let_missing_bindings_string mov rdx, let_missing_bindings_string.len jmp .let_handle_error .let_error_bindings_list: ; expected a list or vector, got something else mov rsi, let_bindings_list_string mov rdx, let_bindings_list_string.len jmp .let_handle_error .let_error_bind_symbol: ; expected a symbol, got something else mov rsi, let_bind_symbol_string mov rdx, let_bind_symbol_string.len jmp .let_handle_error .let_error_bind_value: ; Missing value in binding list mov rsi, let_bind_value_string mov rdx, let_bind_value_string.len jmp .let_handle_error .let_error_missing_body: ; Missing body to evaluate mov rsi, let_missing_body_string mov rdx, let_missing_body_string.len jmp .let_handle_error .let_handle_error: push r11 ; For printing later push rsi push rdx print_str_mac error_string ; print 'Error: ' pop rdx pop rsi call print_rawstring ; print message pop rsi ; let* form jmp error_throw ; No return ; ----------------------------- .do_symbol: mov r11, rsi ; do form in RSI ; Environment in R15 ; Check if there is a body mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .do_no_body ; error mov r11, [r11 + Cons.cdr] ; Body in R11 .do_symbol_loop: ; Need to test if this is the last form ; so we can handle tail call mov bl, BYTE [r11 + Cons.typecdr] cmp bl, content_pointer jne .do_body_last ; Last expression ; not the last expression ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_next ; A value, so skip ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference ; since eval will release Env mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increment ref count since eval will release mov rdi, r15 ; Env call eval ; Result in RAX ; Another form after this. ; Discard the result of the last eval mov rsi, rax call release_object pop r11 pop r15 .do_next: mov r11, [r11 + Cons.cdr] ; Next in list jmp .do_symbol_loop .do_body_last: ; The last form is in R11, which will be returned ; Check if this is a value or pointer mov al, BYTE [r11] and al, block_mask + content_mask cmp al, content_pointer jne .do_body_value_return jmp .do_body_expr_return .do_body_value_return: ; Got a value as last form (in R11). ; Copy and return push rax ; Type of value to return ; release Env mov rsi, r15 call release_object ; Allocate a Cons object to hold value call alloc_cons pop rbx ; type in BL mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx ; release the AST pop rsi mov r15, rax ; not modified by release call release_object mov rax, r15 ret .do_body_expr_return: ; An expression to evaluate as the last form ; Tail call optimise, jumping to eval ; Don't increment Env reference count mov rsi, [r11 + Cons.car] ; new AST form call incref_object ; This will be released by eval mov r11, rsi ; Save new AST pop rsi ; Remove old AST from stack call release_object mov rsi, r11 mov rdi, r15 ; Env jmp eval ; Tail call .do_no_body: ; No expressions to evaluate. Return nil mov rsi, r15 call release_object ; Release Env ; release the AST pop rsi call release_object call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ; ----------------------------- .if_symbol: mov r11, rsi ; if form in R11 ; Environment in R15 mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .if_no_condition mov r11, [r11 + Cons.cdr] ; Should be a condition ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .if_cond_value ; A pointer, so evaluate push r15 push r11 mov rsi, r15 call incref_object ; Increase Env reference mov rsi, [r11 + Cons.car] ; Form call incref_object ; Increase Form/AST ref count mov rdi, r15 ; Env call eval ; Result in RAX pop r11 pop r15 ; Get type of result mov bl, BYTE [rax] ; release value push rbx mov rsi, rax call release_object pop rbx ; Check type cmp bl, maltype_nil je .if_false cmp bl, maltype_false je .if_false jmp .if_true .if_cond_value: ; A value cmp al, content_nil je .if_false cmp al, content_false je .if_false jmp .if_true .if_false: ; Skip the next item mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil mov r11, [r11 + Cons.cdr] .if_true: ; Get the next item in the list and evaluate it mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .return_nil ; Nothing to return mov r11, [r11 + Cons.cdr] ; Check if value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer je .if_got_pointer .if_got_value: ; copy value in r11 call alloc_cons mov bl, BYTE [r11] and bl, content_mask mov [rax], BYTE bl mov rbx, [r11 + Cons.car] mov [rax + Cons.car], rbx jmp .return .if_got_pointer: mov rsi, [r11 + Cons.car] ; Form call incref_object ; Will be released by eval mov r11, rsi pop rsi call release_object ; Release old AST mov rsi, r11 ; New AST mov rdi, r15 ; Env jmp eval ; Tail call .if_no_condition: ; just (if) without a condition print_str_mac error_string print_str_mac if_missing_condition_string ; Release environment mov rsi, r15 call release_object xor rsi, rsi ; No object to throw jmp error_throw .return_nil: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil .return: ; Release environment mov rsi, r15 mov r15, rax ; Save RAX (return value) call release_object ; Release the AST pop rsi ; Pushed at start of eval call release_object mov rax, r15 ; return value ret ; ----------------------------- .fn_symbol: mov r11, rsi ; fn form in R11 ; Environment in R15 ; Get the binds and body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_empty mov r11, [r11 + Cons.cdr] mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_binds_not_list mov r12, [r11 + Cons.car] ; Should be binds list mov al, BYTE [r12] and al, (block_mask + container_mask) cmp al, (block_cons + container_list) je .fn_got_binds ; Can be list cmp al, (block_cons + container_vector) je .fn_got_binds ; or vector jmp .fn_binds_not_list .fn_got_binds: ; Next get the body of the function mov al, BYTE [r11 + Cons.typecdr] cmp al, content_pointer jne .fn_no_body mov r11, [r11 + Cons.cdr] ; Check value or pointer mov al, BYTE [r11] and al, content_mask cmp al, content_pointer jne .fn_is_value ; Body in r11 mov r11, [r11 + Cons.car] jmp .fn_got_body .fn_is_value: ; Body is just a value, no expression mov [r11], BYTE al ; Mark as value, not list .fn_got_body: ; Now put into function type ; Addr is "apply_fn", the address to call ; Env in R15 ; Binds in R12 ; Body in R11 call alloc_cons mov [rax], BYTE (block_cons + container_function + content_function) mov rbx, apply_fn mov [rax + Cons.car], rbx ; Address of apply function mov [rax + Cons.typecdr], BYTE content_pointer mov r13, rax ; Return list in R13 ; Meta call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax ; Append mov r14, rax ; Env call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r15 ; Environment mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax ; R14 contains last cons in list push rax mov rsi, r15 call incref_object pop rax ; Binds call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r12 ; Binds list mov [rax + Cons.typecdr], BYTE content_pointer mov [r14 + Cons.cdr], rax ; Append to list mov r14, rax push rax mov rsi, r12 call incref_object pop rax call alloc_cons mov [rax], BYTE (block_cons + container_function + content_pointer) mov [rax + Cons.car], r11 ; Body of function mov [r14 + Cons.cdr], rax mov rsi, r11 call incref_object mov rax, r13 jmp .return .fn_empty: .fn_binds_not_list: .fn_no_body: call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil jmp .return ; ----------------------------- .quote_symbol: ; Just return the arguments in rsi cdr mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quote empty, so return nil mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] call incref_object mov rax, rsi jmp .return ; ----------------------------- .quasiquote_symbol: ; call quasiquote function with first argument mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; quasiquote empty, so return nil mov r11, rsi ; Save original AST in R11 mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .quasiquote_pointer ; RSI contains a value. Remove the list container mov [rsi + Cons.typecar], BYTE al call incref_object mov rax, rsi jmp .return .quasiquote_pointer: ; RSI contains a pointer, so get the object pointed to mov rsi, [rsi + Cons.car] push r15 ; Environment ; Original AST already on stack call quasiquote ; New AST in RAX pop rdi ; Environment pop rsi ; Old AST mov r11, rax ; New AST call release_object ; Release old AST mov rsi, r11 ; New AST in RSI jmp eval ; Tail call ; ----------------------------- .try_symbol: ; Should have the form ; ; (try* A (catch* B C)) ; ; where B is a symbol, A and C are forms to evaluate ; Check first arg A mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .return_nil ; No argument mov rsi, [rsi + Cons.cdr] ; Check if this is a value or pointer mov al, BYTE [rsi + Cons.typecar] and al, content_mask cmp al, content_pointer je .try_pointer ; RSI contains a value. Copy and return mov cl, al call alloc_cons mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx jmp .return .try_pointer: mov r8, [rsi + Cons.car] ; form A in R8 ; Check second arg B mov al, BYTE [rsi + Cons.typecdr] ; If nil (catchless try) cmp al, content_nil je .catchless_try cmp al, content_pointer jne .try_missing_catch mov rsi, [rsi + Cons.cdr] mov al, BYTE [rsi] and al, content_mask cmp al, content_pointer jne .try_missing_catch mov r9, [rsi + Cons.car] ; (catch* B C) in R9 mov al, BYTE [r9] cmp al, (container_list + content_pointer) jne .try_missing_catch mov rsi, [r9 + Cons.car] ; Should be catch* symbol mov al, BYTE [rsi] cmp al, maltype_symbol jne .try_missing_catch mov rdi, catch_symbol call compare_char_array test rax, rax ; ZF set if rax = 0 (equal) jnz .try_missing_catch ; Check that B is a symbol mov al, [r9 + Cons.typecdr] cmp al, content_pointer jne .catch_missing_symbol mov r9, [r9 + Cons.cdr] ; (B C) in R9 mov al, BYTE [r9] and al, content_mask cmp al, content_pointer jne .catch_missing_symbol mov r10, [r9 + Cons.car] ; B in R10 mov al, BYTE [r10] cmp al, maltype_symbol jne .catch_missing_symbol mov al, BYTE [r9 + Cons.typecdr] cmp al, content_pointer jne .catch_missing_form mov r9, [r9 + Cons.cdr] ; C in R9 ; Now have extracted from (try* A (catch* B C)) ; A in R8 ; B in R10 ; C in R9 push R9 push R10 push r15 ; Env ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the form in R8 mov rsi, r15 call incref_object ; Env released by eval mov rdi, r15 ; Env in RDI mov rsi, r8 ; The form to evaluate (A) call incref_object ; AST released by eval call eval mov r8, rax ; Result in R8 pop r15 ; Environment ; Discard B and C ;add rsi, 8 ; pop R10 and R9 pop r10 pop r9 ; Remove error handler call error_handler_pop mov rax, r8 jmp .return .catchless_try: ;; Evaluate the form in R8 push r15 ; Environment mov rsi, r15 call incref_object ; Env released by eval mov rdi, r15 ; Env in RDI mov rsi, r8 ; The form to evaluate (A) call incref_object ; AST released by eval call eval ; Result in RAX pop r15 ; Environment jmp .return .catch: ; Jumps here on error ; Value thrown in RSI ; push rsi call error_handler_pop pop rsi pop r15 ; Env pop r12 ; B (symbol to bind) pop r13 ; C (form to evaluate) ; Check if C is a value or pointer mov cl, BYTE [r13] and cl, content_mask cmp cl, content_pointer je .catch_C_pointer ; A value, so copy and return call alloc_cons mov [rax], BYTE cl ; Set type mov rbx, [r13 + Cons.car] mov [rax + Cons.car], rbx ; Set value jmp .return .catch_C_pointer: mov r11, rsi ; Value thrown in R11 mov rsi, r15 ; Outer env call env_new ; Increments R15's ref count mov rsi, rax ; New environment in RSI mov rdi, r12 ; key (symbol) mov rcx, r11 ; value call env_set mov rdi, rsi ; Env in RDI (will be released) mov rsi, [r13 + Cons.car] ; Form to evaluate call incref_object ; will be released push r15 call eval pop r15 jmp .return .try_missing_catch: load_static try_missing_catch call raw_to_string mov rsi, rax jmp error_throw .catch_missing_symbol: load_static catch_missing_symbol call raw_to_string mov rsi, rax jmp error_throw .catch_missing_form: load_static catch_missing_form call raw_to_string mov rsi, rax jmp error_throw ; ----------------------------- .list_eval: push rsi mov rdi, r15 ; Environment push r15 jmp .list_map_eval ; List of evaluated forms in RAX .return_from_list_map_eval pop r15 pop rsi .list_exec: ; This point can be called to run a function ; used by swap! ; ; Inputs: RAX - List with function as first element ; NOTE: This list is released ; ; Check that the first element of the return is a function mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .list_not_function mov rbx, [rax + Cons.car] ; Get the address mov cl, BYTE [rbx] cmp cl, maltype_function jne .list_not_function ; Check the rest of the args mov cl, BYTE [rax + Cons.typecdr] cmp cl, content_pointer je .list_got_args ; No arguments push rbx ; Function object push rax ; List with function first ; Create an empty list for the arguments call alloc_cons mov [rax], BYTE maltype_empty_list mov rsi, rax ; Argument list into RSI pop rax ; list, function first ;; Put new empty list onto end of original list mov [rax + Cons.typecdr], BYTE content_pointer mov [rax + Cons.cdr], rsi pop rbx jmp .list_function_call .list_got_args: mov rsi, [rax + Cons.cdr] ; Rest of list .list_function_call: ; Call the function with the rest of the list in RSI mov rdx, rax ; List to release mov rdi, rbx ; Function object in RDI mov rbx, [rbx + Cons.car] ; Call function cmp rbx, apply_fn je apply_fn_jmp ; Jump to user function apply ; A built-in function, so call (no recursion) push rax push r15 call rbx ; Result in rax pop r15 pop rsi ; eval'ed list push rax call release_cons pop rax jmp .return ; Releases Env .list_not_function: ; Not a function. Probably an error push rsi mov rsi, rax call release_object print_str_mac error_string print_str_mac eval_list_not_function pop rsi jmp error_throw .empty_list: mov rax, rsi jmp .return ;; Applies a user-defined function ;; ;; Input: RSI - Arguments to bind ;; RDI - Function object ;; RDX - list to release after binding ;; R15 - Env (will be released) ;; R13 - AST released before return ;; ;; ;; Output: Result in RAX ;; ;; This is jumped to from eval, so if it returns ;; then it will return to the caller of eval, not to eval apply_fn_jmp: ; This is jumped to from eval with AST on the stack pop r13 apply_fn: push rsi ; Extract values from the list in RDI mov rax, [rdi + Cons.cdr] mov rax, [rax + Cons.cdr] ; Meta (don't need) mov rsi, [rax + Cons.car] ; Env mov rax, [rax + Cons.cdr] mov rdi, [rax + Cons.car] ; Binds mov rax, [rax + Cons.cdr] mov rax, [rax + Cons.car] ; Body pop rcx ; Exprs ; Check the type of the body mov bl, BYTE [rax] and bl, block_mask + container_mask jnz .bind ; Just a value (in RAX). No eval needed mov r14, rax ; Save return value in R14 mov rsi, rax call incref_object ; Release the list passed in RDX mov rsi, rdx call release_object ; Release the environment mov rsi, r15 call release_object ; Release the AST mov rsi, r13 call release_object mov rax, r14 ret .bind: ; Create a new environment, binding arguments push rax ; Body mov r14, r13 ; Old AST. R13 used by env_new_bind push rdx call env_new_bind pop rdx mov rdi, rax ; New environment in RDI ; Note: Need to increment the reference count ; of the function body before releasing anything, ; since if the function was defined in-place (lambda) ; then the body may be released early pop rsi ; Body call incref_object ; Will be released by eval mov r8, rsi ; Body in R8 ; Release the list passed in RDX mov rsi, rdx call release_cons ; Release the environment mov rsi, r15 call release_object ; Release the old AST mov rsi, r14 call release_object mov rsi, r8 ; Body jmp eval ; Tail call ; The new environment (in RDI) will be released by eval ;;; Called by eval ;;; Original AST in RSI. ;;; Returns new AST in RAX quasiquote: ;; 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 .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 cmp cl, content_pointer ; and it is a pointer, jne qq_foldr 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 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 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] 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], 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 ;; Expands macro calls ;; ;; A part of eval, written here for historical reasons. ;; RSI: AST, a non-empty list (released and replaced) ;; RAX: evaluated first element of AST, a macro ;; R15: env macroexpand: mov r13, rsi mov rdi, rax ; Macro in RDI ; Check the rest of the args mov cl, BYTE [rsi + Cons.typecdr] cmp cl, content_pointer je .got_args ; No arguments. Create an empty list call alloc_cons mov [rax], BYTE maltype_empty_list mov rdx, rax mov rsi, rdx ; Arguments (empty list) call incref_object jmp .macro_call .got_args: mov rsi, [rsi + Cons.cdr] ; Rest of list call incref_object mov rdx, rsi ; Released .macro_call: ; Here have: ; RSI - Arguments ; RDI - Macro object ; RDX - List to release ; R15 - Environment ; R13 - AST ; Increment reference for Environment ; since this will be released by apply_fn xchg rsi, r15 call incref_object xchg rsi, r15 call apply_fn mov rsi, rax ; Result in RSI pop rdi ; env pushed as r15 by .list_eval pop rax ; (ignored) ast pushed as r15 by .list_eval pop rax ; (ignored) ast pushed as rsi by eval jmp eval ;; Read and eval read_eval: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval jmp eval ; This releases Env and Form/AST ;; Read-Eval-Print in sequence ;; ;; Input string in RSI rep_seq: ; ------------- ; Read call read_str ; ------------- ; Eval mov rsi, rax ; Form to evaluate mov rdi, [repl_env] ; Environment xchg rsi, rdi call incref_object ; Environment increment refs xchg rsi, rdi ; since it will be decremented by eval call eval ; This releases Env and Form/AST push rax ; Save result of eval ; ------------- ; Print mov rsi, rax ; Output of eval into input of print mov rdi, 1 ; print readably call pr_str ; String in RAX mov r8, rax ; Save output pop rsi ; Result from eval call release_object mov rax, r8 ret _start: ; Create and print the core environment call core_environment ; Environment in RAX mov [repl_env], rax ; store in memory ; Set the error handler mov rsi, rsp ; Stack pointer mov rdi, .catch ; Address to jump to xor rcx, rcx ; No data call error_handler_push ; Evaluate the startup string mov rsi, mal_startup_string mov edx, mal_startup_string.len call raw_to_string ; String in RAX push rax mov rsi, rax call read_str ; AST in RAX pop rsi ; string push rax ; AST call release_array ; string pop rdi ; AST in RDI mov rsi, [repl_env] ; Environment in RSI call incref_object ; Environment increment refs xchg rsi, rdi ; Env in RDI, AST in RSI call eval mov rsi, rax call release_object ; Return from eval ; ----------------------------- ; Check command-line arguments pop rax ; Number of arguments cmp rax, 1 ; Always have at least one, the path to executable jg run_script ; No extra arguments, so just set *ARGV* to an empty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov rcx, rax ; value (empty list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set ; ----------------------------- ; Header load_static mal_startup_header call raw_to_string push rax mov rsi, rax call read_eval ; no print ('nil') mov rsi, rax call release_object ; Release result of eval ; Release the input string pop rsi call release_array ; ----------------------------- ; Main loop .mainLoop: ; print the prompt print_str_mac prompt_string call read_line ; Check if we have a zero-length string cmp DWORD [rax+Array.length], 0 je .mainLoopEnd push rax ; Save address of the string mov rsi, rax call rep_seq ; Read-Eval-Print push rax ; Save returned string mov rsi, rax ; Put into input of print_string call print_string ; Release string from rep_seq pop rsi call release_array ; Release the input string pop rsi call release_array jmp .mainLoop .mainLoopEnd: jmp quit .catch: ; Jumps here on error ; Check if an object was thrown cmp rsi, 0 je .catch_done_print ; nothing to print push rsi print_str_mac error_string ; print 'Error: ' pop rsi mov rdi, 1 call pr_str mov rsi, rax call print_string .catch_done_print: jmp .mainLoop ; Go back to the prompt run_script: ; Called with number of command-line arguments in RAX mov r8, rax pop rbx ; executable dec r8 pop rsi ; Address of first arg call cstring_to_string ; string in RAX mov r9, rax ; get the rest of the args xor r10, r10 ; Zero dec r8 jz .no_args ; Got some arguments .arg_loop: ; Got an argument left. pop rsi ; Address of C string call cstring_to_string ; String in RAX mov r12, rax ;Make a Cons to point to the string call alloc_cons ; in RAX mov [rax], BYTE (block_cons + container_list + content_pointer) mov [rax + Cons.car], r12 test r10, r10 jnz .append ; R10 zero, so first arg mov r10, rax ; Head of list mov r11, rax ; Tail of list jmp .next .append: ; R10 not zero, so append to list tail mov [r11 + Cons.cdr], rax mov [r11 + Cons.typecdr], BYTE content_pointer mov r11, rax .next: dec r8 jnz .arg_loop jmp .got_args .no_args: ; No arguments. Create an emoty list call alloc_cons ; in RAX mov [rax], BYTE maltype_empty_list mov r10, rax .got_args: push r9 ; File name string mov rcx, r10 ; value (list) mov rdi, argv_symbol ; symbol (*ARGV*) mov rsi, [repl_env] ; environment call env_set mov rsi, run_script_string ; load-file function mov edx, run_script_string.len call raw_to_string ; String in RAX mov rsi, rax pop rdx ; File name string call string_append_string mov cl, 34 ; " call string_append_char mov cl, ')' call string_append_char ; closing brace ; Read-Eval "(load-file )" call read_eval jmp quit ================================================ FILE: impls/nasm/system.asm ================================================ ;;; System call functions ;;; ;;; This file contains system-specific functions, ;;; which use calls to the operating system (Linux) section .data static error_open_file_string, db "Error opening file " static error_read_file_string, db "Error reading file " section .bss timespec: RESQ 2 section .text ;; ------------------------------------------- ;; Prints a raw string to stdout ;; String address in rsi, string length in rdx print_rawstring: push rax push rdi ; write(1, string, length) mov rax, 1 ; system call 1 is write mov rdi, 1 ; file handle 1 is stdout syscall pop rdi pop rax ret ;------------------------------------------ ; void exit() ; Exit program and restore resources quit: mov eax, 60 ; system call 60 is exit xor rdi, rdi ; exit code 0 syscall ; invoke operating system to exit quit_error: mov eax, 60 ; system call 60 is exit mov rdi, 1 ; exit code 1 syscall ;; Read a line from stdin ;; Gets a new string array, fills it until a newline or EOF is reached ;; Returns pointer to string in RAX read_line: ; Get an array to put the string into ; Address in rax call alloc_array ; Mark it as a character array (string) mov BYTE [rax + Array.type], maltype_string push rax ; Save pointer to string ; Read character by character until either newline or end of input mov ebx, 0 ; Count how many characters read mov rsi, rax add rsi, Array.data ; Point to the data .readLoop: mov rax, 0 ; sys_read mov rdi, 0 ; stdin mov rdx, 1 ; count syscall ; Characters read in RAX cmp rax, 0 ; end loop if read <= 0 jle .readLoopEnd mov cl, BYTE [rsi] cmp cl, 10 ; End if we read a newline je .readLoopEnd cmp cl, 8 ; Backspace? je .handleBackspace cmp cl, 31 ; Below space jle .readLoop ; Ignore, keep going cmp cl, 127 ; DEL or above jge .readLoop ; Ignore, keep going inc ebx inc rsi ; Move to next point in the array jmp .readLoop ; Get another character .handleBackspace: ; Check if we've read any characters cmp ebx, 0 je .readLoop ; If not, carry on the loop ; Characters have been read. Remove one dec ebx dec rsi jmp .readLoop .readLoopEnd: pop rax ; Restore pointer to string mov DWORD [rax + Array.length], ebx ; Set string length ret ;; Reads a file into a string ;; ;; Input: RSI - File name string (char Array) ;; ;; Returns: string in RAX ;; ;; Pieces from https://stackoverflow.com/questions/20133698/how-to-read-from-and-write-to-files-using-nasm-for-x86-64bit read_file: mov rdi, rsi ; Filename ; Need to add null terminator mov eax, DWORD [rdi + Array.length] cmp eax, (array_chunk_len * 8) je .error_filename ; File name too long ; Insert a null terminator add rax, rdi mov [rax + Array.data], BYTE 0 ; Open the file mov rax, 2 add rdi, Array.data; filename in RDI xor rsi, rsi ; O_RDONLY in RSI syscall ; Check for error (return -1) cmp eax, 0 jl .error_open mov rdi, rax ; File handle in RDI ; Create a string push rdi call string_new ; In RAX pop rdi mov r9, rax ; Current Array push rax ; This is popped in .done .loop: ; Read next chunk push r9 mov rsi, r9 add rsi, Array.data ; address mov rax, 0 ; sys_read ; file handle in RDI mov rdx, (array_chunk_len * 8) ; count syscall pop r9 ; Characters read in RAX cmp rax, 0 jl .error_read cmp rax, (array_chunk_len * 8) jg .error_read mov [r9 + Array.length], DWORD eax jl .done ; May still be more to read. ; Allocate another call string_new mov [r9 + Array.next], rax mov r9, rax jmp .loop .done: ; Close the file mov rax, 3 ;rdi = file handle syscall pop rax ret .error_filename: .error_open: ; File name in RDI sub rdi, Array.data ; Make the error message mov rsi, error_open_file_string mov edx, error_open_file_string.len call raw_to_string mov rsi, rax mov cl, 39 ; (') call string_append_char mov rdx, rdi ; file name call string_append_string mov cl, 39 call string_append_char ; Error message in RSI jmp error_throw .error_read: mov rsi, error_read_file_string mov edx, error_read_file_string.len call raw_to_string mov rsi, rax jmp error_throw ;; Returns the time in ms in RAX clock_time_ms: mov rax, 228 ; clock_gettime mov rdi, 0 ; CLOCK_REALTIME mov rsi, timespec syscall mov rax, [timespec + 8] ; nanoseconds cqo ; Sign extend RAX into RDX mov rcx, 1000000 idiv rcx ; Divide RAX by 1e6 -> ms mov rbx, rax ; -> ms in RBX mov rax, [timespec] ; Seconds mov rcx, 1000 imul rcx ; Convert to ms add rax, rbx ; Add RBX ret ================================================ FILE: impls/nasm/types.asm ================================================ ;; Data structures ;; =============== ;; ;; Memory management is done by having two fixed-size datatypes, ;; Cons and Array. ;; ;; Both Cons and Array have the following in common: ;; a type field at the start, a reference count, followed by data ;; [ type (8) | (8) | refs (16) | data ] ;; ;; ;; Type bit fields ;; --------------- ;; ;; The 8-bit type fields describe the Block, Container and Content type. ;; ;; The Block type is used for memory management, to determine the kind of memory block ;; The Container type indicates the data structure that the Cons or Array block is being used to represent ;; The Content type indicates the raw type of the data in the content ;; ;; Block type [1 bit]: ;; 0 0 - Cons memory block ;; 1 1 - Array memory block ;; ;; Container type [3 bits]: ;; 0 0 - Value (single boxed value for Cons blocks, multiple values for Array blocks). ;; 2 1 - List (value followed by pointer). Only for Cons blocks ;; 4 2 - Symbol (special char array). Only for Array blocks ;; 6 3 - Keyword. Only for Array blocks ;; 8 4 - Map ;; 10 5 - Function ;; 12 6 - Atom ;; 14 7 - Vector ;; ;; Content type [4 bits]: ;; 0 0 - Nil ;; 16 1 - True ;; 32 2 - Char ;; 48 3 - Int ;; 64 4 - Float ;; 80 5 - Pointer (memory address) ;; 96 6 - Function (instruction address) ;; 112 7 - Empty (distinct from Nil) ;; 208 8 - False ;; 224 9 - Macro ;; ;; ;; These represent MAL data types as follows: ;; ;; MAL type Block Container Content ;; --------- | -------- | ---------- | --------- ;; integer Cons Value Int ;; symbol Array Symbol Char ;; list Cons List Any ;; vector Cons Vector Any ;; nil Cons Value Nil ;; true Cons Value True ;; false Cons Value False ;; string Array Value Char ;; keyword Array Keyword Char ;; hash-map Cons Map Alternate key, values ;; atom Cons Atom Pointer ;; %include "macros.mac" ;; Cons type. ;; Used to store either a single value with type information ;; or a pair of (value, Pointer or Nil) to represent a list STRUC Cons .typecar: RESB 1 ; Type information for car (8 bit) .typecdr: RESB 1 ; Type information for cdr (8 bits) .refcount: RESW 1 ; Number of references to this Cons (16 bit) .car: RESQ 1 ; First value (64 bit) .cdr: RESQ 1 ; Second value (64 bit) .size: ; Total size of struc ENDSTRUC %define array_chunk_len 32 ; Number of 64-bit values which can be stored in a single chunk STRUC Array .type: RESB 1 ; Type information (8 bits) .control: RESB 1 ; Control data (8 bits) .refcount: RESW 1 ; Number of references to this Array (16 bit) .length: RESD 1 ; Number of elements in this part of the array (32 bit) .next RESQ 1 ; Pointer to the next chunk (64 bit) .data: RESQ array_chunk_len ; Data storage .size: ; Total size of struc ENDSTRUC ;; Type information %define block_mask 1 ; LSB for block type %define container_mask 2 + 4 + 8 ; Next three bits for container type %define content_mask 16 + 32 + 64 + 128 ; Four bits for content type ;; Block types %define block_cons 0 ; Note: This must be zero %define block_array 1 ;; Container types %define container_value 0 ; Note: This must be zero %define container_list 2 %define container_symbol 4 %define container_keyword 6 %define container_map 8 %define container_function 10 %define container_atom 12 %define container_vector 14 ;; Content type %define content_nil 0 %define content_true 16 %define content_char 32 %define content_int 48 %define content_float 64 %define content_pointer 80 ; Memory pointer (to Cons or Array) %define content_function 96 ; Function pointer %define content_empty 112 %define content_false 208 %define content_macro 224 ;; Common combinations for MAL types %define maltype_integer (block_cons + container_value + content_int) %define maltype_string (block_array + container_value + content_char) %define maltype_symbol (block_array + container_symbol + content_char) %define maltype_nil (block_cons + container_value + content_nil) %define maltype_empty_list (block_cons + container_list + content_empty) %define maltype_empty_map (block_cons + container_map + content_empty) %define maltype_empty_vector (block_cons + container_vector + content_empty) %define maltype_function (block_cons + container_function + content_function) %define maltype_macro (block_cons + container_function + content_macro) %define maltype_true (block_cons + container_value + content_true) %define maltype_false (block_cons + container_value + content_false) %define maltype_atom (block_cons + container_atom + content_pointer) ;; ------------------------------------------ section .data ;; Fixed strings for printing static error_msg_print_string, db "Error in print string",10 static error_array_memory_limit, db "Error: Run out of memory for Array objects. Increase heap_array_limit.",10 static error_cons_memory_limit, db "Error: Run out of memory for Cons objects. Increase heap_cons_limit.",10 static error_cons_double_free, db "Error: double free error releasing Cons" static error_array_double_free, db "Error: double free error releasing Array" ;; ------------------------------------------ ;; Memory management ;; ;; For each object (Cons or Array), there is a block of memory (in BSS). ;; When an object is requested it is first taken from the free list ;; If the free list is empty (address 0) then the next object in the block ;; is used, and the heap_x_number counter is incremented. When an object ;; is free'd it is pushed onto the heap_x_free list. %define heap_cons_limit 5000 ; Number of cons objects which can be created heap_cons_next: dq heap_cons_store ; Address of next cons in memory heap_cons_free: dq 0 ; Address of start of free list %define heap_array_limit 2000 ; Number of array objects which can be created heap_array_next: dq heap_array_store heap_array_free: dq 0 section .bss ;; Reserve space to store Cons and Array objects heap_cons_store: resb heap_cons_limit * Cons.size .end: ; Address of end of the store heap_array_store: resb heap_array_limit * Array.size .end: section .text ;; ------------------------------------------ ;; Array alloc_array() ;; ;; Returns the address of an Array object in RAX ;; ;; Working registers: rbx alloc_array: ; Get the address of a free array mov rax, [heap_array_free] ; Address of the array ; Check if it's null cmp rax, 0 je .create_array mov rbx, [rax + Array.next] ; Get the address of the next array in the linked list mov [heap_array_free], rbx ; Put this address at the front of the list jmp .initialise_array .create_array: ; Get the address of the next Array mov rax, [heap_array_next] ; Check if we've reached the end cmp rax, heap_array_store.end je .out_of_memory mov rbx, rax add rbx, Array.size ; Address of the next array mov [heap_array_next], rbx ; for next time .initialise_array: ; Address of Array now in rax mov BYTE [rax + Array.type], block_array mov WORD [rax + Array.refcount], 1 ; Only one reference mov DWORD [rax + Array.length], 0 mov QWORD [rax + Array.next], 0 ; null next address ret .out_of_memory: mov rsi, error_array_memory_limit mov rdx, error_array_memory_limit.len call print_rawstring jmp quit_error ;; ------------------------------------------- ;; Decrements the reference count of the array in RSI ;; If the count reaches zero then push the array ;; onto the free list release_array: mov ax, WORD [rsi + Array.refcount] ; Check if reference count is already zero test ax,ax jz .double_free dec ax mov WORD [rsi + Array.refcount], ax jz .free ; If the count reaches zero then put on free list ret .free: ; Get the next field mov rbx, [rsi + Array.next] mov rax, [heap_array_free] ; Get the current head mov [rsi + Array.next], rax ; Put current head into the "next" field mov [heap_array_free], rsi ; Push Array onto free list cmp rbx, 0 jne .release_next ; If there is another array, then need to release it ret .release_next: ; release the next array mov rsi, rbx call release_array ret .double_free: ret load_static error_cons_double_free call raw_to_string mov rsi, rax jmp error_throw ;; ------------------------------------------ ;; Cons alloc_cons() ;; ;; Returns the address of a Cons object in RAX ;; ;; Modifies: ;; RBX alloc_cons: ; Get the address of a free cons mov rax, [heap_cons_free] ; Address of the cons ; Check if it's null cmp rax, 0 je .create_cons mov rbx, [rax + Cons.cdr] ; Get the address of the next cons in the linked list mov [heap_cons_free], rbx ; Put this address at the front of the list jmp .initialise_cons .create_cons: ; Get the address of the next Cons mov rax, [heap_cons_next] ; Check if we've reached the end cmp rax, heap_cons_store.end je .out_of_memory mov rbx, rax add rbx, Cons.size ; Address of the next cons mov [heap_cons_next], rbx ; for next time .initialise_cons: ; Address of Cons now in rax mov BYTE [rax + Cons.typecar], 0 mov BYTE [rax + Cons.typecdr], 0 mov WORD [rax + Cons.refcount], 1 ; Only one reference mov QWORD [rax + Cons.car], 0 mov QWORD [rax + Cons.cdr], 0 ret .out_of_memory: mov rsi, error_cons_memory_limit mov rdx, error_cons_memory_limit.len call print_rawstring jmp quit_error ;; ------------------------------------------- ;; Decrements the reference count of the cons in RSI ;; If the count reaches zero then push the cons ;; onto the free list ;; ;; Modifies registers: ;; RAX ;; RBX ;; RCX ;; release_cons: mov ax, WORD [rsi + Cons.refcount] ; Check if already released test ax,ax jz .double_free dec ax mov WORD [rsi + Cons.refcount], ax jz .free ; If the count reaches zero then put on free list ret .free: ; Get and push cdr onto stack mov rcx, [rsi + Cons.cdr] push rcx ; Content of CDR push rsi ; Original Cons object being released mov rax, [heap_cons_free] ; Get the current head mov [rsi + Cons.cdr], rax ; Put current head into the "cdr" field mov [heap_cons_free], rsi ; Push Cons onto free list ; Check if the CAR needs to be released mov al, BYTE [rsi+Cons.typecar] and al, content_mask ; Test content type cmp al, content_pointer jne .free_cdr ; Jump if CAR not pointer ; CAR is a pointer to either a Cons or Array ; Get the address stored in CAR mov rsi, [rsi + Cons.car] call release_object .free_cdr: pop rcx ; This was rsi, the original Cons pop rsi ; This was rcx, the original Cons.cdr ; Get the type from the original Cons mov al, BYTE [rcx+Cons.typecdr] and al, content_mask ; Test content type cmp al, content_pointer jne .done call release_object .done: ret .double_free: ; Already released ret load_static error_cons_double_free call raw_to_string mov rsi, rax jmp error_throw ;; Releases either a Cons or Array ;; Address of object in RSI ;; ;; May modify: ;; RAX ;; RBX ;; RCX ;; release_object: mov al, BYTE [rsi] ; Get first byte and al, block_mask ; Test block type cmp al, block_array ; Test if it's an array je release_array jmp release_cons ;; Increment reference count of Cons or Array ;; Address of object in RSI ;; ;; This code makes use of the fact that the reference ;; count is in the same place in Cons and Array types ;; ;; Modifies ;; RAX incref_object: mov ax, WORD [rsi + Cons.refcount] ; Same for Array inc ax ; Check for overflow? mov [rsi + Cons.refcount], WORD ax ret ;; ------------------------------------------- ;; Copying lists/vectors ;; This does a shallow copy, copying only the ;; top level of objects. Any objects pointed to are not copied ;; ;; Input: RSI - address of list/vector ;; ;; Returns: New list/vector in RAX, last Cons in RBX ;; ;; Modifies: ;; RBX ;; RCX ;; RDX ;; R8 ;; R9 ;; R10 ;; cons_seq_copy: push rsi ; Restored at the end mov r8, rsi ; Input in R8 xor r9, r9 ; Head of list in R9, start in R10 .loop: ; Check the type mov cl, BYTE [r8] mov ch, cl and ch, block_mask jnz .not_seq ; Not a Cons object call alloc_cons mov rdx, rax ; New Cons in RDX mov [rdx], BYTE cl ; Copy type in RCX mov rbx, [r8 + Cons.car] ; Value in RBX mov [rdx + Cons.car], rbx ; Copy value and cl, content_mask cmp cl, content_pointer jne .copied ; A pointer, so increment the reference count mov rsi, rbx call incref_object .copied: ; Check if this is the first test r9,r9 jnz .append ; First Cons mov r9, rdx mov r10, rdx ; Start of the list, will be returned jmp .next .append: ; Appending to last Cons mov [r9 + Cons.cdr], rdx mov [r9 + Cons.typecdr], BYTE content_pointer ; Replace mov r9, rdx .next: ; Check if there's another mov al, BYTE [r8 + Cons.typecdr] cmp al, content_pointer jne .done ; No more ; Got another mov r8, [r8 + Cons.cdr] jmp .loop .done: pop rsi ; Restore input mov rax, r10 ; Output list mov rbx, r9 ; Last Cons ret .not_seq: xor rsi,rsi jmp error_throw ;; ------------------------------------------- ;; String type ;; ;; Create a new string, address in RAX ;; ;; Modifies registers ;; RBX ;; string_new: call alloc_array mov [rax], BYTE maltype_string mov DWORD [rax + Array.length], 0 mov QWORD [rax + Array.next], 0 ret ;; Convert a raw string to a String type ;; ;; Input: Address of raw string in RSI, length in EDX ;; Output: Address of string in RAX ;; ;; Modifies registers: R8,R9,RCX ;; raw_to_string: ; Save registers to restore at the end push r10 push r11 push rsi push rdx call string_new ; String now in RAX pop rdx pop rsi mov r8, rax add r8, Array.data ; Address of string data mov r10, rax add r10, Array.size ; End of the destination data mov r11, rax ; First Array to return mov r9, rsi ; Address of raw data mov ecx, edx ; Count .copy_loop: test ecx, ecx ; Check if count is zero jz .done ; Copy one byte mov bl, BYTE [r9] mov [r8], BYTE bl ; Move the destination inc r8 cmp r8, r10 jne .dest_ok ; Hit the end. Set the length of the array mov [rax + Array.length], DWORD (array_chunk_len * 8) push rax ; Last Array push rsi push rdx call string_new ; String now in RAX pop rdx pop rsi pop rbx ; Last Array mov [rbx + Array.next], rax ; Point to new Array mov r8, rax add r8, Array.data ; Address of string data mov r10, rax add r10, Array.size ; End of the destination data .dest_ok: inc r9 dec ecx jmp .copy_loop .done: ; Set the length of the destination array sub r8, Array.data sub r8, rax mov [rax + Array.length], DWORD r8d ; Move first Array into RAX mov rax, r11 ; Restore registers pop r11 pop r10 ret ;; Convert a raw string to a symbol ;; ;; Input: Address of raw string in RSI, length in EDX ;; Output: Address of string in RAX ;; ;; Modifies registers: R8,R9,RCX raw_to_symbol: call raw_to_string ; set the content type mov [rax], BYTE (block_array + container_symbol + content_char) ret ;; Convert a NUL terminated C string to string ;; ;; Input: RSI - Address of string ;; ;; Returns: String in RAX ;; ;; Modifies: ;; RBX ;; RCX ;; RDX cstring_to_string: push rsi call string_new ; in RAX pop rsi mov rbx, rax add rbx, Array.data ; Start of output mov rcx, rax add rcx, Array.size ; End of output .loop: mov dl, BYTE [rsi] test dl, dl ; Check if NUL (0) jz .done mov [rbx], BYTE dl inc rbx inc rsi jmp .loop .done: sub rbx, rax sub rbx, Array.data ; rbx now contains the length mov [rax + Array.length], DWORD ebx ret ;; Appends a character to a string ;; Input: Address of string in RSI, character in CL ;; ;; Modifies ;; RAX string_append_char: push rsi ; Get the end of the string .get_end: mov rax, [rsi + Array.next] test rax, rax jz .got_dest_end mov rsi, rax jmp .get_end .got_dest_end: ; Check if this chunk is full mov eax, DWORD [rsi + Array.length] cmp eax, (array_chunk_len*8) jne .append ; full, need to allocate another call alloc_array mov [rsi + Array.next], rax mov rsi, rax xor eax, eax ; Set length to zero .append: inc eax mov DWORD [rsi + Array.length], eax dec eax add rax, rsi add rax, Array.data ; End of data mov [rax], BYTE cl pop rsi ; Restore original value ret ;; Appends a string to the end of a string ;; ;; Input: String to be modified in RSI ;; String to be copied in RDX ;; ;; Output: Modified string in RSI ;; ;; Working registers: ;; rax Array chunk for output (copied to) ;; rbx Array chunk for input (copied from) ;; cl Character being copied ;; r8 Address of destination ;; r9 Destination end address ;; r10 Address of source ;; r11 Source end address string_append_string: ; copy source Array address to rbx mov rbx, rdx ; source data address in r10 mov r10, rbx add r10, Array.data ; Start of the data ; source data end address in r11 mov r11, r10 mov r8d, DWORD [rbx + Array.length] add r11, r8 test r8d, r8d jz .return ; Appending zero-size array ; Find the end of the string in RSI ; and put the address of the Array object into rax mov rax, rsi .find_string_end: mov r8, QWORD [rax + Array.next] test r8, r8 ; Next chunk is 0 je .got_dest_end ; so reached end mov rax, r8 ; Go to next chunk jmp .find_string_end .got_dest_end: ; destination data address into r8 mov r8, rax add r8, Array.data add r8d, DWORD [rax + Array.length] ; destination data end into r9 mov r9, rax add r9, Array.size ; Check if we are at the end of the destination cmp r8, r9 je .alloc_dest .copy_loop: ; Copy one byte from source to destination mov cl, BYTE [r10] mov BYTE [r8], cl ; move source to next byte inc r10 ; Check if we've reached the end of this Array cmp r10, r11 jne .source_ok ; have reached the end of the source Array mov rbx, QWORD [rbx + Array.next] ; Get the next Array address test rbx, rbx ; Test if it's null je .finished ; No more, so we're done ; Move on to next Array object ; Get source address into r10 mov r10, rbx add r10, Array.data ; Start of the data ; Source end address mov r11d, DWORD [rbx + Array.length] ; Length of the array add r11, r10 ; Check if the next array is empty cmp r10, r11 je .finished .source_ok: ; Move destination to next byte inc r8 ; Check if we've reached end of the Array cmp r8, r9 jne .copy_loop ; Next byte .alloc_dest: ; Reached the end of the destination ; Need to allocate another Array push rax push rbx call alloc_array ; New Array in rax mov r8, rax ; copy to r8 pop rbx pop rax ; Previous Array in rax. ; Add a reference to the new array and set length mov QWORD [rax + Array.next], r8 mov DWORD [rax + Array.length], (Array.size - Array.data) mov rax, r8 ; new array add r8, Array.data ; Start of data mov r9, rax add r9, Array.size jmp .copy_loop .finished: ; Compare r8 (destination) with data start ; to get length of string sub r8, rax sub r8, Array.data inc r8 ; r8 now contains length mov DWORD [rax + Array.length], r8d .return: ret ;; ------------------------------------------ ;; void print_string(char array) ;; Address of the char Array should be in RSI print_string: ; Push registers we're going to use push rax push rdi push rdx push rsi ; Check that we have a char array mov al, [rsi] cmp al, maltype_string jne .error .print_chunk: ; write(1, string, length) push rsi mov edx, [rsi + Array.length] ; number of bytes add rsi, Array.data ; address of raw string to output call print_rawstring pop rsi ; Check if this is the end mov rsi, QWORD [rsi + Array.next] cmp rsi, 0 jne .print_chunk ; next chunk ; Restore registers pop rsi pop rdx pop rdi pop rax ret .error: ; An error occurred mov rdx, error_msg_print_string.len ; number of bytes mov rsi, error_msg_print_string ; address of raw string to output call print_rawstring ; exit jmp quit_error ;; Copy a string ;; ;; Input: RSI - String to copy ;; ;; Output: New string in RAX ;; ;; Modifies: ;; RBX ;; RCX ;; RDX ;; RSI ;; string_copy: call string_new ; new string in RAX push rsi push rax ; Get lengths mov ebx, DWORD [rsi + Array.length] mov [rax + Array.length], ebx ; Copy the whole block of data ; Not sure if this is quicker than copying byte-by-byte ; Could divide ebx by 8 (rounded up) to get the number ; of blocks needed add rsi, Array.data ; Start of input data add rax, Array.data ; Start of output data mov ecx, array_chunk_len ; Number of 64-bit chunks .loop: mov rbx, QWORD [rsi] mov [rax], QWORD rbx add rsi, 8 add rax, 8 dec ecx jnz .loop pop rax pop rsi ; Now check if there's another block mov rsi, [rsi + Array.next] cmp rsi, 0 jz .done ; Result in RAX ; Another array chunk push rax ; Save output call string_copy ; Copy next chunk mov rbx, rax ; The copy in RBX pop rax ; append mov [rax + Array.next], rbx .done: ret ;; ------------------------------------------ ;; String itostring(Integer number) ;; ;; Converts an integer to a string (array of chars) ;; ;; Input in RAX ;; Return string address in RAX itostring: ; Save registers to restore afterwards push rbx push rcx push rdx push rsi push rdi mov rcx, 0 ; counter of how many bytes we need to print in the end mov rbx, rax ; Original input ; Check if the number is negative cmp rax, 0 jge .divideLoop ; a negative number. To get the '-' sign ; at the front the test is done again at the end ; using the value stored in rbx neg rax ; Make it positive .divideLoop: inc rcx ; count each byte to print - number of characters xor rdx, rdx mov rsi, 10 idiv rsi ; divide rax by rsi add rdx, 48 ; convert rdx to it's ascii representation - rdx holds the remainder after a divide instruction ; Character is now in DL dec rsp mov BYTE [rsp], dl ; Put onto stack cmp rax, 0 ; can the integer be divided anymore? jnz .divideLoop ; jump if not zero to the label divideLoop ; Check if the value was negative (in rbx) cmp rbx, 0 jge .create_string ; a negative number dec rsp mov BYTE [rsp], '-' inc rcx .create_string: ; Get an Array object to put the string into call string_new ; Address in RAX ; put length into string mov [rax + Array.length], ecx ; copy data from stack into string ; Note: Currently this does not handle long strings mov rdi, rax add rdi, Array.data ; Address where raw string will go .copyLoop: mov BYTE dl, [rsp] ; Copy one byte at a time. Could be more efficient mov [rdi], BYTE dl inc rsp inc rdi dec rcx cmp rcx, 0 jnz .copyLoop ; Restore registers pop rdi pop rsi pop rdx pop rcx pop rbx ret ;; ------------------------------------------------------------ ;; Object comparison ;; ;; These comparison functions take two objects ;; in RSI and RDI ;; and return a code (not an object) in RAX ;; ;; RAX = 0 Objects are equal ;; 1 RSI object is greater than RDI ;; 2 RSI object is less than RDI ;; -1 Different object types, or no ordering ;; ;; Note that the ordering of objects depends on the type ;; strings - Alphabetical ;; ;; ;; ;; Given an object in RSI, follows pointers ;; to return the value object in RAX ;; ;; Modifies registers: ;; RCX compare_get_value: mov cl, BYTE [rsi] mov ch, cl and ch, block_mask jnz .nop ; Got an Array ; Here got Cons mov ch, cl and ch, content_mask cmp ch, content_pointer jne .nop ; Not a pointer ; Got a pointer, so follow and return mov rax, [rsi + Cons.car] ret .nop: mov rax, rsi ret ;; Compare two objects in RSI and RDI. ;; Note that this does not compare lists ;; but will just compare the first element ;; ;; Modifies registers ;; RAX, RBX, RCX, RDX ;; compare_objects: ; Get the value that RSI points to call compare_get_value mov rbx, rax ; Save in RBX ; Get the value that RDI points to mov rsi, rdi call compare_get_value mov rdi, rax mov rsi, rbx ; now get types mov cl, BYTE [rsi] ; Type of RSI mov bl, BYTE [rdi] ; Type of RDI mov ch, cl mov bh, bl ; Don't care about container type and cl, block_mask + content_mask and bl, block_mask + content_mask cmp bl, cl ; compare block and content jne .different_types ; Here the same block, content type ; May be different container (value/list, string/symbol) ; Need to distinguish between map and vector/list and ch, (block_mask + container_mask) and bh, (block_mask + container_mask) cmp ch, bh je .same_container ; if either is a map, then different types cmp ch, container_map je .different_types cmp bh, container_map je .different_types .same_container: cmp bl, block_cons + content_nil je .objects_equal ; nil cmp bl, block_array + content_char je compare_char_array ; strings, symbols cmp bl, block_cons + content_int je .integers ; Unknown jmp .different_types .integers: ; two Cons objects, both containing integers mov rbx, [rsi + Cons.car] cmp rbx, [rdi + Cons.car] je .objects_equal jl .rdi_greater jmp .rsi_greater .objects_equal: mov rax, 0 ret .rsi_greater: ; rsi > rdi mov rax, 1 ret .rdi_greater: ; rdi > rsi mov rax, 2 ret .different_types: mov rax, -1 ret ;; Recursively check objects, including lists ;; ;; Inputs: Objects in RSI and RDI ;; ;; Sets ZF if equal, clears flag otherwise compare_objects_rec: ; Compare rsi and rdi objects ; Check type mov al, BYTE [rsi] mov bl, BYTE [rdi] mov ah, al mov bh, bl ; Don't distinguish between [] and () and ah, (block_mask + content_mask) and bh, (block_mask + content_mask) cmp ah, bh jne .false ; Need to distinguish between map and vector/list mov ah, al mov bh, bl and ah, (block_mask + container_mask) and bh, (block_mask + container_mask) cmp ah, bh je .same_container ; if either is a map, then different types cmp ah, container_map je .false cmp bh, container_map je .false .same_container: ; Check the container type and bh, block_mask jnz .array ; Check if a pointer to something and al, content_mask cmp al, content_pointer je .pointer ; Get the values mov rbx, [rsi + Cons.car] mov rcx, [rdi + Cons.car] cmp rbx, rcx jne .false ; Value is the same, so get next jmp .next .array: ; Comparing arrays ; Container type (symbol/string) does matter cmp al, bl jne .false call compare_char_array cmp rax, 0 ret ; Array has no next .pointer: mov rbx, [rsi + Cons.car] mov rcx, [rdi + Cons.car] cmp rbx, rcx je .next ; Equal pointers push rsi push rdi ; Put the addresses to compare into RSI and RDI mov rsi, rbx mov rdi, rcx call compare_objects_rec pop rdi pop rsi jne .false ; fall through to .next .next: ; Check if both have a 'cdr' pointer mov al, BYTE [rsi + Cons.typecdr] mov bl, BYTE [rdi + Cons.typecdr] cmp al, content_pointer je .rsi_has_next ; No next pointer in RSI cmp bl, content_pointer je .false ; RDI has a next pointer ; Neither have a next pointer, so done jmp .true .rsi_has_next: cmp bl, content_pointer jne .false ; RDI has no next pointer ; Both have a next pointer, so keep going mov rsi, [rsi + Cons.cdr] mov rdi, [rdi + Cons.cdr] jmp compare_objects_rec .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 ;; Char array objects (strings, symbols, keywords) in RSI and RDI ;; Return code in RAX ;; ;; Modifies registers: ;; RBX ;; RCX ;; RDX compare_char_array: ; Check length mov eax, DWORD [rsi + Array.length] mov ebx, DWORD [rdi + Array.length] cmp eax, ebx jne .different ; same length cmp eax, 0 je .equal ; Both zero length mov rbx, rsi add rbx, Array.data mov rcx, rdi add rcx, Array.data .compare_loop: ; get next character mov dl, BYTE [rbx] cmp dl, BYTE [rcx] jl .rdi_greater jg .rsi_greater ; this character is equal inc rbx inc rcx dec eax jnz .compare_loop ; Next character .equal: mov rax, 0 ret .rsi_greater: ; rsi > rdi mov rax, 1 ret .rdi_greater: ; rdi > rsi mov rax, 2 ret .different: mov rax, -1 ret ;; ------------------------------------------------------------ ;; Map type ;; ;; This uses a list (Cons type) to represent key-value pairs in ;; a single chain. The only map which consists of an odd number of Cons ;; objects is the empty map, created by map_new map_new: call alloc_cons mov [rax], BYTE (block_cons + container_map + content_empty) mov [rax + Cons.typecdr], BYTE content_nil ret ;; Copy map ;; ;; Input: RSI - map ;; ;; Returns: new map in RAX ;; ;; Modifies: ;; RAX, RBX, RCX, R13, R14, R15 ;; map_copy: mov r14, rsi call alloc_cons mov r15, rax ; start of new map xor r13, r13 .loop: mov bl, BYTE [rsi] mov rcx, [rsi + Cons.car] mov [rax], BYTE bl ; copy type mov [rax + Cons.car], rcx ; copy value and bl, content_mask cmp bl, content_pointer jne .set_cdr ; A pointer in CAR. Increase reference count mov bx, WORD [rcx + Cons.refcount] inc bx mov [rcx + Cons.refcount], WORD bx .set_cdr: test r13,r13 jz .next ; R13 contains last Cons mov [r13 + Cons.typecdr], BYTE content_pointer mov [r13 + Cons.cdr], rax .next: mov r13, rax ; Check if there's another Cons mov bl, BYTE [rsi + Cons.typecdr] cmp bl, content_pointer jne .done ; no more mov rsi, [rsi + Cons.cdr] ; next call alloc_cons jmp .loop .done: mov rax, r15 mov rsi, r14 ret ;; Add to map. Input is a list with an even number of values ;; as (key, value, key, value, ...) ;; ;; Inputs: ;; RSI - Map to append to. This is not modified ;; RDI - List to add to the map ;; Outputs: ;; RAX - New map ;; ;; Modifies: ;; RCX map_add: ; Check type of input mov cl, BYTE [rsi] mov cl, ch and ch, block_mask + container_mask cmp ch, block_cons + container_map jne .error mov cl, BYTE [rdi] and cl, block_mask + container_mask cmp cl, block_cons + container_list jne .error xor r8, r8 ; Zero r8 .copy_input: ; Copy input list, changing container type call alloc_cons mov cl, BYTE [rdi] and cl, content_mask ; Keep the content add cl, block_cons + container_map mov [rax], BYTE cl ; Set type mov rcx, [rdi+Cons.car] ; Copy data mov [rax+Cons.car], rcx cmp cl, (block_cons + container_map + content_pointer) jne .copy_not_pointer ; Copying a pointer to data ; so need to increase the reference count mov bx, WORD [rcx + Cons.refcount] ; Same offset for Array inc bx mov [rcx + Cons.refcount], WORD bx .copy_not_pointer: ; Check if this is the first object cmp r8, 0 jnz .copy_not_first mov r8, rax ; Save start of map to R8 mov r9, rax ; Last cons in R9 jmp .copy_next .copy_not_first: ; Append to R9 mov [r9+Cons.cdr], rax mov [r9+Cons.typecdr], BYTE content_pointer ; Put new Cons in R9 as the latest in the list mov r9, rax .copy_next: ; Check if we've reached the end mov cl, BYTE [rdi + Cons.typecdr] cmp cl, content_nil je .copy_finished ; Not yet. Get next Cons and keep going mov rdi, [rdi + Cons.cdr] jmp .copy_input .copy_finished: ; Start of map in r8, end in r9 ; Check if the original map is empty mov cl, [rsi] and cl, content_mask cmp cl, content_empty je .return ; Put old map on the end of the new map ; For now this avoids the need to overwrite ; values in the map, since a search will find ; the new values first. mov [r9 + Cons.cdr], rsi mov [r9 + Cons.typecdr], BYTE content_pointer ; Increment reference count mov bx, WORD [rsi + Cons.refcount] inc bx mov [rsi + Cons.refcount], WORD bx .return: mov rax, r8 ret .error: ; Return nil call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ;; Find a key in a map ;; ;; Inputs: RSI - map [ Modified ] ;; RDI - key [ Modified ] ;; ;; Outputs: RAX - Cons object containing value in CAR ;; ;; Modifies registers: ;; RBX [compare_objects, alloc_cons] ;; RCX [compare_objects] ;; ;; ;; If value is found then the Zero Flag is set ;; ;; Examples: ;; {a 1 b 2} find a -> {1 b 2} ;; {1 2 3 4} find a -> {4} map_find: mov al, BYTE [rsi] cmp al, maltype_empty_map je .not_found .map_loop: ; compare RSI and RDI, ignoring differences in container push rsi push rdi call compare_objects pop rdi pop rsi ; rax is now zero if objects are equal cmp rax, 0 je .found ; Move along two cons to the next key mov al, [rsi + Cons.typecdr] cmp al, content_pointer jne .error ; Expecting value after key mov rsi, [rsi + Cons.cdr] ; Get value mov al, [rsi + Cons.typecdr] cmp al, content_pointer jne .not_found mov rsi, [rsi + Cons.cdr] ; Get next key jmp .map_loop ; Test next key .found: lahf ; flags in AH or ah, 64 ; set zero flag sahf ; key in rsi. Get next value mov al, [rsi + Cons.typecdr] cmp al, content_pointer jne .error ; Expecting value after key mov rsi, [rsi + Cons.cdr] ; ; increment reference count ; mov ax, WORD [rsi + Cons.refcount] ; inc ax ; mov [rsi + Cons.refcount], WORD ax ; Put address in rax mov rax, rsi ret .not_found: lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ; last cons in rsi ; increment reference count ; mov ax, WORD [rsi + Cons.refcount] ; inc ax ; mov [rsi + Cons.refcount], WORD ax ; Put address in rax mov rax, rsi ret .error: lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ; return nil call alloc_cons mov [rax], BYTE maltype_nil mov [rax + Cons.typecdr], BYTE content_nil ret ;; Map set ;; ;; Sets a key-value pair in a map ;; ;; Inputs: RSI - map [not modified] ;; RDI - key [not modified] ;; RCX - value [not modified] ;; ;; If references are added to key or value, ;; then reference counts are incremented. ;; ;; Modifies registers: ;; R8 ;; R9 ;; R10 map_set: ; Save inputs in less volatile registers mov r8, rsi ; map mov r9, rdi ; key mov r10, rcx ; value ; Find the key, to see if it already exists in the map call map_find ; Cons object in RAX je .found_key ; Key not in map. RAX should be address of the last ; value in the map, or empty mov bl, BYTE [rax] cmp bl, maltype_empty_map je .set_key ; Append key push rax call alloc_cons ; New Cons in rax pop rbx ; Last Cons in map ; append rax to rbx mov [rbx + Cons.typecdr], BYTE content_pointer mov [rbx + Cons.cdr], rax jmp .set_key ; Put key into rax .found_key: ; Key already in map, so replace value ; address in RAX ; check type of value already there mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer jne .set_value ; Not a pointer, just overwrite ; A pointer, so need to release mov rsi, [rax + Cons.car] ; Address of object push rax call release_object pop rax jmp .set_value ; put value into Cons .set_key: ; Put key (R9) in RAX ; Check the type of object mov bl, BYTE [r9] mov bh, bl and bh, block_mask jnz .set_key_pointer ; Array, so point to it ; Here a Cons object mov bh, bl and bh, container_mask cmp bh, container_value jne .set_key_pointer ; Not a simple value, so point to it ; A value, so copy mov rcx, [r9 + Cons.car] mov [rax + Cons.car], rcx ; Set the type and bl, content_mask or bl, (block_cons + container_map) mov [rax], BYTE bl jmp .set_key_done .set_key_pointer: ; The key is a pointer mov [rax + Cons.car], r9 mov [rax], BYTE (block_cons + container_map + content_pointer) ; Increment reference count mov bx, WORD [r9 + Cons.refcount] inc bx mov [r9 + Cons.refcount], bx ; fall through to .set_key_done .set_key_done: ; Key in RAX. allocate and append a Cons for the value push rax call alloc_cons ; value Cons in rax pop rbx ; key Cons ; append rax to rbx mov [rbx + Cons.typecdr], BYTE content_pointer mov [rbx + Cons.cdr], rax ; fall through to .set_value ; -------------------------------- .set_value: ; Set the value into the Cons at [rax] ; Check the type of object mov bl, BYTE [r10] mov bh, bl and bh, block_mask jnz .set_value_pointer ; Array, so point to it ; Here a Cons object mov bh, bl and bh, container_mask cmp bh, container_value jne .set_value_pointer ; Not a simple value, so point to it ; A value, so copy mov rcx, [r10 + Cons.car] mov [rax + Cons.car], rcx ; Set the type and bl, content_mask or bl, (block_cons + container_map) mov [rax], BYTE bl jmp .finished .set_value_pointer: mov [rax + Cons.car], r10 ; Put address into CAR mov [rax], BYTE (block_cons + container_map + content_pointer) ; Mark as a pointer ; Increment reference count mov bx, WORD [r10 + Cons.refcount] inc bx mov [r10 + Cons.refcount], bx ; fall through to .finished .finished: ; Restore inputs mov rsi, r8 mov rdi, r9 mov rcx, r10 ret ;; Get a value from a map, incrementing the reference count ;; of the object returned ;; ;; Inputs: RSI - map ;; RDI - key ;; ;; Returns: If found, Zero Flag is set and address in RAX ;; If not found, Zero Flag cleared ;; ;; Modifies registers: ;; RAX ;; RBX ;; RCX ;; R8 ;; R9 map_get: ; Save inputs mov r8, rsi ; map mov r9, rdi ; key call map_find ; Cons object in RAX je .found_key ; Not found mov rsi, r8 mov rdi, r9 lahf ; flags in AH and ah, 255-64 ; clear zero flag sahf ret ; --------------- .found_key: ; Check if the object in RAX is a value or pointer mov bl, BYTE [rax] and bl, content_mask cmp bl, content_pointer je .got_pointer ; A value, so copy push rax push rbx call alloc_cons ; cons in rax pop rbx ; content type in bl pop rcx ; Object to copy add bl, block_cons + container_value mov [rax], BYTE bl ; set type mov [rax + Cons.typecdr], BYTE content_nil ; Copy value mov rbx, [rcx + Cons.car] mov [rax + Cons.car], rbx jmp .finished_found .got_pointer: ; A pointer, so get the address mov rax, [rax + Cons.car] ; increment reference count mov bx, WORD [rax + Cons.refcount] inc bx mov [rax + Cons.refcount], bx ; Fall through to .finished_found .finished_found: mov rsi, r8 mov rdi, r9 mov rbx, rax lahf ; flags in AH or ah, 64 ; set zero flag sahf mov rax, rbx ret ;; Get a list of keys ;; ;; Input: Map in RSI ;; ;; Returns: List in RAX ;; ;; Modifies registers: ;; RAX ;; RBX ;; RCX ;; R8 ;; R9 map_keys: ; check type mov al, BYTE [rsi] cmp al, maltype_empty_map je .empty_map and al, container_mask cmp al, container_map jne .empty_map ; error xor r8, r8 ; Return list ; Take the current value .loop: ; Create a new Cons for this key call alloc_cons mov cl, BYTE [rsi] and cl, content_mask add cl, block_cons + container_list mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; Set value and cl, content_mask cmp cl, content_pointer jne .append ; A pointer, so increment reference count mov cx, WORD [rbx + Cons.refcount] inc cx mov [rbx + Cons.refcount], WORD cx .append: cmp r8, 0 je .first ; appending mov [r9 + Cons.typecdr], BYTE content_pointer mov [r9 + Cons.cdr], rax mov r9, rax jmp .next .first: ; First key, so put into r8 mov r8, rax mov r9, rax .next: ; First get the value mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .done ; error. Should be a value mov rsi, [rsi + Cons.cdr] ; Get the next key mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .done mov rsi, [rsi + Cons.cdr] jmp .loop .done: ; Finished, return the list mov rax, r8 ret .empty_map: ; return empty list call alloc_cons mov [rax], BYTE maltype_empty_list ret ;; Get a list of values ;; ;; Input: Map in RSI ;; ;; Returns: List in RAX ;; ;; Modifies registers: ;; RAX ;; RBX ;; RCX ;; R8 ;; R9 map_vals: ; check type mov al, BYTE [rsi] cmp al, maltype_empty_map je .empty_map and al, container_mask cmp al, container_map jne .empty_map ; error xor r8, r8 ; Return list .loop: ; Here should have a key in RSI ; First get the value mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .done ; error. Should be a value mov rsi, [rsi + Cons.cdr] ; Now have value in RSI ; Create a new Cons for this value call alloc_cons mov cl, BYTE [rsi] and cl, content_mask add cl, block_cons + container_list mov [rax], BYTE cl ; Set type mov rbx, [rsi + Cons.car] mov [rax + Cons.car], rbx ; Set value and cl, content_mask cmp cl, content_pointer jne .append ; A pointer, so increment reference count mov cx, WORD [rbx + Cons.refcount] inc cx mov [rbx + Cons.refcount], WORD cx .append: cmp r8, 0 je .first ; appending mov [r9 + Cons.typecdr], BYTE content_pointer mov [r9 + Cons.cdr], rax mov r9, rax jmp .next .first: ; First key, so put into r8 mov r8, rax mov r9, rax .next: ; Get the next key mov al, BYTE [rsi + Cons.typecdr] cmp al, content_pointer jne .done mov rsi, [rsi + Cons.cdr] jmp .loop .done: ; Finished, return the list mov rax, r8 ret .empty_map: ; return empty list call alloc_cons mov [rax], BYTE maltype_empty_list ret ;; ------------------------------------------------------------ ;; Function type ;; ;; Functions are consist of a list ;; - First car is the function address to call ;; - Second is the Meta data (nil by default) ;; - Third is the environment ;; - Fourth is the binds list ;; - Fifth is the body of the function ;; ;; ( addr meta env binds body ) ;; ;; ;; Address of native function in RSI ;; returns Function object in RAX native_function: call alloc_cons ; for meta mov [rax], BYTE maltype_nil push rax call alloc_cons ; For function address mov [rax], BYTE (block_cons + container_function + content_function) mov [rax + Cons.car], rsi mov [rax + Cons.typecdr], BYTE content_pointer pop rbx ; meta mov [rax + Cons.cdr], rbx ret ================================================ FILE: impls/nim/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install gcc libc-dev nim ENV HOME /mal ================================================ FILE: impls/nim/Makefile ================================================ ##################### SOURCES_BASE = types.nim reader.nim printer.nim SOURCES_REBUILD = $(SOURCES_BASE) env.nim core.nim ##################### SRCS = step0_repl.nim step1_read_print.nim step2_eval.nim step3_env.nim \ step4_if_fn_do.nim step5_tco.nim step6_file.nim step7_quote.nim \ step8_macros.nim step9_try.nim stepA_mal.nim BINS = $(SRCS:%.nim=%) ##################### all: $(BINS) dist: mal mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ $(BINS): %: %.nim $(SOURCES_REBUILD) nim -d:release --nimcache:nimcache-$@ c $@ clean: rm -rf nimcache-*/ $(BINS) rm -f mal ================================================ FILE: impls/nim/core.nim ================================================ import strutils, rdstdin, tables, times, sequtils, types, printer, reader type MalError* = object of CatchableError t*: MalType # String functions proc pr_str(xs: varargs[MalType]): MalType = str(xs.map(proc(x: MalType): string = x.pr_str(true)).join(" ")) proc do_str(xs: varargs[MalType]): MalType = str(xs.map(proc(x: MalType): string = x.pr_str(false)).join) proc prn(xs: varargs[MalType]): MalType = echo xs.map(proc(x: MalType): string = x.pr_str(true)).join(" ") result = nilObj proc println(xs: varargs[MalType]): MalType = echo xs.map(proc(x: MalType): string = x.pr_str(false)).join(" ") result = nilObj proc read_str(xs: varargs[MalType]): MalType = read_str(xs[0].str) proc readline(xs: varargs[MalType]): MalType = str readLineFromStdin(xs[0].str) proc slurp(xs: varargs[MalType]): MalType = str readFile(xs[0].str) proc cons(xs: varargs[MalType]): MalType = result = list(xs[0]) for x in xs[1].list: result.list.add x proc concat(xs: varargs[MalType]): MalType = result = list() for x in xs: 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") proc first(xs: varargs[MalType]): MalType = if xs[0].kind in {List, Vector} and xs[0].list.len > 0: xs[0].list[0] else: nilObj proc rest(xs: varargs[MalType]): MalType = if xs[0].kind in {List, Vector} and xs[0].list.len > 0: list xs[0].list[1 .. ^1] else: list() proc throw(xs: varargs[MalType]): MalType = raise (ref MalError)(t: list xs) proc assoc(xs: varargs[MalType]): MalType = result = hash_map() result.hash_map = xs[0].hash_map for i in countup(1, xs.high, 2): result.hash_map[xs[i].str] = xs[i+1] proc dissoc(xs: varargs[MalType]): MalType = result = hash_map() result.hash_map = xs[0].hash_map for i in 1 .. xs.high: if result.hash_map.hasKey(xs[i].str): result.hash_map.del(xs[i].str) proc get(xs: varargs[MalType]): MalType = if xs[0].kind == HashMap: if xs[1].str in xs[0].hash_map: result = xs[0].hash_map[xs[1].str] if not result.isNil: return result = nilObj proc contains_q(xs: varargs[MalType]): MalType = boolObj xs[0].hash_map.hasKey(xs[1].str) proc keys(xs: varargs[MalType]): MalType = result = list() for key in xs[0].hash_map.keys: result.list.add str(key) proc vals(xs: varargs[MalType]): MalType = result = list() for value in xs[0].hash_map.values: result.list.add value proc apply(xs: varargs[MalType]): MalType = var s = newSeq[MalType]() if xs.len > 2: for j in 1 .. xs.high-1: s.add xs[j] s.add xs[xs.high].list xs[0].getFun()(s) proc map(xs: varargs[MalType]): MalType = result = list() for i in 0 .. xs[1].list.high: result.list.add xs[0].getFun()(xs[1].list[i]) proc conj(xs: varargs[MalType]): MalType = if xs[0].kind == List: result = list() for i in countdown(xs.high, 1): result.list.add xs[i] result.list.add xs[0].list else: result = vector() result.list.add xs[0].list for i in 1..xs.high: result.list.add xs[i] result.meta = xs[0].meta proc seq(xs: varargs[MalType]): MalType = if xs[0].kind == List: if len(xs[0].list) == 0: return nilObj result = xs[0] elif xs[0].kind == Vector: if len(xs[0].list) == 0: return nilObj result = list() result.list.add xs[0].list elif xs[0].kind == String: if len(xs[0].str) == 0: return nilObj result = list() for i in countup(0, len(xs[0].str) - 1): result.list.add(str xs[0].str.substr(i,i)) elif xs[0] == nilObj: result = nilObj else: raise newException(ValueError, "seq: called on non-sequence") proc with_meta(xs: varargs[MalType]): MalType = new result result[] = xs[0][] result.meta = xs[1] proc meta(xs: varargs[MalType]): MalType = if not xs[0].meta.isNil: xs[0].meta else: nilObj proc deref(xs: varargs[MalType]): MalType = xs[0].val proc reset_bang(xs: varargs[MalType]): MalType = xs[0].val = xs[1] result = xs[0].val proc swap_bang(xs: varargs[MalType]): MalType = var args = @[xs[0].val] for i in 2 .. xs.high: args.add xs[i] xs[0].val = xs[1].getFun()(args) result = xs[0].val proc time_ms(xs: varargs[MalType]): MalType = number int(epochTime() * 1000) template wrapNumberFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) template wrapBoolFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = if op(xs[0].number, xs[1].number): trueObj else: falseObj let ns* = { "+": wrapNumberFun(`+`), "-": wrapNumberFun(`-`), "*": wrapNumberFun(`*`), "/": wrapNumberFun(`div`), "<": wrapBoolFun(`<`), "<=": wrapBoolFun(`<=`), ">": wrapBoolFun(`>`), ">=": wrapBoolFun(`>=`), "list": fun list, "list?": fun list_q, "vector": fun vector, "vector?": fun vector_q, "hash-map": fun hash_map, "map?": fun hash_map_q, "empty?": fun empty_q, "assoc": fun assoc, "dissoc": fun dissoc, "get": fun get, "contains?": fun contains_q, "keys": fun keys, "vals": fun vals, "=": fun equal, "pr-str": fun pr_str, "str": fun do_str, "prn": fun prn, "println": fun println, "read-string": fun read_str, "readline": fun readline, "slurp": fun slurp, "sequential?": fun seq_q, "cons": fun cons, "concat": fun concat, "vec": fun vec, "count": fun count, "nth": fun nth, "first": fun first, "rest": fun rest, "apply": fun apply, "map": fun map, "conj": fun conj, "seq": fun seq, "throw": fun throw, "nil?": fun nil_q, "true?": fun true_q, "false?": fun false_q, "string?": fun string_q, "symbol": fun symbol, "symbol?": fun symbol_q, "keyword": fun keyword, "keyword?": fun keyword_q, "number?": fun number_q, "fn?": fun fn_q, "macro?": fun macro_q, "with-meta": fun with_meta, "meta": fun meta, "atom": fun atom, "atom?": fun atom_q, "deref": fun deref, "reset!": fun reset_bang, "swap!": fun swap_bang, "time-ms": fun time_ms, } ================================================ FILE: impls/nim/env.nim ================================================ import tables, types proc initEnv*(outer: Env = nil, binds, exprs: MalType = nilObj): Env = result = Env(data: initTable[string, MalType](), outer: outer) if binds.kind in {List, Vector}: for i, e in binds.list: if e.str == "&": result.data[binds.list[i+1].str] = list(exprs.list[i .. ^1]) break else: result.data[e.str] = exprs.list[i] proc set*(e: Env, key: string, value: MalType): MalType {.discardable.} = e.data[key] = value value proc get*(e: Env, key: string): MalType = var env = e while not env.data.hasKey(key): env = env.outer if env.isNil: return nil return env.data[key] ================================================ FILE: impls/nim/mal.nimble ================================================ [Package] name = "mal" version = "1.1" author = "Dennis Felsing" description = "Mal code in Nim" license = "MIT" bin = "step0_repl, step1_read_print, step2_eval, step3_env, step4_if_fn_do, step5_tco, step6_file, step7_quote, step8_macros, step9_try, stepA_mal" [Deps] Requires = "nim >= 0.10.3" ================================================ FILE: impls/nim/nim.cfg ================================================ gc: markandsweep ================================================ FILE: impls/nim/printer.nim ================================================ import strutils, sequtils, tables, types proc str_handle(x: string, pr = true): string = if x.len > 0 and x[0] == '\xff': result = ":" & x[1 .. x.high] elif pr: result = "\"" & x.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") & "\"" else: result = x proc pr_str*(m: MalType, pr = true): string = case m.kind of Nil: result = "nil" of True: result = "true" of False: result = "false" of Fun: result = "#" of MalFun: result = "#" of Atom: result = "(atom " & m.val.pr_str & ")" of Symbol: result = m.str of String: result = m.str.str_handle(pr) of Number: result = $m.number of List: result = "(" & m.list.mapIt(it.pr_str(pr)).join(" ") & ")" of Vector: result = "[" & m.list.mapIt(it.pr_str(pr)).join(" ") & "]" of HashMap: result = "{" for key, val in m.hash_map.pairs: if result.len > 1: result.add " " result.add key.str_handle & " " & val.pr_str(pr) result.add "}" ================================================ FILE: impls/nim/reader.nim ================================================ import options, re, strutils, types let tokenRE = re"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)""" intRE = re"-?[0-9]+$" strRE = re"""^"(?:\\.|[^\\"])*"$""" type Blank* = object of CatchableError Reader = object tokens: seq[string] position: int proc next(r: var Reader): Option[string] = if r.position < r.tokens.len: result = r.tokens[r.position].some inc r.position proc peek(r: Reader): Option[string] = if r.position < r.tokens.len: return r.tokens[r.position].some proc tokenize(str: string): seq[string] = result = @[] var pos = 0 while pos < str.len: var matches: array[2, string] var len = str.findBounds(tokenRE, matches, pos) if len.first != -1 and len.last != -1 and len.last >= len.first: pos = len.last + 1 if matches[0].len > 0 and matches[0][0] != ';': result.add matches[0] else: inc pos proc read_form(r: var Reader): MalType proc read_seq(r: var Reader, fr, to: string): seq[MalType] = result = @[] var t = r.next if t.get("") != fr: raise newException(ValueError, "expected '" & fr & "'") t = r.peek while t.get("") != to: if t.get("") == "": raise newException(ValueError, "expected '" & to & "', got EOF") result.add r.read_form t = r.peek discard r.next proc read_list(r: var Reader): MalType = result = list r.read_seq("(", ")") proc read_vector(r: var Reader): MalType = result = vector r.read_seq("[", "]") proc read_hash_map(r: var Reader): MalType = result = hash_map r.read_seq("{", "}") proc read_atom(r: var Reader): MalType = let t = r.next.get("") if t.match(intRE): number t.parseInt elif t[0] == '"': if not t.match(strRE): raise newException(ValueError, "expected '\"', got EOF") str t[1 ..< t.high].multiReplace(("\\\"", "\""), ("\\n", "\n"), ("\\\\", "\\")) elif t[0] == ':': keyword t[1 .. t.high] elif t == "nil": nilObj elif t == "true": trueObj elif t == "false": falseObj else: symbol t proc read_form(r: var Reader): MalType = if r.peek.get("")[0] == ';': discard r.next return nilObj case r.peek.get("") of "'": discard r.next result = list(symbol "quote", r.read_form) of "`": discard r.next result = list(symbol "quasiquote", r.read_form) of "~": discard r.next result = list(symbol "unquote", r.read_form) of "~@": discard r.next result = list(symbol "splice-unquote", r.read_form) of "^": discard r.next let meta = r.read_form result = list(symbol "with-meta", r.read_form, meta) of "@": discard r.next result = list(symbol "deref", r.read_form) # list of "(": result = r.read_list of ")": raise newException(ValueError, "unexpected ')'") # vector of "[": result = r.read_vector of "]": raise newException(ValueError, "unexpected ']'") # hash-map of "{": result = r.read_hash_map of "}": raise newException(ValueError, "unexpected '}'") # atom else: result = r.read_atom proc read_str*(str: string): MalType = var r = Reader(tokens: str.tokenize) if r.tokens.len == 0: raise newException(Blank, "Blank line") r.read_form ================================================ FILE: impls/nim/run ================================================ #!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/nim/step0_repl.nim ================================================ import rdstdin proc read(str: string): string = str proc eval(ast: string): string = ast proc print(exp: string): string = exp while true: try: let line = readLineFromStdin("user> ") echo line.read.eval.print except IOError: quit() ================================================ FILE: impls/nim/step1_read_print.nim ================================================ import rdstdin, types, reader, printer proc read(str: string): MalType = str.read_str proc eval(ast: MalType): MalType = ast proc print(exp: MalType): string = exp.pr_str while true: try: let line = readLineFromStdin("user> ") echo line.read.eval.print except IOError: quit() except: echo getCurrentExceptionMsg() ================================================ FILE: impls/nim/step2_eval.nim ================================================ import rdstdin, tables, sequtils, types, reader, printer proc read(str: string): MalType = str.read_str proc eval(ast: MalType, env: Table[string, MalType]): MalType = # echo "EVAL: " & ast.pr_str case ast.kind of Symbol: if not env.hasKey(ast.str): raise newException(ValueError, "'" & ast.str & "' not found") result = env[ast.str] of Vector: result = vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) of List: if ast.list.len == 0: return ast let el = ast.list.mapIt(it.eval(env)) result = el[0].fun(el[1 .. ^1]) else: result = ast proc print(exp: MalType): string = exp.pr_str template wrapNumberFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) let repl_env = toTable({ "+": wrapNumberFun `+`, "-": wrapNumberFun `-`, "*": wrapNumberFun `*`, "/": wrapNumberFun `div`, }) proc rep(str: string): string = str.read.eval(repl_env).print while true: try: let line = readLineFromStdin("user> ") echo line.rep except IOError: quit() except: echo getCurrentExceptionMsg() ================================================ FILE: impls/nim/step3_env.nim ================================================ import rdstdin, tables, sequtils, types, reader, printer, env proc read(str: string): MalType = str.read_str proc eval(ast: MalType, env: Env): MalType = let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: result = env.get(ast.str) if result.isNil: raise newException(ValueError, "'" & ast.str & "' not found") of Vector: result = vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) of List: if ast.list.len == 0: return ast let a0 = ast.list[0] a1 = ast.list[1] a2 = ast.list[2] case a0.str of "def!": result = env.set(a1.str, a2.eval(env)) of "let*": let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: discard result = a2.eval(let_env) else: let el = ast.list.mapIt(it.eval(env)) result = el[0].fun(el[1 .. ^1]) else: result = ast proc print(exp: MalType): string = exp.pr_str template wrapNumberFun(op): untyped = fun proc(xs: varargs[MalType]): MalType = number op(xs[0].number, xs[1].number) let repl_env = initEnv() repl_env.set("+", wrapNumberFun(`+`)) repl_env.set("-", wrapNumberFun(`-`)) repl_env.set("*", wrapNumberFun(`*`)) repl_env.set("/", wrapNumberFun(`div`)) #repl_env.set("/", wrapNumberFun(proc(x,y: int): int = int(x.float / y.float))) proc rep(str: string): string = str.read.eval(repl_env).print while true: try: let line = readLineFromStdin("user> ") echo line.rep except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step4_if_fn_do.nim ================================================ import rdstdin, tables, sequtils, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc eval(ast: MalType, env: Env): MalType = let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: result = env.get(ast.str) if result.isNil: raise newException(ValueError, "'" & ast.str & "' not found") of Vector: result = vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) of List: if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] return env.set(a1.str, a2.eval(env)) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: discard return a2.eval(let_env) of "do": let el = ast.list[1 .. ^1].mapIt(it.eval(env)) return el[el.high] of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: return ast.list[3].eval(env) else: return nilObj else: return a2.eval(env) of "fn*": let a1 = ast.list[1] a2 = ast.list[2] return fun(proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a)))) let el = ast.list.mapIt(it.eval(env)) result = el[0].fun(el[1 .. ^1]) else: result = ast proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) # core.nim: defined using nim proc rep(str: string): string = str.read.eval(repl_env).print # core.mal: defined using mal itself discard rep "(def! not (fn* (a) (if a false true)))" while true: try: let line = readLineFromStdin("user> ") echo line.rep except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step5_tco.nim ================================================ import rdstdin, tables, sequtils, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] return env.set(a1.str, a2.eval(env)) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) # core.nim: defined using nim proc rep(str: string): string = str.read.eval(repl_env).print # core.mal: defined using mal itself discard rep "(def! not (fn* (a) (if a false true)))" while true: try: let line = readLineFromStdin("user> ") echo line.rep except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step6_file.nim ================================================ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] return env.set(a1.str, a2.eval(env)) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) let ps = commandLineParams() repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) # core.nim: defined using nim proc rep(str: string): string {.discardable.} = str.read.eval(repl_env).print # core.mal: defined using mal itself rep "(def! not (fn* (a) (if a false true)))" rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" if paramCount() >= 1: rep "(load-file \"" & paramStr(1) & "\")" quit() while true: try: let line = readLineFromStdin("user> ") echo line.rep except Blank: discard except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step7_quote.nim ================================================ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc quasiquote(ast: MalType): MalType proc quasiquote_loop(xs: seq[MalType]): MalType = result = list() for i in countdown(xs.high, 0): let 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 = 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: result = ast proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] return env.set(a1.str, a2.eval(env)) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "quote": return ast.list[1] of "quasiquote": ast = ast.list[1].quasiquote continue # TCO of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) let ps = commandLineParams() repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) # core.nim: defined using nim proc rep(str: string): string {.discardable.} = str.read.eval(repl_env).print # core.mal: defined using mal itself rep "(def! not (fn* (a) (if a false true)))" rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" if paramCount() >= 1: rep "(load-file \"" & paramStr(1) & "\")" quit() while true: try: let line = readLineFromStdin("user> ") echo line.rep except Blank: discard except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step8_macros.nim ================================================ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc quasiquote(ast: MalType): MalType proc quasiquote_loop(xs: seq[MalType]): MalType = result = list() for i in countdown(xs.high, 0): let 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 = 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: result = ast proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] return env.set(a1.str, a2.eval(env)) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "quote": return ast.list[1] of "quasiquote": ast = ast.list[1].quasiquote continue # TCO of "defmacro!": let fun = ast.list[2].eval(env) let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, mac) of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) if f.fun_is_macro: ast = f.malfun.fn(ast.list[1 .. ^1]) continue # TCO let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) let ps = commandLineParams() repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) # core.nim: defined using nim proc rep(str: string): string {.discardable.} = str.read.eval(repl_env).print # core.mal: defined using mal itself rep "(def! not (fn* (a) (if a false true)))" rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" if paramCount() >= 1: rep "(load-file \"" & paramStr(1) & "\")" quit() while true: try: let line = readLineFromStdin("user> ") echo line.rep except Blank: discard except IOError: quit() except: echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/step9_try.nim ================================================ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc quasiquote(ast: MalType): MalType proc quasiquote_loop(xs: seq[MalType]): MalType = result = list() for i in countdown(xs.high, 0): let 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 = 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: result = ast proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] res = a2.eval(env) return env.set(a1.str, res) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "quote": return ast.list[1] of "quasiquote": ast = ast.list[1].quasiquote continue # TCO of "defmacro!": let fun = ast.list[2].eval(env) let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, mac) of "try*": let a1 = ast.list[1] if ast.list.len <= 2: ast = a1 continue # TCO let a2 = ast.list[2] try: return a1.eval(env) except MalError: let exc = (ref MalError) getCurrentException() env = initEnv(env, list a2.list[1], exc.t) ast = a2.list[2] continue # TCO except: let exc = getCurrentExceptionMsg() env = initEnv(env, list a2.list[1], list str (exc)) ast = a2.list[2] continue # TCO of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) if f.fun_is_macro: ast = f.malfun.fn(ast.list[1 .. ^1]) continue # TCO let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) let ps = commandLineParams() repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) # core.nim: defined using nim proc rep(str: string): string {.discardable.} = str.read.eval(repl_env).print # core.mal: defined using mal itself rep "(def! not (fn* (a) (if a false true)))" rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" if paramCount() >= 1: rep "(load-file \"" & paramStr(1) & "\")" quit() while true: try: let line = readLineFromStdin("user> ") echo line.rep except Blank: discard except IOError: quit() except MalError: let exc = (ref MalError) getCurrentException() echo "Error: " & exc.t.list[0].pr_str except: stdout.write "Error: " echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/stepA_mal.nim ================================================ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str proc quasiquote(ast: MalType): MalType proc quasiquote_loop(xs: seq[MalType]): MalType = result = list() for i in countdown(xs.high, 0): let 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 = 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: result = ast proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env while true: let dbgeval = env.get("DEBUG-EVAL") if not (dbgeval.isNil or dbgeval.kind in {Nil, False}): echo "EVAL: " & ast.pr_str case ast.kind of Symbol: let val = env.get(ast.str) if val.isNil: raise newException(ValueError, "'" & ast.str & "' not found") return val of List: discard(nil) # Proceed after the case statement of Vector: return vector ast.list.mapIt(it.eval(env)) of HashMap: result = hash_map() for k, v in ast.hash_map.pairs: result.hash_map[k] = v.eval(env) return result else: return ast if ast.list.len == 0: return ast let a0 = ast.list[0] if a0.kind == Symbol: case a0.str of "def!": let a1 = ast.list[1] a2 = ast.list[2] res = a2.eval(env) return env.set(a1.str, res) of "let*": let a1 = ast.list[1] a2 = ast.list[2] let let_env = initEnv(env) case a1.kind of List, Vector: for i in countup(0, a1.list.high, 2): let_env.set(a1.list[i].str, a1.list[i+1].eval(let_env)) else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env continue # TCO of "quote": return ast.list[1] of "quasiquote": ast = ast.list[1].quasiquote continue # TCO of "defmacro!": let fun = ast.list[2].eval(env) let mac = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, mac) of "try*": let a1 = ast.list[1] if ast.list.len <= 2: ast = a1 continue # TCO let a2 = ast.list[2] try: return a1.eval(env) except MalError: let exc = (ref MalError) getCurrentException() env = initEnv(env, list a2.list[1], exc.t) ast = a2.list[2] continue # TCO except: let exc = getCurrentExceptionMsg() env = initEnv(env, list a2.list[1], list str (exc)) ast = a2.list[2] continue # TCO of "do": let last = ast.list.high discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] continue # TCO of "if": let a1 = ast.list[1] a2 = ast.list[2] cond = a1.eval(env) if cond.kind in {Nil, False}: if ast.list.len > 3: ast = ast.list[3] continue # TCO else: return nilObj else: ast = a2 continue # TCO of "fn*": let a1 = ast.list[1] a2 = ast.list[2] let fn = proc(a: varargs[MalType]): MalType = a2.eval(initEnv(env, a1, list(a))) return malfun(fn, a2, a1, env) let f = eval(a0, env) if f.fun_is_macro: ast = f.malfun.fn(ast.list[1 .. ^1]) continue # TCO let args = ast.list[1 .. ^1].mapIt(it.eval(env)) if f.kind == MalFun: ast = f.malfun.ast env = initEnv(f.malfun.env, f.malfun.params, list(args)) continue # TCO return f.fun(args) proc print(exp: MalType): string = exp.pr_str let repl_env = initEnv() for k, v in ns.items: repl_env.set(k, v) repl_env.set("eval", fun(proc(xs: varargs[MalType]): MalType = eval(xs[0], repl_env))) let ps = commandLineParams() repl_env.set("*ARGV*", list((if paramCount() > 1: ps[1..ps.high] else: @[]).map(str))) # core.nim: defined using nim proc rep(str: string): string {.discardable.} = str.read.eval(repl_env).print # core.mal: defined using mal itself rep "(def! not (fn* (a) (if a false true)))" rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep "(def! *host-language* \"nim\")" if paramCount() >= 1: rep "(load-file \"" & paramStr(1) & "\")" quit() rep "(println (str \"Mal [\" *host-language* \"]\"))" while true: try: let line = readLineFromStdin("user> ") echo line.rep except Blank: discard except IOError: quit() except MalError: let exc = (ref MalError) getCurrentException() echo "Error: " & exc.t.list[0].pr_str except: stdout.write "Error: " echo getCurrentExceptionMsg() echo getCurrentException().getStackTrace() ================================================ FILE: impls/nim/tests/step5_tco.mal ================================================ ;; Nim: skipping non-TCO recursion ;; Reason: completes at 10,000, unrecoverable segfault 20,000 ================================================ FILE: impls/nim/types.nim ================================================ import tables type MalTypeKind* = enum Nil, True, False, Number, Symbol, String, List, Vector, HashMap, Fun, MalFun, Atom FunType = proc(a: varargs[MalType]): MalType MalFunType* = ref object fn*: FunType ast*: MalType params*: MalType env*: Env is_macro*: bool MalType* = ref object case kind*: MalTypeKind of Nil, True, False: nil of Number: number*: int of String, Symbol: str*: string of List, Vector: list*: seq[MalType] of HashMap: hash_map*: Table[string, MalType] of Fun: fun*: FunType is_macro*: bool of MalFun: malfun*: MalFunType of Atom: val*: MalType meta*: MalType Env* = ref object data*: Table[string, MalType] outer*: Env let nilObj* = MalType(kind: Nil) let trueObj* = MalType(kind: True) let falseObj* = MalType(kind: False) proc number*(x: int): MalType = MalType(kind: Number, number: x) proc symbol*(x: string): MalType = MalType(kind: Symbol, str: x) proc str*(x: string): MalType {.procvar.} = MalType(kind: String, str: x) proc keyword*(x: string): MalType = MalType(kind: String, str: "\xff" & x) proc atom*(x: MalType): MalType = result = MalType(kind: Atom) result.val = x proc list*(xs: varargs[MalType]): MalType {.procvar.} = result = MalType(kind: List, list: newSeq[MalType](xs.len)) for i, x in xs: result.list[i] = x proc vector*(xs: varargs[MalType]): MalType {.procvar.} = result = MalType(kind: Vector, list: newSeq[MalType](xs.len)) for i, x in xs: result.list[i] = x proc hash_map*(xs: varargs[MalType]): MalType {.procvar.} = result = MalType(kind: HashMap, hash_map: initTable[string, MalType]()) for i in countup(0, xs.high, 2): let s = case xs[i].kind of String: xs[i].str else: xs[i].str result.hash_map[s] = xs[i+1] proc fun_is_macro*(x: MalType): bool = if x.kind == Fun: result = x.is_macro elif x.kind == MalFun: result = x.malfun.is_macro else: raise newException(ValueError, "no function") proc getFun*(x: MalType): FunType = if x.kind == Fun: result = x.fun elif x.kind == MalFun: result = x.malfun.fn else: raise newException(ValueError, "no function") proc fun*(x: proc(xs: varargs[MalType]): MalType, is_macro = false): MalType = MalType(kind: Fun, fun: x, is_macro: is_macro) proc malfun*(fn: auto, ast, params: MalType, env: Env, is_macro = false): MalType = MalType(kind: MalFun, malfun: MalFunType(fn: fn, ast: ast, params: params, env: env, is_macro: is_macro)) proc boolObj*(b: bool): MalType = if b: trueObj else: falseObj proc list_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == List proc vector_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Vector proc seq_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind in {List, Vector} proc hash_map_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == HashMap proc empty_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].list.len == 0 proc nil_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Nil proc true_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == True proc false_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == False proc string_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj(xs[0].kind == String and (xs[0].str.len == 0 or xs[0].str[0] != '\xff')) proc symbol*(xs: varargs[MalType]): MalType {.procvar.} = symbol(xs[0].str) proc symbol_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Symbol proc keyword*(xs: varargs[MalType]): MalType {.procvar.} = if 0 < xs[0].str.len and xs[0].str[0] == '\xff': xs[0] else: keyword(xs[0].str) proc keyword_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj(xs[0].kind == String and xs[0].str.len > 0 and xs[0].str[0] == '\xff') proc number_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Number proc fn_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj((xs[0].kind == MalFun or xs[0].kind == Fun) and not xs[0].fun_is_macro) proc macro_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj((xs[0].kind == MalFun or xs[0].kind == Fun) and xs[0].fun_is_macro) proc atom*(xs: varargs[MalType]): MalType {.procvar.} = atom(xs[0]) proc atom_q*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0].kind == Atom proc count*(xs: varargs[MalType]): MalType {.procvar.} = number if xs[0].kind == Nil: 0 else: xs[0].list.len proc `==`*(x, y: MalType): bool = if not (x.kind in {List, Vector} and y.kind in {List, Vector}): if x.kind != y.kind: return false result = case x.kind of Nil, True, False: true of Number: x.number == y.number of Symbol, String: x.str == y.str of List, Vector: x.list == y.list of HashMap: x.hash_map == y.hash_map of Fun: x.fun == y.fun and x.is_macro == y.is_macro of MalFun: x.malfun == y.malfun of Atom: x.val == y.val proc equal*(xs: varargs[MalType]): MalType {.procvar.} = boolObj xs[0] == xs[1] ================================================ FILE: impls/objc/Dockerfile ================================================ M ubuntu:vivid MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Based on: # https://blog.tlensing.org/2013/02/24/objective-c-on-linux-setting-up-gnustep-clang-llvm-objective-c-2-0-blocks-runtime-gcd-on-ubuntu-12-04/ RUN apt-get -y install build-essential clang libblocksruntime-dev \ libkqueue-dev libpthread-workqueue-dev gobjc libxml2-dev \ libjpeg-dev libtiff-dev libpng12-dev libcups2-dev \ libfreetype6-dev libcairo2-dev libxt-dev libgl1-mesa-dev RUN mkdir -p /root/gnustep-dev RUN cd /root/gnustep-dev && \ curl http://download.gna.org/gnustep/libobjc2-1.7.tar.bz2 \ | tar xjf - RUN cd /root/gnustep-dev && \ curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-make-2.6.7.tar.gz \ | tar xzf - RUN cd /root/gnustep-dev && \ curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-base-1.24.8.tar.gz \ | tar xzf - RUN cd /root/gnustep-dev && \ curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-gui-0.24.1.tar.gz \ | tar xzf - RUN cd /root/gnustep-dev && \ curl ftp://ftp.gnustep.org/pub/gnustep/core/gnustep-back-0.24.1.tar.gz \ | tar xzf - # TODO move up RUN apt-get -y install gnutls-dev libxslt-dev libffi-dev openssl ENV CC clang RUN cd /root/gnustep-dev/libobjc2-1.7 && make && make install RUN cd /root/gnustep-dev/gnustep-make-2.6.7 && ./configure && make && make install RUN cd /root/gnustep-dev/gnustep-base-1.24.8 && ./configure && make && make install && ldconfig RUN cd /root/gnustep-dev/gnustep-gui-0.24.1 && ./configure && make && make install RUN cd /root/gnustep-dev/gnustep-back-0.24.1 && ./configure && make && make install RUN apt-get -y install libdispatch-dev ENV HOME /mal ================================================ FILE: impls/objc/Makefile ================================================ STEP0_DEPS = mal_readline.c mal_readline.h STEP1_DEPS = $(STEP0_DEPS) types.h types.m reader.h reader.m printer.h printer.m STEP2_DEPS = $(STEP1_DEPS) STEP3_DEPS = $(STEP2_DEPS) env.m STEP4_DEPS = $(STEP3_DEPS) malfunc.h malfunc.m core.h core.m STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal # From: https://blog.tlensing.org/2013/02/24/objective-c-on-linux-setting-up-gnustep-clang-llvm-objective-c-2-0-blocks-runtime-gcd-on-ubuntu-12-04/: # clang `gnustep-config --objc-flags` -o main -x objective-c main.m -fconstant-string-class=NSConstantString -fobjc-nonfragile-abi -fblocks -lgnustep-base -lgnustep-gui -ldispatch -I/usr/local/include/GNUstep -L/usr/local/lib/GNUstep OS := $(shell uname) ## Bizzare gnustep-config/make interaction causes make to get run ## during gnustep-config so we need to remove make output ifeq ($(OS),Darwin) CC = clang -framework Foundation OBJC_LIBS := -lobjc -lreadline else #CC = clang -fblocks -fobjc-nonfragile-abi -fobjc-arc CC = clang -fblocks -fobjc-nonfragile-abi OBJC_FLAGS := $(shell gnustep-config --objc-flags 2>/dev/null | egrep -v "Entering|Leaving") OBJC_LIBS := $(filter-out -shared-libgcc,$(shell gnustep-config --base-libs 2>/dev/null | egrep -v "Entering|Leaving")) -ldispatch -lreadline endif all: $(STEPS) dist: mal mal: stepA_mal cp $< $@ step0_repl: $(STEP0_DEPS) step1_read_print: $(STEP1_DEPS) step2_eval: $(STEP2_DEPS) step3_env: $(STEP3_DEPS) step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) step%: step%.m $(CC) \ -xobjective-c $(filter-out %.h mal_readline%,$+) \ -xc mal_readline.c \ -o $@ \ $(OBJC_FLAGS) \ $(OBJC_LIBS) clean: rm -f $(STEPS) *.o *.d mal ================================================ FILE: impls/objc/core.h ================================================ #import @interface Core : NSObject + (NSDictionary *)ns; @end ================================================ FILE: impls/objc/core.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "malfunc.h" #import "core.h" #import NSObject * wrap_tf(BOOL val) { return val ? [MalTrue alloc] : [MalFalse alloc]; } @implementation Core + (NSDictionary *)ns { return @{ @"=": ^(NSArray *args){ return wrap_tf(equal_Q(args[0], args[1])); }, @"throw": ^(NSArray *args){ @throw args[0]; }, @"nil?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[NSNull class]]); }, @"true?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[MalTrue class]]); }, @"false?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[MalFalse class]]); }, @"string?": ^(NSArray *args){ return wrap_tf(string_Q(args[0])); }, @"symbol": ^(NSArray *args){ return [MalSymbol stringWithString:args[0]]; }, @"symbol?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[MalSymbol class]]); }, @"keyword": ^(NSArray *args){ if (string_Q(args[0])) { return [NSString stringWithFormat:@"\u029e%@", args[0]]; } else { return args[0]; } }, @"keyword?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[NSString class]] && ![args[0] isKindOfClass:[MalSymbol class]] && !string_Q(args[0])); }, @"number?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[NSNumber class]]); }, @"fn?": ^(NSArray *args){ return wrap_tf(block_Q(args[0]) || ([args[0] isKindOfClass:[MalFunc class]] && ![(MalFunc *)args[0] isMacro])); }, @"macro?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[MalFunc class]] && [(MalFunc *)args[0] isMacro]); }, @"pr-str": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; for (id e in args) { [res addObject:_pr_str(e,true)]; } return [res componentsJoinedByString:@" "]; }, @"str": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; for (id e in args) { [res addObject:_pr_str(e,false)]; } return [res componentsJoinedByString:@""]; }, @"prn": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; for (id e in args) { [res addObject:_pr_str(e,true)]; } printf("%s\n", [[res componentsJoinedByString:@" "] UTF8String]); fflush(stdout); return [NSNull alloc]; }, @"println": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; for (id e in args) { [res addObject:_pr_str(e,false)]; } printf("%s\n", [[res componentsJoinedByString:@" "] UTF8String]); fflush(stdout); return [NSNull alloc]; }, @"read-string": ^(NSArray *args){ return read_str(args[0]); }, @"readline": ^(NSArray *args){ char * rawline = _readline((char *)[(NSString *)args[0] UTF8String]); if (rawline) { return (NSObject *)[NSString stringWithUTF8String:rawline]; } else { return (NSObject *)[NSNull alloc]; } }, @"slurp": ^(NSArray *args){ return [NSString stringWithContentsOfFile:args[0] encoding: NSUTF8StringEncoding error: NULL]; }, @"<": ^(NSArray *args){ return wrap_tf([args[0] intValue] < [args[1] intValue]); }, @"<=": ^(NSArray *args){ return wrap_tf([args[0] intValue] <= [args[1] intValue]); }, @">": ^(NSArray *args){ return wrap_tf([args[0] intValue] > [args[1] intValue]); }, @">=": ^(NSArray *args){ return wrap_tf([args[0] intValue] >= [args[1] intValue]); }, @"+": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; }, @"-": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; }, @"*": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; }, @"/": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; }, @"time-ms": ^(NSArray *args){ long long ms = [[NSDate date] timeIntervalSince1970] * 1000; return [NSNumber numberWithUnsignedInteger:ms]; }, @"list": ^(NSArray *args){ return args; }, @"list?": ^(NSArray *args){ return wrap_tf(list_Q(args[0])); }, @"vector": ^(NSArray *args){ return [MalVector fromArray:args]; }, @"vector?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[MalVector class]]); }, @"hash-map": ^(NSArray *args){ return hash_map(args); }, @"map?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[NSDictionary class]]); }, @"assoc": ^(NSArray *args){ NSDictionary * dict = args[0]; NSMutableDictionary * new_dict = [[NSMutableDictionary alloc] initWithDictionary:dict copyItems:NO]; return assoc_BANG(new_dict, _rest(args)); }, @"dissoc": ^(NSArray *args){ NSDictionary * dict = args[0]; NSMutableDictionary * new_dict = [[NSMutableDictionary alloc] initWithDictionary:dict copyItems:NO]; for (NSString * key in _rest(args)) { [new_dict removeObjectForKey:key]; } return new_dict; }, @"get": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return (NSObject *)[NSNull alloc]; } NSObject * res = ((NSDictionary *)args[0])[args[1]]; return res ? res : [NSNull alloc]; }, @"contains?": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return wrap_tf(false); } return wrap_tf(((NSDictionary *)args[0])[args[1]] != nil); }, @"keys": ^(NSArray *args){ return [(NSDictionary *)args[0] allKeys]; }, @"vals": ^(NSArray *args){ return [(NSDictionary *)args[0] allValues]; }, @"sequential?": ^(NSArray *args){ return wrap_tf([args[0] isKindOfClass:[NSArray class]]); }, @"cons": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; [res addObject:args[0]]; [res addObjectsFromArray:args[1]]; return res; }, @"concat": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; for (NSArray * arr in args) { [res addObjectsFromArray:arr]; } return res; }, @"vec": ^(NSArray *args){ return [MalVector fromArray:args[0]]; }, @"nth": ^(NSArray *args){ NSArray * lst = (NSArray *)args[0]; int idx = [(NSNumber *)args[1] intValue]; if (idx < [lst count]) { return lst[idx]; } else { @throw @"nth: index out of range"; } }, @"first": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return (NSObject *)[NSNull alloc]; } NSArray * lst = (NSArray *)args[0]; if ([lst count] > 0) { return (NSObject *)lst[0]; } else { return (NSObject *)[NSNull alloc]; } }, @"rest": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return @[]; } NSArray * lst = (NSArray *)args[0]; if ([lst count] > 1) { return _rest(lst); } else { return @[]; } }, @"empty?": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return wrap_tf(true); } else { return wrap_tf([args[0] count] == 0); } }, @"count": ^(NSArray *args){ if ([args[0] isKindOfClass:[NSNull class]]) { return @0; } else { return [NSNumber numberWithInt:[args[0] count]]; } }, @"apply": ^(NSArray *args){ NSObject * (^ f)(NSArray *) = args[0]; NSMutableArray * fargs = [NSMutableArray array]; if ([args count] > 1) { NSRange r = NSMakeRange(1, [args count]-2); [fargs addObjectsFromArray:[args subarrayWithRange:r]]; } [fargs addObjectsFromArray:(NSArray *)[args lastObject]]; return apply(f, fargs); }, @"map": ^(NSArray *args){ NSObject * (^ f)(NSArray *) = args[0]; NSMutableArray * res = [NSMutableArray array]; for (NSObject * x in (NSArray *)args[1]) { [res addObject:apply(f, @[x])]; } return res; }, @"conj": ^(NSArray *args){ NSMutableArray * res = [NSMutableArray array]; if ([args[0] isKindOfClass:[MalVector class]]) { [res addObjectsFromArray:args[0]]; [res addObjectsFromArray:_rest(args)]; return (NSObject *)[MalVector fromArray:res]; } else { [res addObjectsFromArray:[[_rest(args) reverseObjectEnumerator] allObjects]]; [res addObjectsFromArray:args[0]]; return (NSObject *)res; } }, @"seq": ^(NSArray *args){ if (list_Q(args[0])) { if ([args[0] count] == 0) { return (NSObject *)[NSNull alloc]; } return (NSObject *)args[0]; } else if ([args[0] isKindOfClass:[MalVector class]]) { if ([args[0] count] == 0) { return (NSObject *)[NSNull alloc]; } return (NSObject *)[NSArray arrayWithArray:args[0]]; } else if (string_Q(args[0])) { NSString * str = args[0]; if ([str length] == 0) { return (NSObject *)[NSNull alloc]; } NSMutableArray * res = [NSMutableArray array]; for (int i=0; i < [str length]; i++) { char c = [str characterAtIndex:i]; [res addObject:[NSString stringWithFormat:@"%c", c]]; } return (NSObject *)res; } else if ([args[0] isKindOfClass:[NSNull class]]) { return (NSObject *)args[0]; } else { @throw @"seq: called on non-sequence"; } }, @"meta": ^id (NSArray *args){ if ([args[0] isKindOfClass:[MalFunc class]]) { return [(MalFunc *)args[0] meta]; } else { id res = objc_getAssociatedObject(args[0], @"meta"); return res ? res : (NSObject *)[NSNull alloc]; } }, @"with-meta": ^id (NSArray *args){ if ([args[0] isKindOfClass:[MalFunc class]]) { MalFunc * cmf = [(MalFunc *)args[0] copy]; cmf.meta = args[1]; return cmf; } else if (!block_Q(args[0])) { id res = [args[0] copy]; objc_setAssociatedObject(res, @"meta", args[1], OBJC_ASSOCIATION_RETAIN_NONATOMIC); return res; } else { id (^blk)(NSArray *args) = args[0]; id (^wrapBlock)(NSArray *args) = ^id (NSArray *args) { return blk(args); }; id (^res)(NSArray *args) = [wrapBlock copy]; // under mrc: copy to get a malloc block instead of a stack block. objc_setAssociatedObject(res, @"meta", args[1], OBJC_ASSOCIATION_RETAIN_NONATOMIC); return res; } }, @"atom": ^(NSArray *args){ return [MalAtom fromObject:args[0]]; }, @"atom?": ^(NSArray *args){ return wrap_tf(atom_Q(args[0])); }, @"deref": ^(NSArray *args){ return [(MalAtom *)args[0] val]; }, @"reset!": ^(NSArray *args){ MalAtom * atm = (MalAtom *)args[0]; return atm.val = args[1]; }, @"swap!": ^(NSArray *args){ MalAtom * atm = (MalAtom *)args[0]; NSObject * (^ f)(NSArray *) = args[1]; NSMutableArray * fargs = [NSMutableArray array]; [fargs addObject:atm.val]; if ([args count] > 2) { NSRange r = NSMakeRange(2, [args count]-2); [fargs addObjectsFromArray:[args subarrayWithRange:r]]; } return atm.val = apply(f, fargs); }, }; } @end ================================================ FILE: impls/objc/env.h ================================================ #import // See types.h for Env interface definition ================================================ FILE: impls/objc/env.m ================================================ #import #import "types.h" //#import "env.h" @implementation Env @synthesize data = _data; @synthesize outer = _outer; - (id)initWithBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs { self = [super init]; if (self) { _outer = outer; _data = [NSMutableDictionary dictionary]; for (int i=0; i < [binds count]; i++) { if ([(NSString *)binds[i] isEqualTo:@"&"]) { if ([exprs count] > i) { NSRange r = NSMakeRange(i, [exprs count] - i); _data[binds[i+1]] = [exprs subarrayWithRange:r]; } else { _data[binds[i+1]] = @[]; } break; } else { _data[binds[i]] = exprs[i]; } } } return self; } - (id)initWithOuter:(Env *)outer { return [self initWithBindings:outer binds:@[] exprs:@[]]; } - (id)init { return [self initWithBindings:nil binds:@[] exprs:@[]]; } + (id)fromOuter:(Env *)outer { return [[Env alloc] initWithOuter:outer]; } + (id)fromBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs { return [[Env alloc] initWithBindings:outer binds:binds exprs:exprs]; } - (NSObject *) set:(MalSymbol *)key val:(NSObject *)val { _data[key] = val; return val; } - (NSObject *) get:(MalSymbol *)key { NSObject * value; Env * e = self; while (true) { value = e.data[key]; if (value != nil) return value; e = e.outer; if (e == nil) return nil; } } @end ================================================ FILE: impls/objc/mal_readline.c ================================================ #include #include #include #if USE_READLINE #include #include #include #else #include #endif int history_loaded = 0; char HISTORY_FILE[] = "~/.mal-history"; void load_history() { if (history_loaded) { return; } int ret; char *hf = tilde_expand(HISTORY_FILE); if (access(hf, F_OK) != -1) { // TODO: check if file exists first, use non-static path #if USE_READLINE ret = read_history(hf); #else FILE *fp = fopen(hf, "r"); char *line = malloc(80); // getline reallocs as necessary size_t sz = 80; while ((ret = getline(&line, &sz, fp)) > 0) { add_history(line); // Add line to in-memory history } free(line); fclose(fp); #endif history_loaded = 1; } free(hf); } void append_to_history() { char *hf = tilde_expand(HISTORY_FILE); #ifdef USE_READLINE append_history(1, hf); #else #if defined(RL_READLINE_VERSION) HIST_ENTRY *he = history_get(history_base+history_length-1); #else // libedit-2 segfaults if we add history_base HIST_ENTRY *he = history_get(history_length-1); #endif FILE *fp = fopen(hf, "a"); if (fp) { fprintf(fp, "%s\n", he->line); fclose(fp); } #endif free(hf); } // line must be freed by caller char *_readline (char prompt[]) { char *line; load_history(); line = readline(prompt); if (!line) return NULL; // EOF add_history(line); // Add input to in-memory history append_to_history(); // Flush new line of history to disk return line; } ================================================ FILE: impls/objc/mal_readline.h ================================================ #ifndef __MAL_READLINE__ #define __MAL_READLINE__ char *_readline (char prompt[]); #endif ================================================ FILE: impls/objc/malfunc.h ================================================ #import /* // Forward declaration of Env (see env.h for full interface) @class Env; */ // Forward declaration of EVAL function NSObject *EVAL(id ast, id env); @interface MalFunc : NSObject @property (copy) NSArray * ast; @property (copy) Env * env; @property (copy) NSArray * params; @property BOOL isMacro; @property (copy) NSObject * meta; - (id)init:(NSArray *)ast env:(Env *)env params:(NSArray *)params; - (id)apply:(NSArray *)args; @end NSObject * apply(id f, NSArray *args); ================================================ FILE: impls/objc/malfunc.m ================================================ #import "types.h" #import "malfunc.h" @implementation MalFunc @synthesize ast = _ast; @synthesize env = _env; @synthesize params = _params; @synthesize isMacro = _isMacro; @synthesize meta = _meta; - (id)init:(NSArray *)ast env:(Env *)env params:(NSArray *)params { self = [super init]; if (self) { _ast = ast; _env = env; _params = params; _isMacro = false; _meta = [NSNull alloc]; } return self; } - (id)apply:(NSArray *)args { return EVAL(_ast, [Env fromBindings:_env binds:_params exprs:args]); } - (id)copyWithZone:(NSZone *)zone { MalFunc * copy = [[[self class] alloc] init:_ast env:_env params:_params]; if (copy) { copy.isMacro = _isMacro; copy.meta = _meta; } return copy; } @end NSObject * apply(id f, NSArray *args) { if ([f isKindOfClass:[MalFunc class]]) { return [f apply:args]; } else { NSObject * (^ fn)(NSArray *) = f; return fn(args); } } ================================================ FILE: impls/objc/printer.h ================================================ #import NSString * _pr_str(NSObject * obj, BOOL print_readably); ================================================ FILE: impls/objc/printer.m ================================================ #import #import "types.h" NSString * _pr_str(NSObject * obj, BOOL print_readably) { //NSLog(@"class: %@", [obj class]); if ([obj isMemberOfClass:[NSNull class]]) { return @"nil"; } else if ([obj isMemberOfClass:[MalTrue class]]) { return @"true"; } else if ([obj isMemberOfClass:[MalFalse class]]) { return @"false"; } else if ([obj isKindOfClass:[MalSymbol class]]) { return (NSString *) obj; } else if ([obj isKindOfClass:[NSString class]]) { NSString * str = (NSString *)obj; if ([str length] > 0 && ([str hasPrefix:@"\u029e"])) { return [NSString stringWithFormat:@":%@", [str substringWithRange:NSMakeRange(1, [str length]-1)]]; } else if (print_readably) { str = [[[(NSString *)obj stringByReplacingOccurrencesOfString:@"\\" withString:@"\\\\"] stringByReplacingOccurrencesOfString:@"\"" withString:@"\\\""] stringByReplacingOccurrencesOfString:@"\n" withString:@"\\n"]; return [NSString stringWithFormat:@"\"%@\"", str]; } else { return [NSString stringWithString:str]; } } else if ([obj isKindOfClass:[NSArray class]]) { NSMutableArray * elems = [NSMutableArray array]; for (NSObject * elem in (NSArray *)obj) { [elems addObject:_pr_str(elem, print_readably)]; } if ([obj isKindOfClass:[MalVector class]]) { return [NSString stringWithFormat:@"[%@]", [elems componentsJoinedByString:@" "]]; } else { return [NSString stringWithFormat:@"(%@)", [elems componentsJoinedByString:@" "]]; } } else if ([obj isKindOfClass:[NSDictionary class]]) { NSDictionary * dict = (NSDictionary *)obj; NSMutableArray * elems = [NSMutableArray array]; for (NSString * key in dict) { [elems addObject:_pr_str(key, print_readably)]; [elems addObject:_pr_str(dict[key], print_readably)]; } return [NSString stringWithFormat:@"{%@}", [elems componentsJoinedByString:@" "]]; } else if (block_Q(obj)) { return @"#"; } else if (atom_Q(obj)) { return [NSString stringWithFormat:@"(atom %@)", _pr_str([(MalAtom *)obj val], print_readably)]; } else { return [obj description]; } } ================================================ FILE: impls/objc/reader.h ================================================ NSArray * tokenize(NSString *str); NSObject * read_str(NSString *str); ================================================ FILE: impls/objc/reader.m ================================================ #import #import "types.h" // Only used here, so define interface locally @interface Reader : NSObject - (id)initWithTokens:(NSArray *)toks; - (id)init; - (NSString *) next; - (NSString *) peek; @end @implementation Reader NSArray *_tokens; int _position; - (id)initWithTokens:(NSArray *)toks { self = [super init]; if (self) { _tokens = toks; _position = 0; } return self; } - (id)init { return [self initWithTokens:@[]]; } - (NSString *)next { _position++; return _tokens[_position-1]; } - (NSString *)peek { if ([_tokens count] > _position) { return _tokens[_position]; } else { return nil; } } @end NSArray * tokenize(NSString *str) { NSRegularExpression *regex = [NSRegularExpression regularExpressionWithPattern:@"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)" options:0 error:NULL]; NSArray *matches = [regex matchesInString:str options:0 range:NSMakeRange(0, [str length])]; NSMutableArray * tokens = [NSMutableArray array]; for (NSTextCheckingResult *match in matches) { NSString * mstr = [str substringWithRange:[match rangeAtIndex:1]]; if ([mstr characterAtIndex:0] == ';') { continue; } [tokens addObject:mstr]; } return tokens; } NSObject * read_atom(Reader * rdr) { NSRegularExpression *regex = [NSRegularExpression regularExpressionWithPattern:@"(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"((?:[\\\\].|[^\\\\\"])*)\"$|^\"(.*)$|:(.*)|(^[^\"]*$)" options:0 error:NULL]; NSNumberFormatter *numf = [[NSNumberFormatter alloc] init]; numf.numberStyle = NSNumberFormatterDecimalStyle; NSString *token = [rdr next]; NSArray *matches = [regex matchesInString:token options:0 range:NSMakeRange(0, [token length])]; if ([matches count] > 0) { NSTextCheckingResult *match = matches[0]; if ([match rangeAtIndex:1].location < -1ULL/2) { // integer return [numf numberFromString:token]; } else if ([match rangeAtIndex:2].location < -1ULL/2) { // float return [numf numberFromString:token]; } else if ([match rangeAtIndex:3].location < -1ULL/2) { // nil return [NSNull alloc]; } else if ([match rangeAtIndex:4].location < -1ULL/2) { // true return [MalTrue alloc]; // TODO: intern } else if ([match rangeAtIndex:5].location < -1ULL/2) { // false return [MalFalse alloc]; // TODO: intern } else if ([match rangeAtIndex:6].location < -1ULL/2) { // string NSString * str = [token substringWithRange:[match rangeAtIndex:6]]; return [[[[str stringByReplacingOccurrencesOfString:@"\\\\" withString:@"\u029e"] stringByReplacingOccurrencesOfString:@"\\\"" withString:@"\""] stringByReplacingOccurrencesOfString:@"\\n" withString:@"\n"] stringByReplacingOccurrencesOfString:@"\u029e" withString:@"\\"]; } else if ([match rangeAtIndex:7].location < -1ULL/2) { // string @throw @"read_atom: expected '\"', got EOF"; } else if ([match rangeAtIndex:8].location < -1ULL/2) { // keyword return [NSString stringWithFormat:@"\u029e%@", [token substringWithRange:[match rangeAtIndex:8]]]; } else if ([match rangeAtIndex:9].location < -1ULL/2) { // symbol return [MalSymbol stringWithString:token]; } } @throw @"read_atom: invalid token"; } // Only used locally, so declare here NSObject * read_form(Reader * rdr); NSArray * read_list(Reader * rdr, char start, char end) { NSString * token = [rdr next]; NSMutableArray * ast = [NSMutableArray array]; if ([token characterAtIndex:0] != start) { @throw [NSString stringWithFormat:@"expected '%c'", start]; } while ((token = [rdr peek]) && ([token characterAtIndex:0] != end)) { [ast addObject:read_form(rdr)]; } if (!token) { @throw [NSString stringWithFormat:@"expected '%c', got EOF", end]; } [rdr next]; return ast; } NSObject * read_form(Reader * rdr) { NSString *token = [rdr peek]; switch ([token characterAtIndex:0]) { case '\'': [rdr next]; return @[[MalSymbol stringWithString:@"quote"], read_form(rdr)]; case '`': [rdr next]; return @[[MalSymbol stringWithString:@"quasiquote"], read_form(rdr)]; case '~': [rdr next]; if ([token isEqualToString:@"~@"]) { return @[[MalSymbol stringWithString:@"splice-unquote"], read_form(rdr)]; } else { return @[[MalSymbol stringWithString:@"unquote"], read_form(rdr)]; } case '^': [rdr next]; NSObject * meta = read_form(rdr); return @[[MalSymbol stringWithString:@"with-meta"], read_form(rdr), meta]; case '@': [rdr next]; return @[[MalSymbol stringWithString:@"deref"], read_form(rdr)]; // lists case ')': @throw @"unexpected ')'"; case '(': return read_list(rdr, '(', ')'); // vectors case ']': @throw @"unexpected ']'"; case '[': return [MalVector fromArray:read_list(rdr, '[', ']')]; // hash maps case '}': @throw @"unexpected '}'"; case '{': return hash_map(read_list(rdr, '{', '}')); default: return read_atom(rdr); } } NSObject * read_str(NSString *str) { NSArray * tokens = tokenize(str); if ([tokens count] == 0) { @throw [NSException exceptionWithName:@"ReaderContinue" reason:@"empty token" userInfo:nil]; } //if ([tokens count] == 0) { @throw [[MalContinue alloc] init]; } return read_form([[Reader alloc] initWithTokens:tokens]); } ================================================ FILE: impls/objc/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/objc/step0_repl.m ================================================ #import #import "mal_readline.h" NSString *READ(NSString *str) { return str; } NSString *EVAL(NSString *ast, NSString *env) { return ast; } NSString *PRINT(NSString *exp) { return exp; } NSString *REP(NSString *line) { return PRINT(EVAL(READ(line), @"")); } int main () { // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } printf("%s\n", [[REP(line) description] UTF8String]); } [pool drain]; // } } ================================================ FILE: impls/objc/step1_read_print.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" NSObject *READ(NSString *str) { return read_str(str); } NSObject *EVAL(NSObject *ast, NSString *env) { return ast; } NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } NSString *REP(NSString *line) { return PRINT(EVAL(READ(line), @"")); } int main () { // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step2_eval.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval NSObject *EVAL(NSObject *ast, NSDictionary *env) { // NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); if ([ast isMemberOfClass:[MalSymbol class]]) { if ([env objectForKey:ast]) { return env[ast]; } else { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id el0 = EVAL(alst[0], env); NSObject * (^ f)(NSArray *) = el0; NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } return f(args); } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, NSDictionary *env) { return PRINT(EVAL(READ(line), env)); } int main () { NSDictionary * repl_env = @{ @"+": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; }, @"-": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; }, @"*": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; }, @"/": ^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; }, }; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step3_env.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval NSObject *EVAL(NSObject *ast, Env *env) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; if (![a0 isKindOfClass:[MalSymbol class]]) { @throw @"attempt to apply on non-symbol"; } if ([(NSString *)a0 isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } return EVAL(alst[2], let_env); } else { id el0 = EVAL(a0, env); NSObject * (^ f)(NSArray *) = el0; NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } return f(args); } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { Env * repl_env = [[Env alloc] init]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { [repl_env set:(MalSymbol *)@"+" val:^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] + [args[1] intValue]]; }]; [repl_env set:(MalSymbol *)@"-" val:^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] - [args[1] intValue]]; }]; [repl_env set:(MalSymbol *)@"*" val:^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] * [args[1] intValue]]; }]; [repl_env set:(MalSymbol *)@"/" val:^(NSArray *args){ return [NSNumber numberWithInt:[args[0] intValue] / [args[1] intValue]]; }]; while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step4_if_fn_do.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval NSObject *EVAL(NSObject *ast, Env *env) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } return EVAL(alst[2], let_env); } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } return EVAL([alst lastObject], env); } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { return EVAL(alst[3], env); } else { return [NSNull alloc]; } } else { return EVAL(alst[2], env); } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } return apply(el0, args); } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { Env * repl_env = [[Env alloc] init]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step5_tco.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval NSObject *EVAL(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { Env * repl_env = [[Env alloc] init]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step6_file.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval NSObject *EVAL(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { // Outside of pool to prevent "Block_release called upon // a stack..." message on exit Env * repl_env = [[Env alloc] init]; NSArray *args = [[NSProcessInfo processInfo] arguments]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { return EVAL(args[0], repl_env); }]; NSArray *argv = @[]; if ([args count] > 2) { argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; } [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if ([args count] > 1) { @try { REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } return 0; } while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step7_quote.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval 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 ([ast isMemberOfClass:[MalSymbol class]] || [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; 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(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { // Outside of pool to prevent "Block_release called upon // a stack..." message on exit Env * repl_env = [[Env alloc] init]; NSArray *args = [[NSProcessInfo processInfo] arguments]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { return EVAL(args[0], repl_env); }]; NSArray *argv = @[]; if ([args count] > 2) { argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; } [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if ([args count] > 1) { @try { REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } return 0; } while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step8_macros.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval 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 ([ast isMemberOfClass:[MalSymbol class]] || [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; 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(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; f.isMacro = true; return [env set:alst[1] val:f]; } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; if ([mf isMacro]) { NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:alst[i]]; } ast = [mf apply:args]; continue; // TCO } } NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { // Outside of pool to prevent "Block_release called upon // a stack..." message on exit Env * repl_env = [[Env alloc] init]; NSArray *args = [[NSProcessInfo processInfo] arguments]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { return EVAL(args[0], repl_env); }]; NSArray *argv = @[]; if ([args count] > 2) { argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; } [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if ([args count] > 1) { @try { REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } return 0; } while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/step9_try.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval 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 ([ast isMemberOfClass:[MalSymbol class]] || [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; 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(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; f.isMacro = true; return [env set:alst[1] val:f]; } else if ([a0sym isEqualTo:@"try*"]) { @try { return EVAL(alst[1], env); } @catch(NSObject *e) { if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) { NSArray * a2lst = alst[2]; if ([a2lst[0] isKindOfClass:[MalSymbol class]] && [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) { NSObject * exc = e; if ([e isKindOfClass:[NSException class]]) { exc = [e description]; } return EVAL(a2lst[2], [Env fromBindings:env binds:@[a2lst[1]] exprs:@[exc]]); } } @throw e; } } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; if ([mf isMacro]) { NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:alst[i]]; } ast = [mf apply:args]; continue; // TCO } } NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { // Outside of pool to prevent "Block_release called upon // a stack..." message on exit Env * repl_env = [[Env alloc] init]; NSArray *args = [[NSProcessInfo processInfo] arguments]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { return EVAL(args[0], repl_env); }]; NSArray *argv = @[]; if ([args count] > 2) { argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; } [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; // core.mal: defined using the language itself REP(@"(def! not (fn* (a) (if a false true)))", repl_env); REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if ([args count] > 1) { @try { REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } return 0; } while (true) { char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/stepA_mal.m ================================================ #import #import "mal_readline.h" #import "types.h" #import "reader.h" #import "printer.h" #import "env.h" #import "malfunc.h" #import "core.h" // read NSObject *READ(NSString *str) { return read_str(str); } // eval 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 ([ast isMemberOfClass:[MalSymbol class]] || [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; 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(NSObject *ast, Env *env) { while (true) { NSObject * dbgeval = [env get:[MalSymbol stringWithString:@"DEBUG-EVAL"]]; if (dbgeval != nil && ! [dbgeval isKindOfClass:[NSNull class]] && ! [dbgeval isKindOfClass:[MalFalse class]]) { printf("EVAL: %s\n", [[_pr_str(ast, true) description] UTF8String]); } if ([ast isMemberOfClass:[MalSymbol class]]) { NSObject * value = [env get:(MalSymbol *)ast]; if (value == nil) { @throw [NSString stringWithFormat:@"'%@' not found", ast]; } return value; } else if ([ast isKindOfClass:[MalVector class]]) { NSMutableArray *newLst = [NSMutableArray array]; for (NSObject * x in (NSArray *)ast) { [newLst addObject:EVAL(x, env)]; } return [MalVector fromArray:newLst]; } else if ([ast isKindOfClass:[NSDictionary class]]) { NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; for (NSString * k in (NSDictionary *)ast) { newDict[k] = EVAL(((NSDictionary *)ast)[k], env); } return newDict; } else if (! [ast isKindOfClass:[NSArray class]]) { return ast; } // apply list NSArray * alst = (NSArray *)ast; if ([alst count] == 0) { return ast; } id a0 = alst[0]; NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 : @"__<*fn*>__"; if ([a0sym isEqualTo:@"def!"]) { return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; } else if ([(NSString *)a0 isEqualTo:@"let*"]) { Env *let_env = [Env fromOuter:env]; NSArray * binds = (NSArray *)alst[1]; for (int i=0; i < [binds count]; i+=2) { [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; } env = let_env; ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { MalFunc * f = [(MalFunc *)EVAL(alst[2], env) copy]; f.isMacro = true; return [env set:alst[1] val:f]; } else if ([a0sym isEqualTo:@"try*"]) { @try { return EVAL(alst[1], env); } @catch(NSObject *e) { if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) { NSArray * a2lst = alst[2]; if ([a2lst[0] isKindOfClass:[MalSymbol class]] && [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) { NSObject * exc = e; if ([e isKindOfClass:[NSException class]]) { exc = [e description]; } return EVAL(a2lst[2], [Env fromBindings:env binds:@[a2lst[1]] exprs:@[exc]]); } } @throw e; } } else if ([a0sym isEqualTo:@"do"]) { for (int i=1; i < [alst count] - 1; i++) { EVAL(alst[i], env); } ast = [alst lastObject]; // TCO } else if ([a0sym isEqualTo:@"if"]) { NSObject * cond = EVAL(alst[1], env); if ([cond isKindOfClass:[NSNull class]] || [cond isKindOfClass:[MalFalse class]]) { if ([alst count] > 3) { ast = alst[3]; // TCO } else { return [NSNull alloc]; } } else { ast = alst[2]; // TCO } } else if ([a0sym isEqualTo:@"fn*"]) { return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; } else { id el0 = EVAL(a0, env); if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; if ([mf isMacro]) { NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:alst[i]]; } ast = [mf apply:args]; continue; // TCO } } NSMutableArray * args = [NSMutableArray array]; for (int i = 1; i < [alst count]; i++) { [args addObject:EVAL(alst[i], env)]; } if ([el0 isKindOfClass:[MalFunc class]]) { MalFunc * mf = el0; env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; ast = [mf ast]; // TCO } else { NSObject * (^ f)(NSArray *) = el0; return f(args); } } } } // print NSString *PRINT(NSObject *exp) { return _pr_str(exp, true); } // REPL NSString *REP(NSString *line, Env *env) { return PRINT(EVAL(READ(line), env)); } int main () { // Outside of pool to prevent "Block_release called upon // a stack..." message on exit Env * repl_env = [[Env alloc] init]; NSArray *args = [[NSProcessInfo processInfo] arguments]; // Create an autorelease pool to manage the memory into the program NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; // If using automatic reference counting (ARC), use @autoreleasepool instead: // @autoreleasepool { // core.m: defined using Objective-C NSDictionary * core_ns = [Core ns]; for (NSString* key in core_ns) { [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; } [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { return EVAL(args[0], repl_env); }]; NSArray *argv = @[]; if ([args count] > 2) { argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; } [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; // core.mal: defined using the language itself REP(@"(def! *host-language* \"Objective-C\")", repl_env); REP(@"(def! not (fn* (a) (if a false true)))", repl_env); REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if ([args count] > 1) { @try { REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } return 0; } while (true) { REP(@"(println (str \"Mal [\" *host-language* \"]\"))", repl_env); char *rawline = _readline("user> "); if (!rawline) { break; } NSString *line = [NSString stringWithUTF8String:rawline]; if ([line length] == 0) { continue; } @try { printf("%s\n", [[REP(line, repl_env) description] UTF8String]); } @catch(NSString *e) { printf("Error: %s\n", [e UTF8String]); } @catch(NSObject *e) { NSObject * exc = e; printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); } @catch(NSException *e) { if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } printf("Exception: %s\n", [[e reason] UTF8String]); } } [pool drain]; // } } ================================================ FILE: impls/objc/tests/step5_tco.mal ================================================ ;; Objective C: skipping non-TCO recursion ;; Reason: completes at 10,000, unrecoverable segfault at 20,000 ================================================ FILE: impls/objc/types.h ================================================ #import // // Env definition // @class MalSymbol; @interface Env : NSObject @property (copy) NSMutableDictionary * data; @property (copy) Env * outer; - (id)initWithBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs; - (id)initWithOuter:(Env *)outer; - (id)init; + (id)fromOuter:(Env *)outer; + (id)fromBindings:(Env *)outer binds:(NSArray *)binds exprs:(NSArray *)exprs; - (NSObject *) set:(MalSymbol *)key val:(NSObject *)val; - (NSObject *) get:(MalSymbol *)key; @end // // Mal Types // @interface MalTrue : NSObject @end @interface MalFalse : NSObject @end @interface MalSymbol: NSString @end BOOL string_Q(NSObject * obj); // Lists BOOL list_Q(id obj); NSArray * _rest(NSArray * obj); // Vectors @interface MalVector : NSArray @property (copy) NSArray * array; @property(readonly) NSUInteger count; - (id)initWithArray:(NSArray *)arr; - (id)init; + (id)fromArray:(NSArray *)arr; - (id)objectAtIndex:(NSUInteger)index; @end // Hash Maps NSDictionary * assoc_BANG(NSMutableDictionary * d, NSArray * kvs); NSDictionary * hash_map(NSArray *kvs); // Mal Functions BOOL block_Q(id obj); // Atoms @interface MalAtom : NSObject @property (copy) NSObject * val; - (id)init:(NSObject *)val; + (id)fromObject:(NSObject *)val; @end BOOL atom_Q(id obj); // General functions BOOL equal_Q(NSObject * a, NSObject * b); ================================================ FILE: impls/objc/types.m ================================================ #import "types.h" @implementation MalTrue @end @implementation MalFalse @end // NSString subclassing based on: // http://stackoverflow.com/a/21331422/471795 // Symbols @interface MalSymbol () @property (nonatomic, strong) NSString *stringHolder; @end @implementation MalSymbol - (instancetype)initWithCharactersNoCopy:(unichar *)characters length:(NSUInteger)length freeWhenDone:(BOOL)freeBuffer { self = [super init]; if (self) { self.stringHolder = [[NSString alloc] initWithCharactersNoCopy:characters length:length freeWhenDone:freeBuffer]; } return self; } - (NSUInteger)length { return self.stringHolder.length; } - (unichar)characterAtIndex:(NSUInteger)index { return [self.stringHolder characterAtIndex:index]; } @end BOOL string_Q(id obj) { if ([obj isKindOfClass:[NSString class]]) { NSString * s = obj; if (![s isKindOfClass:[MalSymbol class]]) { return ![s hasPrefix:@"\u029e"]; } } return false; } // Lists BOOL list_Q(id obj) { return ([obj isKindOfClass:[NSArray class]] && ![obj isKindOfClass:[MalVector class]]); } NSArray * _rest(NSArray * obj) { return [obj subarrayWithRange:NSMakeRange(1, [obj count]-1)]; } // Vectors @implementation MalVector @synthesize array = _array; @synthesize count = _count; - (id)initWithArray:(NSArray *)arr { self = [self init]; if (self) { _array = arr; _count = [arr count]; } return self; } - (id)init { self = [super init]; if (self) { _array = @[]; _count = 0; } return self; } + (id)fromArray:(NSArray *)arr { return [[MalVector alloc] initWithArray:arr]; } - (id)objectAtIndex:(NSUInteger)index { return _array[index]; } - (id)copyWithZone:(NSZone *)zone { return [[MalVector alloc] initWithArray:[_array copy]]; } @end // Hash Maps NSDictionary * assoc_BANG(NSMutableDictionary * d, NSArray * kvs) { for (int i=0; i < [kvs count]; i+=2) { d[kvs[i]] = kvs[i+1]; } return d; } NSDictionary * hash_map(NSArray *kvs) { return assoc_BANG([NSMutableDictionary dictionary], kvs); } // Mal Functions BOOL block_Q(id obj) { id block = ^{}; Class blockClass = [block class]; while ([blockClass superclass] != [NSObject class]) { blockClass = [blockClass superclass]; } return [obj isKindOfClass:blockClass]; } @implementation MalAtom @synthesize val = _val; - (id)init:(NSObject *)val { self = [super init]; if (self) { _val = val; } return self; } + (id)fromObject:(NSObject *)val { return [[MalAtom alloc] init:val]; } @end BOOL atom_Q(id obj) { return [obj isKindOfClass:[MalAtom class]]; } // General functions BOOL sequential_Q(NSObject * obj) { return [obj isKindOfClass:[NSArray class]]; } BOOL equal_Q(NSObject * a, NSObject * b) { //NSLog(@"= %@ (%@), %@ (%@)", a, [a class], b, [b class]); if (!(([a class] == [b class]) || ([a isKindOfClass:[NSArray class]] && [b isKindOfClass:[NSArray class]]) || ([a isKindOfClass:[NSNumber class]] && [b isKindOfClass:[NSNumber class]]) || (string_Q(a) && string_Q(b)))) { return false; } if ([a isKindOfClass:[MalTrue class]]) { return true; } else if ([a isKindOfClass:[MalFalse class]]) { return true; } else if ([a isKindOfClass:[NSNumber class]]) { return [(NSNumber *)a intValue] == [(NSNumber *)b intValue]; } else { return [a isEqual:b]; } } ================================================ FILE: impls/objpascal/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Free Pascal RUN apt-get -y install libc-dev fp-compiler libedit-dev ================================================ FILE: impls/objpascal/Makefile ================================================ STEPS = step0_repl.pas step1_read_print.pas step2_eval.pas \ step3_env.pas step4_if_fn_do.pas step5_tco.pas \ step6_file.pas step7_quote.pas step8_macros.pas \ step9_try.pas stepA_mal.pas STEP0_DEPS = mal_readline.pas STEP1_DEPS = $(STEP0_DEPS) mal_types.pas reader.pas printer.pas STEP3_DEPS = $(STEP1_DEPS) mal_env.pas STEP4_DEPS = $(STEP3_DEPS) core.pas ##################### DEBUG = -gl # Set this to link with libreadline instead of libedit USE_READLINE = FPC = fpc -MOBJFPC -ve -Furegexpr/Source $(DEBUG) $(if $(strip $(USE_READLINE)),-dUSE_READLINE,) all: $(patsubst %.pas,%,$(STEPS)) step%: step%.pas $(FPC) $< step0_repl: $(STEP0_DEPS) step1_read_print step2_eval: $(STEP1_DEPS) step3_env: $(STEP3_DEPS) step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) clean: rm -f $(STEPS:%.pas=%) *.o *.ppu regexpr/Source/*.o regexpr/Source/*.ppu mal ================================================ FILE: impls/objpascal/core.pas ================================================ unit core; {$H+} // Use AnsiString interface uses Classes, sysutils, fgl, mal_readline, mal_types, mal_func, mal_env, reader, printer; type TCoreDict = specialize TFPGMap; var EVAL : function (A: TMal; E: TEnv) : TMal; NS : TCoreDict; //////////////////////////////////////////////////////////// implementation // General functions function equal_Q(Args: TMalArray) : TMal; begin equal_Q := wrap_tf(_equal_Q(Args[0], Args[1])); end; function throw(Args: TMalArray) : TMal; begin raise TMalException.Create(Args[0]); throw := TMalNil.Create; // Not reached end; // Scalar functions function nil_Q(Args: TMalArray) : TMal; begin nil_Q := wrap_tf(Args[0] is TMalNil); end; function true_Q(Args: TMalArray) : TMal; begin true_Q := wrap_tf(Args[0] is TMalTrue); end; function false_Q(Args: TMalArray) : TMal; begin false_Q := wrap_tf(Args[0] is TMalFalse); end; function number_Q(Args: TMalArray) : TMal; begin number_Q := wrap_tf(Args[0] is TMalInt); end; function string_Q(Args: TMalArray) : TMal; begin string_Q := wrap_tf(_string_Q(Args[0])); end; function symbol(Args: TMalArray) : TMal; begin if Args[0] is TMalSymbol then symbol := Args[0] else if Args[0] is TMalString then symbol := TMalSymbol.Create((Args[0] as TMalString).Val) else raise Exception.Create('Invalid symbol call'); end; function symbol_Q(Args: TMalArray) : TMal; begin symbol_Q := wrap_tf(Args[0] is TMalSymbol); end; function keyword(Args: TMalArray) : TMal; begin if ((Args[0] is TMalString) and not _string_Q(Args[0])) then keyword := Args[0] else if Args[0] is TMalString then keyword := TMalString.Create(#127 + (Args[0] as TMalString).Val) else raise Exception.Create('Invalid keyword call'); end; function keyword_Q(Args: TMalArray) : TMal; begin keyword_Q := wrap_tf((Args[0] is TMalString) and not _string_Q(Args[0])); end; function fn_Q(Args: TMalArray) : TMal; begin if Args[0] is TMalFunc then fn_Q := wrap_tf(not (Args[0] as TMalFunc).isMacro) else fn_Q := TMalFalse.Create; end; function macro_Q(Args: TMalArray) : TMal; begin if Args[0] is TMalFunc then macro_Q := wrap_tf((Args[0] as TMalFunc).isMacro) else macro_Q := TMalFalse.Create; end; // String functions function do_pr_str(Args: TMalArray) : TMal; begin do_pr_str := TMalString.Create(pr_str_array(Args, true, ' ')); end; function str(Args: TMalArray) : TMal; begin str := TMalString.Create(pr_str_array(Args, false, '')); end; function prn(Args: TMalArray) : TMal; begin WriteLn(pr_str_array(Args, true, ' ')); prn := TMalNil.Create; end; function println(Args: TMalArray) : TMal; begin WriteLn(pr_str_array(Args, false, ' ')); println := TMalNil.Create; end; function read_string(Args: TMalArray) : TMal; begin read_string := read_str((Args[0] as TMalString).Val); end; function do_readline(Args: TMalArray) : TMal; var Prompt : string; Line : string; begin Prompt := (Args[0] as TMalString).Val; try Line := _readline(Prompt); do_readline := TMalString.Create(Line); except On E : MalEOF do do_readline := TMalNil.Create; end; end; function slurp(Args: TMalArray) : TMal; var StrL : TStringList; begin StrL := TStringList.Create; StrL.LoadFromFile((Args[0] as TMalString).Val); slurp := TMalString.Create(StrL.Text); end; // Math functions function lt(Args: TMalArray) : TMal; begin lt := wrap_tf((Args[0] as TMalInt).Val < (Args[1] as TMalInt).Val); end; function lte(Args: TMalArray) : TMal; begin lte := wrap_tf((Args[0] as TMalInt).Val <= (Args[1] as TMalInt).Val); end; function gt(Args: TMalArray) : TMal; begin gt := wrap_tf((Args[0] as TMalInt).Val > (Args[1] as TMalInt).Val); end; function gte(Args: TMalArray) : TMal; begin gte := wrap_tf((Args[0] as TMalInt).Val >= (Args[1] as TMalInt).Val); end; function add(Args: TMalArray) : TMal; begin add := TMalInt.Create((Args[0] as TMalInt).Val + (Args[1] as TMalInt).Val); end; function subtract(Args: TMalArray) : TMal; begin subtract := TMalInt.Create((Args[0] as TMalInt).Val - (Args[1] as TMalInt).Val); end; function multiply(Args: TMalArray) : TMal; begin multiply := TMalInt.Create((Args[0] as TMalInt).Val * (Args[1] as TMalInt).Val); end; function divide(Args: TMalArray) : TMal; begin divide := TMalInt.Create((Args[0] as TMalInt).Val div (Args[1] as TMalInt).Val); end; function time_ms(Args: TMalArray) : TMal; begin time_ms := TMalInt.Create(Trunc(TimeStampToMSecs(DateTimeToTimeStamp(Now)))); end; // Collection functions function list(Args: TMalArray) : TMal; begin list := TMalList.Create(Args); end; 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); end; function vector_Q(Args: TMalArray) : TMal; begin vector_Q := wrap_tf(Args[0].ClassType = TMalVector); end; function hash_map(Args: TMalArray) : TMal; begin hash_map := TMalHashMap.Create(Args); end; function map_Q(Args: TMalArray) : TMal; begin map_Q := wrap_tf(Args[0].ClassType = TMalHashMap); end; function assoc(Args: TMalArray) : TMal; var OrigHM, NewHM : TMalHashMap; begin OrigHM := (Args[0] as TMalHashMap); NewHM := TMalHashMap.Clone(OrigHM); assoc := NewHM.assoc_BANG(copy(Args, 1, Length(Args))); end; function dissoc(Args: TMalArray) : TMal; var OrigHM, NewHM : TMalHashMap; begin OrigHM := (Args[0] as TMalHashMap); NewHM := TMalHashMap.Clone(OrigHM); dissoc := NewHM.dissoc_BANG(copy(Args, 1, Length(Args))); end; function get(Args: TMalArray) : TMal; var HM : TMalHashMap; begin if Args[0] is TMalNil then Exit(TMalNil.Create); HM := (Args[0] as TMalHashMap); if HM.Val.IndexOf((Args[1] as TMalString).Val) >= 0 then get := HM.Val[(Args[1] as TMalString).Val] else get := TMalNil.Create; end; function contains_Q(Args: TMalArray) : TMal; var HM : TMalHashMap; begin if Args[0] is TMalNil then Exit(TMalFalse.Create); HM := (Args[0] as TMalHashMap); contains_Q := wrap_tf(HM.Val.IndexOf((Args[1] as TMalString).Val) >= 0); end; function keys(Args: TMalArray) : TMal; var Dict : TMalDict; Arr : TMalArray; I : longint; begin Dict := (Args[0] as TMalHashMap).Val; SetLength(Arr, Dict.Count); for I := 0 to Dict.Count-1 do Arr[I] := TMalString.Create(Dict.Keys[I]); keys := TMalList.Create(Arr); end; function vals(Args: TMalArray) : TMal; var Dict : TMalDict; Arr : TMalArray; I : longint; begin Dict := (Args[0] as TMalHashMap).Val; SetLength(Arr, Dict.Count); for I := 0 to Dict.Count-1 do Arr[I] := Dict[Dict.Keys[I]]; vals := TMalList.Create(Arr); end; // Sequence functions function sequential_Q(Args: TMalArray) : TMal; begin sequential_Q := wrap_tf(_sequential_Q(Args[0])); end; function cons(Args: TMalArray) : TMal; var Res, Src : TMalArray; I : longint; begin Src := (Args[1] as TMalList).Val; SetLength(Res, 1 + Length(Src)); Res[0] := Args[0]; for I := 1 to Length(Src) do Res[I] := Src[I-1]; cons := TMalList.Create(Res); end; function do_concat(Args: TMalArray) : TMal; var Res : TMalArray; I : longint; begin SetLength(Res, 0); for I := 0 to Length(Args)-1 do begin Res := _concat(Res, (Args[I] as TMalList).Val); end; do_concat := TMalList.Create(Res); end; function nth(Args: TMalArray) : TMal; var Arr : TMalArray; Idx : longint; begin Arr := (Args[0] as TMalList).Val; Idx := (Args[1] as TMalInt).Val; if Idx >= Length(Arr) then raise Exception.Create('nth: index out of range') else nth := Arr[Idx]; end; function first(Args: TMalArray) : TMal; var Arr : TMalArray; begin if Args[0] is TMalNil then Exit(TMalNil.Create); Arr := (Args[0] as TMalList).Val; if Length(Arr) = 0 then first := TMalNil.Create else first := (Args[0] as TMalList).Val[0]; end; function rest(Args: TMalArray) : TMal; begin if Args[0] is TMalNil then Exit(_list()); rest := (Args[0] as TMalList).Rest(); end; function empty_Q(Args: TMalArray) : TMal; begin if Args[0] is TMalNil then empty_Q := TMalTrue.Create else if Args[0] is TMalList then empty_Q := wrap_tf(Length((Args[0] as TMalList).Val) = 0) else raise Exception.Create('invalid empty? call'); end; function count(Args: TMalArray) : TMal; begin if Args[0] is TMalNil then count := TMalInt.Create(0) else if Args[0] is TMalList then count := TMalInt.Create(Length((Args[0] as TMalList).Val)) else raise Exception.Create('invalid count call'); end; function map(Args: TMalArray) : TMal; var Fn : TMalFunc; FArgs : TMalArray; Src, Res : TMalArray; I : longint; begin Fn := (Args[0] as TMalFunc); Src := (Args[1] as TMalList).Val; SetLength(FArgs, 1); SetLength(Res, Length(Src)); if Fn.Ast = nil then for I := 0 to Length(Src)-1 do begin FArgs[0] := Src[I]; Res[I] := Fn.Val(FArgs); end else for I := 0 to Length(Src)-1 do begin FArgs[0] := Src[I]; Res[I] := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); end; map := TMalList.Create(Res); end; function apply(Args: TMalArray) : TMal; var Fn : TMalFunc; LastArgs : TMalArray; FArgs : TMalArray; I : longint; begin Fn := (Args[0] as TMalFunc); LastArgs := (Args[Length(Args)-1] as TMalList).Val; SetLength(FArgs, Length(LastArgs) + Length(Args) - 2); for I := 0 to Length(Args)-3 do FArgs[I] := Args[I+1]; for I := 0 to Length(LastArgs)-1 do FArgs[Length(Args)-2 + I] := LastArgs[I]; if Fn.Ast = nil then apply := Fn.Val(FArgs) else apply := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); end; function conj(Args: TMalArray) : TMal; var I : longint; Vals : TMalArray; begin if Args[0] is TMalVector then conj := TMalVector.Create(_concat((Args[0] as TMalList).Val, copy(Args, 1, Length(Args)))) else if Args[0] is TMalList then begin SetLength(Vals, Length(Args)-1); for I := 1 to Length(Args)-1 do Vals[I-1] := Args[Length(Args) - I]; conj := TMalList.Create(_concat(Vals, (Args[0] as TMalList).Val)); end else raise Exception.Create('conj: called on non-sequence'); end; function seq(Args: TMalArray) : TMal; var Str : string; Arr : TMalArray; I : longint; begin if Args[0] is TMalVector then begin if Length((Args[0] as TMalVector).Val) = 0 then Exit(TMalNil.Create); seq := TMalList.Create((Args[0] as TMalVector).Val); end else if Args[0] is TMalList then begin if Length((Args[0] as TMalList).Val) = 0 then Exit(TMalNil.Create); seq := Args[0] end else if _string_Q(Args[0]) then begin Str := (Args[0] as TMalString).Val; if Length(Str) = 0 then Exit(TMalNil.Create); SetLength(Arr, Length(Str)); for I := 0 to Length(Str) do Arr[I] := TMalString.Create(Str[I+1]); seq := TMalList.Create(Arr); end else if Args[0] is TMalNil then begin seq := Args[0]; end else raise Exception.Create('seq: called on non-sequence'); end; // Metadata functions function meta(Args: TMalArray) : TMal; begin if Args[0] is TMalFunc then meta := (Args[0] as TMalFunc).Meta else if Args[0] is TMalList then meta := (Args[0] as TMalList).Meta else if Args[0] is TMalHashMap then meta := (Args[0] as TMalHashMap).Meta else raise Exception.Create('meta not supported on ' + Args[0].ClassName); if meta = nil then meta := TMalNil.Create; end; function with_meta(Args: TMalArray) : TMal; var Fn : TMalFunc; Vec : TMalVector; Lst : TMalList; HM : TMalHashMap; begin if Args[0] is TMalFunc then begin Fn := TMalFunc.Clone(Args[0] as TMalFunc); Fn.Meta := Args[1]; with_meta := Fn; end else if Args[0] is TMalVector then begin Vec := TMalVector.Clone(Args[0] as TMalVector); Vec.Meta := Args[1]; with_meta := Vec; end else if Args[0] is TMalList then begin Lst := TMalList.Clone(Args[0] as TMalList); Lst.Meta := Args[1]; with_meta := Lst; end else if Args[0] is TMalHashMap then begin HM := TMalHashMap.Clone(Args[0] as TMalHashMap); HM.Meta := Args[1]; with_meta := HM; end else raise Exception.Create('with-meta call on non-mal function'); end; // Atom functions function atom(Args: TMalArray) : TMal; begin atom := TMalAtom.Create(Args[0]); end; function atom_Q(Args: TMalArray) : TMal; begin atom_Q := wrap_tf(Args[0] is TMalAtom); end; function deref(Args: TMalArray) : TMal; begin deref := (Args[0] as TMalAtom).Val; end; function reset_BANG(Args: TMalArray) : TMal; begin (Args[0] as TMalAtom).Val := Args[1]; reset_BANG := Args[1]; end; function swap_BANG(Args: TMalArray) : TMal; var Atm : TMalAtom; Fn : TMalFunc; FArgs : TMalArray; I : longint; begin Atm := (Args[0] as TMalAtom); Fn := (Args[1] as TMalFunc); SetLength(FArgs, Length(Args)-1); FArgs[0] := Atm.Val; for I := 1 to Length(Args)-2 do FArgs[I] := Args[I+1]; if Fn.Ast = nil then Atm.Val := Fn.Val(FArgs) else Atm.Val := EVAL(Fn.Ast, TEnv.Create(Fn.Env, Fn.Params, FArgs)); swap_BANG := Atm.Val; end; //////////////////////////////////////////////////////////// initialization begin NS := TCoreDict.Create; NS['='] := @equal_Q; NS['throw'] := @throw; NS['nil?'] := @nil_Q; NS['true?'] := @true_Q; NS['false?'] := @false_Q; NS['number?'] := @number_Q; NS['string?'] := @string_Q; NS['symbol'] := @symbol; NS['symbol?'] := @symbol_Q; NS['keyword'] := @keyword; NS['keyword?'] := @keyword_Q; NS['fn?'] := @fn_Q; NS['macro?'] := @macro_Q; NS['pr-str'] := @do_pr_str; NS['str'] := @str; NS['prn'] := @prn; NS['println'] := @println; NS['read-string'] := @read_string; NS['readline'] := @do_readline; NS['slurp'] := @slurp; NS['<'] := @lt; NS['<='] := @lte; NS['>'] := @gt; NS['>='] := @gte; NS['+'] := @add; NS['-'] := @subtract; NS['*'] := @multiply; NS['/'] := @divide; NS['time-ms'] := @time_ms; NS['list'] := @list; NS['list?'] := @list_Q; NS['vector'] := @vector; NS['vector?'] := @vector_Q; NS['hash-map'] := @hash_map; NS['map?'] := @map_Q; NS['assoc'] := @assoc; NS['dissoc'] := @dissoc; NS['get'] := @get; NS['contains?'] := @contains_Q; NS['keys'] := @keys; NS['vals'] := @vals; NS['sequential?'] := @sequential_Q; NS['cons'] := @cons; NS['concat'] := @do_concat; NS['vec'] := @vec; NS['nth'] := @nth; NS['first'] := @first; NS['rest'] := @rest; NS['empty?'] := @empty_Q; NS['count'] := @count; NS['apply'] := @apply; NS['map'] := @map; NS['conj'] := @conj; NS['seq'] := @seq; NS['meta'] := @meta; NS['with-meta'] := @with_meta; NS['atom'] := @atom; NS['atom?'] := @atom_Q; NS['deref'] := @deref; NS['reset!'] := @reset_BANG; NS['swap!'] := @swap_BANG; end end. ================================================ FILE: impls/objpascal/mal_env.pas ================================================ unit mal_env; {$H+} // Use AnsiString interface Uses sysutils, fgl, mal_types; type TEnv = class(TObject) public Data : TMalDict; Outer : TEnv; constructor Create; constructor Create(_Outer : TEnv); constructor Create(_Outer : TEnv; Binds : TMalList; Exprs : TMalArray); function Add(Key : TMalSymbol; Val : TMal) : TMal; function Get(Key : String) : TMal; end; //////////////////////////////////////////////////////////// implementation constructor TEnv.Create(); begin inherited Create(); Self.Data := TMalDict.Create; Self.Outer := nil; end; constructor TEnv.Create(_Outer: TEnv); begin Self.Create(); Self.Outer := _Outer; end; constructor TEnv.Create(_Outer : TEnv; Binds : TMalList; Exprs : TMalArray); var I : longint; Bind : TMalSymbol; Rest : TMalList; begin Self.Create(_Outer); for I := 0 to Length(Binds.Val)-1 do begin Bind := (Binds.Val[I] as TMalSymbol); if Bind.Val = '&' then begin if I < Length(Exprs) then Rest := TMalList.Create(copy(Exprs, I, Length(Exprs)-I)) else Rest := TMalList.Create; Self.Data[(Binds.Val[I+1] as TMalSymbol).Val] := Rest; break; end; Self.Data[Bind.Val] := Exprs[I]; end; end; function TEnv.Add(Key : TMalSymbol; Val : TMal) : TMal; begin Self.Data[Key.Val] := Val; Add := Val; end; function TEnv.Get(Key : String) : TMal; begin if Data.IndexOf(Key) >= 0 then Get := Data[Key] else if Outer <> nil then Get := Outer.Get(Key) else Get := nil; end; end. ================================================ FILE: impls/objpascal/mal_func.pas ================================================ unit mal_func; interface uses mal_types, mal_env; // Some general type definitions type TMalCallable = function (Args : TMalArray) : TMal; type TMalFunc = class(TMal) public Val : TMalCallable; Ast : TMal; Env : TEnv; Params : TMalList; isMacro : Boolean; Meta : TMal; constructor Create(V : TMalCallable); constructor Create(A : TMal; E : TEnv; P : TMalList); constructor Clone(F : TMalFunc); end; //////////////////////////////////////////////////////////// implementation constructor TMalFunc.Create(V : TMalCallable); begin inherited Create(); Self.Val := V; end; constructor TMalFunc.Create(A : TMal; E : TEnv; P : TMalList); begin inherited Create(); Self.Ast := A; Self.Env := E; Self.Params := P; end; constructor TMalFunc.Clone(F : TMalFunc); begin Self.Create(F.Ast, F.Env, F.Params); Self.isMacro := F.isMacro; Self.Meta := F.Meta; end; end. ================================================ FILE: impls/objpascal/mal_readline.pas ================================================ unit mal_readline; {$H+} // Use AnsiString interface uses sysutils, CTypes; {$IFDEF USE_READLINE} {$LINKLIB readline} {$ELSE} {$LINKLIB libedit} {$ENDIF} // External libedit/readline functions function readline(Prompt: PChar) : PChar; cdecl; external; procedure add_history(Line: PChar); cdecl; external; // API type MalEOF = class(Exception); function _readline(Prompt: string) : string; //////////////////////////////////////////////////////////// implementation function _readline(Prompt: string) : string; var Line : PChar; begin Line := readline(PChar(Prompt)); if Line = Nil then raise MalEOF.Create('MalEOF'); if Line <> '' then add_history(Line); _readline := Line; end; end. ================================================ FILE: impls/objpascal/mal_types.pas ================================================ unit mal_types; {$H+} // Use AnsiString interface uses sysutils, fgl; // Ancestor of all Mal types type TMal = class(TObject); // Some general type definitions type TMalArray = array of TMal; // TODO: use http://bugs.freepascal.org/view.php?id=27206 when // incorporated into FPC TMalDict = specialize TFPGMap; type TMalException = class(Exception) public Val: TMal; constructor Create(V : TMal); end; // Mal types type TMalNil = class(TMal); type TMalTrue = class(TMal); type TMalFalse = class(TMal); type TMalInt = class(TMal) public Val: int64; constructor Create(V : int64); end; type TMalString = class(TMal) public Val: string; constructor Create(V : string); end; type TMalSymbol = class(TMal) public Val: string; constructor Create(V : string); end; type TMalList = class(TMal) public Val: TMalArray; Meta: TMal; constructor Create(); constructor Create(V : TMalArray); function Rest() : TMalList; constructor Clone(L : TMalList); end; type TMalVector = class(TMalList) end; type TMalAtom = class(TMal) public Val: TMal; constructor Create(V : TMal); end; type TMalHashMap = class(TMal) public Val: TMalDict; Meta: TMal; constructor Create(); constructor Create(V : TMalDict); constructor Create(V : TMalArray); constructor Clone(HM : TMalHashMap); function assoc_BANG(KVs: TMalArray) : TMal; function dissoc_BANG(Ks: TMalArray) : TMal; end; // General type functions function GetBacktrace(E: Exception) : string; function wrap_tf(x : Boolean) : TMal; function _equal_Q(A : TMal; B : TMal) : Boolean; function _sequential_Q(Obj: TMal) : Boolean; function _list() : TMalList; function _list(A: TMal) : TMalList; function _list(A: TMal; B: TMal) : TMalList; function _list(A: TMal; B: TMal; C: TMal) : TMalList; function _concat(A: TMalArray; B: TMalArray) : TMalArray; function _string_Q(Obj: TMal) : Boolean; //////////////////////////////////////////////////////////// implementation constructor TMalException.Create(V : TMal); begin inherited Create('MalException'); Self.Val := V; end; // // Mal types // constructor TMalInt.Create(V : int64); begin inherited Create(); Self.Val := V; end; constructor TMalString.Create(V : string); begin inherited Create(); Self.Val := V; end; constructor TMalSymbol.Create(V : string); begin inherited Create(); Self.Val := V; end; constructor TMalList.Create(); begin inherited Create(); SetLength(Self.Val, 0); end; constructor TMalList.Create(V : TMalArray); begin inherited Create(); Self.Val := V; end; constructor TMalList.Clone(L : TMalList); begin inherited Create(); Self.Val := copy(L.Val, 0, Length(L.Val)); end; function TMalList.Rest() : TMalList; begin if Length(Val) <= 1 then Rest := (_list() as TMalList) else Rest := TMalList.Create(copy(Val, 1, Length(Val)-1)); end; // Hash Maps constructor TMalHashMap.Create(); begin inherited Create(); Self.Val := TMalDict.Create; end; constructor TMalHashMap.Create(V : TMalDict); begin inherited Create(); Self.Val := V; end; function TMalHashMap.assoc_BANG(KVs: TMalArray) : TMal; var I : longint; begin I := 0; while I < Length(KVs) do begin Self.Val[(KVs[I] as TMalString).Val] := KVs[I+1]; I := I + 2; end; assoc_BANG := Self; end; function TMalHashMap.dissoc_BANG(Ks: TMalArray) : TMal; var I : longint; begin for I := 0 to Length(Ks)-1 do Self.Val.Remove((Ks[I] as TMalString).Val); dissoc_BANG := Self; end; constructor TMalHashMap.Create(V : TMalArray); begin Self.Create(); Self.assoc_BANG(V); end; constructor TMalHashMap.Clone(HM : TMalHashMap); var I : longint; begin Self.Create(); I := 0; while I < HM.Val.Count do begin Self.Val[HM.Val.Keys[I]] := HM.Val[HM.Val.Keys[I]]; I := I + 1; end; end; // Atoms constructor TMalAtom.Create(V : TMal); begin inherited Create(); Self.Val := V; end; // // General type functions // function GetBacktrace(E: Exception) : string; var I: Integer; Frames: PPointer; begin GetBacktrace := BackTraceStrFunc(ExceptAddr); Frames := ExceptFrames; for I := 0 to ExceptFrameCount - 1 do GetBacktrace := GetBacktrace + #10 + BackTraceStrFunc(Frames[I]); end; function wrap_tf(x : Boolean) : TMal; begin if x = true then wrap_tf := TMalTrue.Create else wrap_tf := TMalFalse.Create; end; function _equal_Q(A : TMal; B : TMal) : Boolean; var I : longint; ArrA, ArrB : TMalArray; DictA, DictB : TMalDict; Key : string; begin if not ((A.ClassType = B.ClassType) or ((A is TMalList) and (B is TMalList))) then _equal_Q := false else begin if A is TMalList then begin ArrA := (A as TMalList).Val; ArrB := (B as TMalList).Val; if Length(ArrA) <> Length(ArrB) then Exit(false); for I := 0 to Length(ArrA)-1 do if not _equal_Q(ArrA[I], ArrB[I]) then Exit(false); _equal_Q := true; end else if A is TMalHashMap then begin DictA := (A as TMalHashMap).Val; DictB := (B as TMalHashMap).Val; if DictA.Count <> DictB.Count then Exit(false); for I := 0 to DictA.Count-1 do begin Key := DictA.Keys[I]; if DictB.IndexOf(Key) < 0 then Exit(false); if not _equal_Q(DictA[Key], DictB[Key]) then Exit(false); end; _equal_Q := true; end else if A is TMalString then _equal_Q := (A as TMalString).Val = (B as TMalString).Val else if A is TMalSymbol then _equal_Q := (A as TMalSymbol).Val = (B as TMalSymbol).Val else if A is TMalInt then _equal_Q := (A as TMalInt).Val = (B as TMalInt).Val else if A is TMalNil then _equal_Q := B is TMalNil else if A is TMalTrue then _equal_Q := B is TMalTrue else if A is TMalFalse then _equal_Q := B is TMalFalse else _equal_Q := A = B; end end; function _sequential_Q(Obj: TMal) : Boolean; begin _sequential_Q := Obj is TMalList; end; function _list() : TMalList; var Arr: TMalArray; begin SetLength(Arr, 0); _list := TMalList.Create(Arr); end; function _list(A: TMal) : TMalList; var Arr: TMalArray; begin SetLength(Arr, 1); Arr[0] := A; _list := TMalList.Create(Arr); end; function _list(A: TMal; B: TMal) : TMalList; var Arr: TMalArray; begin SetLength(Arr, 2); Arr[0] := A; Arr[1] := B; _list := TMalList.Create(Arr); end; function _list(A: TMal; B: TMal; C: TMal) : TMalList; var Arr: TMalArray; begin SetLength(Arr, 3); Arr[0] := A; Arr[1] := B; Arr[2] := C; _list := TMalList.Create(Arr); end; function _concat(A: TMalArray; B: TMalArray) : TMalArray; var Res : TMalArray; I : longint; begin SetLength(Res, Length(A) + Length(B)); for I := 0 to Length(A)-1 do Res[I] := A[I]; for I := 0 to Length(B)-1 do Res[I+Length(A)] := B[I]; _concat := Res; end; function _string_Q(Obj: TMal) : Boolean; var Str : string; begin if (Obj is TMalString) then begin Str := (Obj as TMalString).Val; _string_Q := (Length(Str) = 0) or (Str[1] <> #127) end else _string_Q := false; end; end. ================================================ FILE: impls/objpascal/printer.pas ================================================ unit printer; {$H+} // Use AnsiString interface Uses sysutils, mal_types, mal_func; function pr_str_array(Args : TMalArray; print_readably : Boolean; Separator : string) : string; function pr_str(Obj : TMal; print_readably : Boolean) : string; implementation function pr_str_array(Args : TMalArray; print_readably : Boolean; Separator : string) : string; var Str : string; I : longint; begin Str := ''; for I := 0 to Length(Args)-1 do begin Str := Str + pr_str(Args[I], print_readably); if I <> Length(Args)-1 then Str := Str + Separator; end; pr_str_array := Str; end; function pr_str_dict(Dict : TMalDict; print_readably : Boolean; Separator : string) : string; var I : longint; Arr : TMalArray; begin SetLength(Arr, Dict.Count * 2); I := 0; while I < Dict.Count do begin Arr[I*2] := TMalString.Create(Dict.Keys[I]); Arr[I*2+1] := Dict[Dict.Keys[I]]; I := I + 1; end; pr_str_dict := pr_str_array(Arr, print_readably, ' '); end; function pr_str(Obj : TMal; print_readably : Boolean) : string; var Str : string; Fn : TMalFunc; begin if Obj.ClassType = TMalList then pr_str := '(' + pr_str_array((Obj as TMalList).Val, print_readably, ' ') + ')' else if Obj.ClassType = TMalVector then pr_str := '[' + pr_str_array((Obj as TMalList).Val, print_readably, ' ') + ']' else if Obj is TMalHashMap then pr_str := '{' + pr_str_dict((Obj as TMalHashMap).Val, print_readably, ' ') + '}' else if Obj is TMalString then begin Str := (Obj as TMalString).Val; if (Length(Str) > 0) and (Str[1] = #127) then pr_str := ':' + copy(Str, 2, Length(Str)) else if print_readably then begin Str := StringReplace(Str, '\', '\\', [rfReplaceAll]); Str := StringReplace(Str, '"', '\"', [rfReplaceAll]); Str := StringReplace(Str, #10, '\n', [rfReplaceAll]); pr_str := Format('"%s"', [Str]) end else pr_str := Str; end else if Obj is TMalNil then pr_str := 'nil' else if Obj is TMalTrue then pr_str := 'true' else if Obj is TMalFalse then pr_str := 'false' else if Obj is TMalInt then pr_str := IntToStr((Obj as TMalInt).Val) else if Obj is TMalSymbol then pr_str := (Obj as TMalSymbol).Val else if Obj is TMalAtom then pr_str := '(atom ' + pr_str((Obj as TMalAtom).Val, print_readably) + ')' else if Obj is TMalFunc then begin Fn := (Obj as TMalFunc); if Fn.Ast = nil then pr_str := '#' else pr_str := '(fn* ' + pr_str(Fn.Params,true) + ' ' + pr_str(Fn.Ast,true) + ')' end else pr_str := '#unknown'; end; end. ================================================ FILE: impls/objpascal/reader.pas ================================================ unit reader; {$H+} // Use AnsiString interface Uses sysutils, Classes, RegExpr in 'regexpr/Source/RegExpr.pas', mal_types; // // Reader class // type TReader = class(TObject) public Tokens : TStringList; Position : Integer; constructor Create(Toks: TStringList); function Peek() : string; function Next() : string; end; // // reader functions // function read_str(const Str: string): TMal; implementation // // Reader class // constructor TReader.Create(Toks: TStringList); begin inherited Create(); Self.Tokens := Toks; Self.Position := 0; end; function TReader.Peek() : string; begin if Position >= Tokens.Count then Peek := #0 else Peek := Tokens[Position]; end; function TReader.Next() : string; begin Next := Tokens[Position]; Position := Position + 1; end; // // reader functions // function tokenize(const Str: string) : TStringList; var RE : TRegExpr; Tokens : TStringList; begin RE := TRegExpr.Create; RE.Expression := '[\s,]*(~@|[\[\]{}()''`~^@]|"(([\\].|[^\\"])*)"?|;[^\r\n]*|[^\s\[\]{}()''"`@,;]+)'; Tokens := TStringList.Create; if RE.Exec(Str) then begin repeat if RE.Match[1][1] <> ';' then Tokens.Add(RE.Match[1]); until not RE.ExecNext; end; RE.Free; tokenize := Tokens; end; function read_atom(Reader : TReader) : TMal; var RE : TRegExpr; Token : string; Str : string; begin RE := TRegExpr.Create; RE.Expression := '(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("([\\].|[^\\"])*)"$|^(\".*)$|:(.*)|(^[^\"]*$)'; Token := Reader.Next(); //WriteLn('token: ' + Token); if RE.Exec(Token) then begin if RE.Match[1] <> '' then read_atom := TMalInt.Create(StrToInt(RE.Match[1])) else if RE.Match[2] <> '' then // TODO read_atom := TMalNil.Create else if RE.Match[3] <> '' then read_atom := TMalNil.Create else if RE.Match[4] <> '' then read_atom := TMalTrue.Create else if RE.Match[5] <> '' then read_atom := TMalFalse.Create else if RE.Match[6] <> '' then begin Str := copy(Token, 2, Length(Token)-2); Str := StringReplace(Str, '\\', #127, [rfReplaceAll]); Str := StringReplace(Str, '\"', '"', [rfReplaceAll]); Str := StringReplace(Str, '\n', #10, [rfReplaceAll]); Str := StringReplace(Str, #127, '\', [rfReplaceAll]); read_atom := TMalString.Create(Str) end else if RE.Match[8] <> '' then raise Exception.Create('expected ''"'', got EOF') else if RE.Match[9] <> '' then read_atom := TMalString.Create(#127 + RE.Match[9]) else if RE.Match[10] <> '' then read_atom := TMalSymbol.Create(Token); end else begin RE.Free; raise Exception.Create('Invalid token in read_atom'); end; RE.Free; end; // Forward declaration since read_seq calls it function read_form(Reader : TReader) : TMal; forward; function read_seq(Reader : TReader; start: string; last: string) : TMalArray; var Token : string; Ast : TMalArray; begin SetLength(Ast, 0); Token := Reader.Next(); if Token <> start then raise Exception.Create('expected ''' + start + ''''); Token := Reader.Peek(); while Token <> last do begin if Token = #0 then raise Exception.Create('expected ''' + last + ''', got EOF'); SetLength(Ast, Length(Ast)+1); Ast[Length(Ast)-1] := read_form(Reader); Token := Reader.Peek(); end; Token := Reader.Next(); read_seq := Ast; end; function read_form(Reader : TReader) : TMal; var Token : string; Meta : TMal; begin Token := Reader.Peek(); case Token of // reader macros/transforms '''': begin Reader.Next(); read_form := _list(TMalSymbol.Create('quote'), read_form(Reader)); end; '`': begin Reader.Next(); read_form := _list(TMalSymbol.Create('quasiquote'), read_form(Reader)); end; '~': begin Reader.Next(); read_form := _list(TMalSymbol.Create('unquote'), read_form(Reader)); end; '~@': begin Reader.Next(); read_form := _list(TMalSymbol.Create('splice-unquote'), read_form(Reader)); end; '^': begin Reader.Next(); Meta := read_form(Reader); read_form := _list(TMalSymbol.Create('with-meta'), read_form(Reader), Meta); end; '@': begin Reader.Next(); read_form := _list(TMalSymbol.Create('deref'), read_form(Reader)); end; // list ')': raise Exception.Create('unexpected '')'''); '(': read_form := TMalList.Create(read_seq(Reader, '(', ')')); // vector ']': raise Exception.Create('unexpected '']'''); '[': read_form := TMalVector.Create(read_seq(Reader, '[', ']')); // hash-map '}': raise Exception.Create('unexpected ''}'''); '{': read_form := TMalHashMap.Create(read_seq(Reader, '{', '}')); else read_form := read_atom(Reader); end; end; function read_str(const Str: string): TMal; var Tokens : TStringList; //Dict : TObjectDictionary; begin Tokens := tokenize(Str); // TODO: check for empty list read_str := read_form(TReader.Create(Tokens)); end; end. ================================================ FILE: impls/objpascal/regexpr/Source/RegExpr.pas ================================================ unit RegExpr; { TRegExpr class library Delphi Regular Expressions Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia You may use this software in any kind of development, including comercial, redistribute, and modify it freely, under the following restrictions : 1. This software is provided as it is, without any kind of warranty given. Use it at Your own risk.The author is not responsible for any consequences of use of this software. 2. The origin of this software may not be mispresented, You must not claim that You wrote the original software. If You use this software in any kind of product, it would be appreciated that there in a information box, or in the documentation would be an acknowledgement like Partial Copyright (c) 2004 Andrey V. Sorokin http://RegExpStudio.com mailto:anso@mail.ru 3. You may not have any income from distributing this source (or altered version of it) to other developers. When You use this product in a comercial package, the source may not be charged seperatly. 4. Altered versions must be plainly marked as such, and must not be misrepresented as being the original software. 5. RegExp Studio application and all the visual components as well as documentation is not part of the TRegExpr library and is not free for usage. mailto:anso@mail.ru http://RegExpStudio.com http://anso.da.ru/ } interface // ======== Determine compiler {$IFDEF VER80} Sorry, TRegExpr is for 32-bits Delphi only. Delphi 1 is not supported (and whos really care today?!). {$ENDIF} {$IFDEF VER90} {$DEFINE D2} {$ENDIF} // D2 {$IFDEF VER93} {$DEFINE D2} {$ENDIF} // CPPB 1 {$IFDEF VER100} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D3 {$IFDEF VER110} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // CPPB 3 {$IFDEF VER120} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D4 {$IFDEF VER130} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D5 {$IFDEF VER140} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D6 {$IFDEF VER150} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7 // ======== Define base compiler options {$BOOLEVAL OFF} {$EXTENDEDSYNTAX ON} {$LONGSTRINGS ON} {$OPTIMIZATION ON} {$IFDEF D6} {$WARN SYMBOL_PLATFORM OFF} // Suppress .Net warnings {$ENDIF} {$IFDEF D7} {$WARN UNSAFE_CAST OFF} // Suppress .Net warnings {$WARN UNSAFE_TYPE OFF} // Suppress .Net warnings {$WARN UNSAFE_CODE OFF} // Suppress .Net warnings {$ENDIF} {$IFDEF FPC} {$MODE DELPHI} // Delphi-compatible mode in FreePascal {$ENDIF} // ======== Define options for TRegExpr engine {.$DEFINE UniCode} // Unicode support {$DEFINE RegExpPCodeDump} // p-code dumping (see Dump method) {$IFNDEF FPC} // the option is not supported in FreePascal {$DEFINE reRealExceptionAddr} // exceptions will point to appropriate source line, not to Error procedure {$ENDIF} {$DEFINE ComplexBraces} // support braces in complex cases {$IFNDEF UniCode} // the option applicable only for non-UniCode mode {$DEFINE UseSetOfChar} // Significant optimization by using set of char {$ENDIF} {$IFDEF UseSetOfChar} {$DEFINE UseFirstCharSet} // Fast skip between matches for r.e. that starts with determined set of chars {$ENDIF} // ======== Define Pascal-language options // Define 'UseAsserts' option (do not edit this definitions). // Asserts used to catch 'strange bugs' in TRegExpr implementation (when something goes // completely wrong). You can swith asserts on/off with help of {$C+}/{$C-} compiler options. {$IFDEF D3} {$DEFINE UseAsserts} {$ENDIF} {$IFDEF FPC} {$DEFINE UseAsserts} {$ENDIF} // Define 'use subroutine parameters default values' option (do not edit this definition). {$IFDEF D4} {$DEFINE DefParam} {$ENDIF} // Define 'OverMeth' options, to use method overloading (do not edit this definitions). {$IFDEF D5} {$DEFINE OverMeth} {$ENDIF} {$IFDEF FPC} {$DEFINE OverMeth} {$ENDIF} uses Classes, // TStrings in Split method SysUtils; // Exception type {$IFDEF UniCode} PRegExprChar = PWideChar; RegExprString = WideString; REChar = WideChar; {$ELSE} PRegExprChar = PChar; RegExprString = AnsiString; //###0.952 was string REChar = Char; {$ENDIF} TREOp = REChar; // internal p-code type //###0.933 PREOp = ^TREOp; TRENextOff = integer; // internal Next "pointer" (offset to current p-code) //###0.933 PRENextOff = ^TRENextOff; // used for extracting Next "pointers" from compiled r.e. //###0.933 TREBracesArg = integer; // type of {m,n} arguments PREBracesArg = ^TREBracesArg; const REOpSz = SizeOf (TREOp) div SizeOf (REChar); // size of p-code in RegExprString units RENextOffSz = SizeOf (TRENextOff) div SizeOf (REChar); // size of Next 'pointer' -"- REBracesArgSz = SizeOf (TREBracesArg) div SizeOf (REChar); // size of BRACES arguments -"- type TRegExprInvertCaseFunction = function (const Ch : REChar) : REChar of object; const EscChar = '\'; // 'Escape'-char ('\' in common r.e.) used for escaping metachars (\w, \d etc). RegExprModifierI : boolean = False; // default value for ModifierI RegExprModifierR : boolean = True; // default value for ModifierR RegExprModifierS : boolean = True; // default value for ModifierS RegExprModifierG : boolean = True; // default value for ModifierG RegExprModifierM : boolean = False; // default value for ModifierM RegExprModifierX : boolean = False; // default value for ModifierX RegExprSpaceChars : RegExprString = // default value for SpaceChars ' '#$9#$A#$D#$C; RegExprWordChars : RegExprString = // default value for WordChars '0123456789' //###0.940 + 'abcdefghijklmnopqrstuvwxyz' + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; RegExprLineSeparators : RegExprString =// default value for LineSeparators #$d#$a{$IFDEF UniCode}+#$b#$c#$2028#$2029#$85{$ENDIF}; //###0.947 RegExprLinePairedSeparator : RegExprString =// default value for LinePairedSeparator #$d#$a; { if You need Unix-styled line separators (only \n), then use: RegExprLineSeparators = #$a; RegExprLinePairedSeparator = ''; } const NSUBEXP = 15; // max number of subexpression //###0.929 // Cannot be more than NSUBEXPMAX // Be carefull - don't use values which overflow CLOSE opcode // (in this case you'll get compiler erorr). // Big NSUBEXP will cause more slow work and more stack required NSUBEXPMAX = 255; // Max possible value for NSUBEXP. //###0.945 // Don't change it! It's defined by internal TRegExpr design. MaxBracesArg = $7FFFFFFF - 1; // max value for {n,m} arguments //###0.933 {$IFDEF ComplexBraces} LoopStackMax = 10; // max depth of loops stack //###0.925 {$ENDIF} TinySetLen = 3; // if range includes more then TinySetLen chars, //###0.934 // then use full (32 bytes) ANYOFFULL instead of ANYOF[BUT]TINYSET // !!! Attension ! If you change TinySetLen, you must // change code marked as "//!!!TinySet" type {$IFDEF UseSetOfChar} PSetOfREChar = ^TSetOfREChar; TSetOfREChar = set of REChar; {$ENDIF} TRegExpr = class; TRegExprReplaceFunction = function (ARegExpr : TRegExpr): string of object; TRegExpr = class private startp : array [0 .. NSUBEXP - 1] of PRegExprChar; // founded expr starting points endp : array [0 .. NSUBEXP - 1] of PRegExprChar; // founded expr end points {$IFDEF ComplexBraces} LoopStack : array [1 .. LoopStackMax] of integer; // state before entering loop LoopStackIdx : integer; // 0 - out of all loops {$ENDIF} // The "internal use only" fields to pass info from compile // to execute that permits the execute phase to run lots faster on // simple cases. regstart : REChar; // char that must begin a match; '\0' if none obvious reganch : REChar; // is the match anchored (at beginning-of-line only)? regmust : PRegExprChar; // string (pointer into program) that match must include, or nil regmlen : integer; // length of regmust string // Regstart and reganch permit very fast decisions on suitable starting points // for a match, cutting down the work a lot. Regmust permits fast rejection // of lines that cannot possibly match. The regmust tests are costly enough // that regcomp() supplies a regmust only if the r.e. contains something // potentially expensive (at present, the only such thing detected is * or + // at the start of the r.e., which can involve a lot of backup). Regmlen is // supplied because the test in regexec() needs it and regcomp() is computing // it anyway. {$IFDEF UseFirstCharSet} //###0.929 FirstCharSet : TSetOfREChar; {$ENDIF} // work variables for Exec's routins - save stack in recursion} reginput : PRegExprChar; // String-input pointer. fInputStart : PRegExprChar; // Pointer to first char of input string. fInputEnd : PRegExprChar; // Pointer to char AFTER last char of input string // work variables for compiler's routines regparse : PRegExprChar; // Input-scan pointer. regnpar : integer; // count. regdummy : char; regcode : PRegExprChar; // Code-emit pointer; @regdummy = don't. regsize : integer; // Code size. regexpbeg : PRegExprChar; // only for error handling. Contains // pointer to beginning of r.e. while compiling fExprIsCompiled : boolean; // true if r.e. successfully compiled // programm is essentially a linear encoding // of a nondeterministic finite-state machine (aka syntax charts or // "railroad normal form" in parsing technology). Each node is an opcode // plus a "next" pointer, possibly plus an operand. "Next" pointers of // all nodes except BRANCH implement concatenation; a "next" pointer with // a BRANCH on both ends of it is connecting two alternatives. (Here we // have one of the subtle syntax dependencies: an individual BRANCH (as // opposed to a collection of them) is never concatenated with anything // because of operator precedence.) The operand of some types of node is // a literal string; for others, it is a node leading into a sub-FSM. In // particular, the operand of a BRANCH node is the first node of the branch. // (NB this is *not* a tree structure: the tail of the branch connects // to the thing following the set of BRANCHes.) The opcodes are: programm : PRegExprChar; // Unwarranted chumminess with compiler. fExpression : PRegExprChar; // source of compiled r.e. fInputString : PRegExprChar; // input string fLastError : integer; // see Error, LastError fModifiers : integer; // modifiers fCompModifiers : integer; // compiler's copy of modifiers fProgModifiers : integer; // modifiers values from last programm compilation fSpaceChars : RegExprString; //###0.927 fWordChars : RegExprString; //###0.929 fInvertCase : TRegExprInvertCaseFunction; //###0.927 fLineSeparators : RegExprString; //###0.941 fLinePairedSeparatorAssigned : boolean; fLinePairedSeparatorHead, fLinePairedSeparatorTail : REChar; {$IFNDEF UniCode} fLineSeparatorsSet : set of REChar; {$ENDIF} procedure InvalidateProgramm; // Mark programm as have to be [re]compiled function IsProgrammOk : boolean; //###0.941 // Check if we can use precompiled r.e. or // [re]compile it if something changed function GetExpression : RegExprString; procedure SetExpression (const s : RegExprString); function GetModifierStr : RegExprString; class function ParseModifiersStr (const AModifiers : RegExprString; var AModifiersInt : integer) : boolean; //###0.941 class function now // Parse AModifiers string and return true and set AModifiersInt // if it's in format 'ismxrg-ismxrg'. procedure SetModifierStr (const AModifiers : RegExprString); function GetModifier (AIndex : integer) : boolean; procedure SetModifier (AIndex : integer; ASet : boolean); procedure Error (AErrorID : integer); virtual; // error handler. // Default handler raise exception ERegExpr with // Message = ErrorMsg (AErrorID), ErrorCode = AErrorID // and CompilerErrorPos = value of property CompilerErrorPos. {==================== Compiler section ===================} function CompileRegExpr (exp : PRegExprChar) : boolean; // compile a regular expression into internal code procedure Tail (p : PRegExprChar; val : PRegExprChar); // set the next-pointer at the end of a node chain procedure OpTail (p : PRegExprChar; val : PRegExprChar); // regoptail - regtail on operand of first argument; nop if operandless function EmitNode (op : TREOp) : PRegExprChar; // regnode - emit a node, return location procedure EmitC (b : REChar); // emit (if appropriate) a byte of code procedure InsertOperator (op : TREOp; opnd : PRegExprChar; sz : integer); //###0.90 // insert an operator in front of already-emitted operand // Means relocating the operand. function ParseReg (paren : integer; var flagp : integer) : PRegExprChar; // regular expression, i.e. main body or parenthesized thing function ParseBranch (var flagp : integer) : PRegExprChar; // one alternative of an | operator function ParsePiece (var flagp : integer) : PRegExprChar; // something followed by possible [*+?] function ParseAtom (var flagp : integer) : PRegExprChar; // the lowest level function GetCompilerErrorPos : integer; // current pos in r.e. - for error hanling {$IFDEF UseFirstCharSet} //###0.929 procedure FillFirstCharSet (prog : PRegExprChar); {$ENDIF} {===================== Mathing section ===================} function regrepeat (p : PRegExprChar; AMax : integer) : integer; // repeatedly match something simple, report how many function regnext (p : PRegExprChar) : PRegExprChar; // dig the "next" pointer out of a node function MatchPrim (prog : PRegExprChar) : boolean; // recursively matching routine function ExecPrim (AOffset: integer) : boolean; // Exec for stored InputString {$IFDEF RegExpPCodeDump} function DumpOp (op : REChar) : RegExprString; {$ENDIF} function GetSubExprMatchCount : integer; function GetMatchPos (Idx : integer) : integer; function GetMatchLen (Idx : integer) : integer; function GetMatch (Idx : integer) : RegExprString; function GetInputString : RegExprString; procedure SetInputString (const AInputString : RegExprString); {$IFNDEF UseSetOfChar} function StrScanCI (s : PRegExprChar; ch : REChar) : PRegExprChar; //###0.928 {$ENDIF} procedure SetLineSeparators (const AStr : RegExprString); procedure SetLinePairedSeparator (const AStr : RegExprString); function GetLinePairedSeparator : RegExprString; public constructor Create; destructor Destroy; override; class function VersionMajor : integer; //###0.944 class function VersionMinor : integer; //###0.944 property Expression : RegExprString read GetExpression write SetExpression; // Regular expression. // For optimization, TRegExpr will automatically compiles it into 'P-code' // (You can see it with help of Dump method) and stores in internal // structures. Real [re]compilation occures only when it really needed - // while calling Exec[Next], Substitute, Dump, etc // and only if Expression or other P-code affected properties was changed // after last [re]compilation. // If any errors while [re]compilation occures, Error method is called // (by default Error raises exception - see below) property ModifierStr : RegExprString read GetModifierStr write SetModifierStr; // Set/get default values of r.e.syntax modifiers. Modifiers in // r.e. (?ismx-ismx) will replace this default values. // If you try to set unsupported modifier, Error will be called // (by defaul Error raises exception ERegExpr). property ModifierI : boolean index 1 read GetModifier write SetModifier; // Modifier /i - caseinsensitive, initialized from RegExprModifierI property ModifierR : boolean index 2 read GetModifier write SetModifier; // Modifier /r - use r.e.syntax extended for russian, // (was property ExtSyntaxEnabled in previous versions) // If true, then - additional include russian letter '', // - additional include '', and - include all russian symbols. // You have to turn it off if it may interfere with you national alphabet. // , initialized from RegExprModifierR property ModifierS : boolean index 3 read GetModifier write SetModifier; // Modifier /s - '.' works as any char (else as [^\n]), // , initialized from RegExprModifierS property ModifierG : boolean index 4 read GetModifier write SetModifier; // Switching off modifier /g switchs all operators in // non-greedy style, so if ModifierG = False, then // all '*' works as '*?', all '+' as '+?' and so on. // , initialized from RegExprModifierG property ModifierM : boolean index 5 read GetModifier write SetModifier; // Treat string as multiple lines. That is, change `^' and `$' from // matching at only the very start or end of the string to the start // or end of any line anywhere within the string. // , initialized from RegExprModifierM property ModifierX : boolean index 6 read GetModifier write SetModifier; // Modifier /x - eXtended syntax, allow r.e. text formatting, // see description in the help. Initialized from RegExprModifierX function Exec (const AInputString : RegExprString) : boolean; {$IFDEF OverMeth} overload; {$IFNDEF FPC} // I do not know why FreePascal cannot overload methods with empty param list function Exec : boolean; overload; //###0.949 {$ENDIF} function Exec (AOffset: integer) : boolean; overload; //###0.949 {$ENDIF} // match a programm against a string AInputString // !!! Exec store AInputString into InputString property // For Delphi 5 and higher available overloaded versions - first without // parameter (uses already assigned to InputString property value) // and second that has integer parameter and is same as ExecPos function ExecNext : boolean; // find next match: // ExecNext; // works same as // if MatchLen [0] = 0 then ExecPos (MatchPos [0] + 1) // else ExecPos (MatchPos [0] + MatchLen [0]); // but it's more simpler ! // Raises exception if used without preceeding SUCCESSFUL call to // Exec* (Exec, ExecPos, ExecNext). So You always must use something like // if Exec (InputString) then repeat { proceed results} until not ExecNext; function ExecPos (AOffset: integer {$IFDEF DefParam}= 1{$ENDIF}) : boolean; // find match for InputString starting from AOffset position // (AOffset=1 - first char of InputString) property InputString : RegExprString read GetInputString write SetInputString; // returns current input string (from last Exec call or last assign // to this property). // Any assignment to this property clear Match* properties ! function Substitute (const ATemplate : RegExprString) : RegExprString; // Returns ATemplate with '$&' or '$0' replaced by whole r.e. // occurence and '$n' replaced by occurence of subexpression #n. // Since v.0.929 '$' used instead of '\' (for future extensions // and for more Perl-compatibility) and accept more then one digit. // If you want place into template raw '$' or '\', use prefix '\' // Example: '1\$ is $2\\rub\\' -> '1$ is \rub\' // If you want to place raw digit after '$n' you must delimit // n with curly braces '{}'. // Example: 'a$12bc' -> 'abc' // 'a${1}2bc' -> 'a2bc'. procedure Split (AInputStr : RegExprString; APieces : TStrings); // Split AInputStr into APieces by r.e. occurencies // Internally calls Exec[Next] function Replace (AInputStr : RegExprString; const AReplaceStr : RegExprString; AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) //###0.946 : RegExprString; {$IFDEF OverMeth} overload; function Replace (AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString; overload; {$ENDIF} function ReplaceEx (AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString; // Returns AInputStr with r.e. occurencies replaced by AReplaceStr // If AUseSubstitution is true, then AReplaceStr will be used // as template for Substitution methods. // For example: // Expression := '({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*'; // Replace ('BLOCK( test1)', 'def "$1" value "$2"', True); // will return: def 'BLOCK' value 'test1' // Replace ('BLOCK( test1)', 'def "$1" value "$2"') // will return: def "$1" value "$2" // Internally calls Exec[Next] // Overloaded version and ReplaceEx operate with call-back function, // so You can implement really complex functionality. property SubExprMatchCount : integer read GetSubExprMatchCount; // Number of subexpressions has been found in last Exec* call. // If there are no subexpr. but whole expr was found (Exec* returned True), // then SubExprMatchCount=0, if no subexpressions nor whole // r.e. found (Exec* returned false) then SubExprMatchCount=-1. // Note, that some subexpr. may be not found and for such // subexpr. MathPos=MatchLen=-1 and Match=''. // For example: Expression := '(1)?2(3)?'; // Exec ('123'): SubExprMatchCount=2, Match[0]='123', [1]='1', [2]='3' // Exec ('12'): SubExprMatchCount=1, Match[0]='12', [1]='1' // Exec ('23'): SubExprMatchCount=2, Match[0]='23', [1]='', [2]='3' // Exec ('2'): SubExprMatchCount=0, Match[0]='2' // Exec ('7') - return False: SubExprMatchCount=-1 property MatchPos [Idx : integer] : integer read GetMatchPos; // pos of entrance subexpr. #Idx into tested in last Exec* // string. First subexpr. have Idx=1, last - MatchCount, // whole r.e. have Idx=0. // Returns -1 if in r.e. no such subexpr. or this subexpr. // not found in input string. property MatchLen [Idx : integer] : integer read GetMatchLen; // len of entrance subexpr. #Idx r.e. into tested in last Exec* // string. First subexpr. have Idx=1, last - MatchCount, // whole r.e. have Idx=0. // Returns -1 if in r.e. no such subexpr. or this subexpr. // not found in input string. // Remember - MatchLen may be 0 (if r.e. match empty string) ! property Match [Idx : integer] : RegExprString read GetMatch; // == copy (InputString, MatchPos [Idx], MatchLen [Idx]) // Returns '' if in r.e. no such subexpr. or this subexpr. // not found in input string. function LastError : integer; // Returns ID of last error, 0 if no errors (unusable if // Error method raises exception) and clear internal status // into 0 (no errors). function ErrorMsg (AErrorID : integer) : RegExprString; virtual; // Returns Error message for error with ID = AErrorID. property CompilerErrorPos : integer read GetCompilerErrorPos; // Returns pos in r.e. there compiler stopped. // Usefull for error diagnostics property SpaceChars : RegExprString read fSpaceChars write fSpaceChars; //###0.927 // Contains chars, treated as /s (initially filled with RegExprSpaceChars // global constant) property WordChars : RegExprString read fWordChars write fWordChars; //###0.929 // Contains chars, treated as /w (initially filled with RegExprWordChars // global constant) property LineSeparators : RegExprString read fLineSeparators write SetLineSeparators; //###0.941 // line separators (like \n in Unix) property LinePairedSeparator : RegExprString read GetLinePairedSeparator write SetLinePairedSeparator; //###0.941 // paired line separator (like \r\n in DOS and Windows). // must contain exactly two chars or no chars at all class function InvertCaseFunction (const Ch : REChar) : REChar; // Converts Ch into upper case if it in lower case or in lower // if it in upper (uses current system local setings) property InvertCase : TRegExprInvertCaseFunction read fInvertCase write fInvertCase; //##0.935 // Set this property if you want to override case-insensitive functionality. // Create set it to RegExprInvertCaseFunction (InvertCaseFunction by default) procedure Compile; //###0.941 // [Re]compile r.e. Usefull for example for GUI r.e. editors (to check // all properties validity). {$IFDEF RegExpPCodeDump} function Dump : RegExprString; // dump a compiled regexp in vaguely comprehensible form {$ENDIF} end; ERegExpr = class (Exception) public ErrorCode : integer; CompilerErrorPos : integer; end; const RegExprInvertCaseFunction : TRegExprInvertCaseFunction = {$IFDEF FPC} nil {$ELSE} TRegExpr.InvertCaseFunction{$ENDIF}; // defaul for InvertCase property function ExecRegExpr (const ARegExpr, AInputStr : RegExprString) : boolean; // true if string AInputString match regular expression ARegExpr // ! will raise exeption if syntax errors in ARegExpr procedure SplitRegExpr (const ARegExpr, AInputStr : RegExprString; APieces : TStrings); // Split AInputStr into APieces by r.e. ARegExpr occurencies function ReplaceRegExpr (const ARegExpr, AInputStr, AReplaceStr : RegExprString; AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; //###0.947 // Returns AInputStr with r.e. occurencies replaced by AReplaceStr // If AUseSubstitution is true, then AReplaceStr will be used // as template for Substitution methods. // For example: // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*', // 'BLOCK( test1)', 'def "$1" value "$2"', True) // will return: def 'BLOCK' value 'test1' // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*', // 'BLOCK( test1)', 'def "$1" value "$2"') // will return: def "$1" value "$2" function QuoteRegExprMetaChars (const AStr : RegExprString) : RegExprString; // Replace all metachars with its safe representation, // for example 'abc$cd.(' converts into 'abc\$cd\.\(' // This function usefull for r.e. autogeneration from // user input function RegExprSubExpressions (const ARegExpr : string; ASubExprs : TStrings; AExtendedSyntax : boolean{$IFDEF DefParam}= False{$ENDIF}) : integer; // Makes list of subexpressions found in ARegExpr r.e. // In ASubExps every item represent subexpression, // from first to last, in format: // String - subexpression text (without '()') // low word of Object - starting position in ARegExpr, including '(' // if exists! (first position is 1) // high word of Object - length, including starting '(' and ending ')' // if exist! // AExtendedSyntax - must be True if modifier /m will be On while // using the r.e. // Usefull for GUI editors of r.e. etc (You can find example of using // in TestRExp.dpr project) // Returns // 0 Success. No unbalanced brackets was found; // -1 There are not enough closing brackets ')'; // -(n+1) At position n was found opening '[' without //###0.942 // corresponding closing ']'; // n At position n was found closing bracket ')' without // corresponding opening '('. // If Result <> 0, then ASubExpr can contain empty items or illegal ones implementation {$IFNDEF FPC} uses Windows; // CharUpper/Lower {$ENDIF} const TRegExprVersionMajor : integer = 0; TRegExprVersionMinor : integer = 952; // TRegExpr.VersionMajor/Minor return values of this constants MaskModI = 1; // modifier /i bit in fModifiers MaskModR = 2; // -"- /r MaskModS = 4; // -"- /s MaskModG = 8; // -"- /g MaskModM = 16; // -"- /m MaskModX = 32; // -"- /x {$IFDEF UniCode} XIgnoredChars = ' '#9#$d#$a; {$ELSE} XIgnoredChars = [' ', #9, #$d, #$a]; {$ENDIF} {=============================================================} {=================== WideString functions ====================} {=============================================================} {$IFDEF UniCode} function StrPCopy (Dest: PRegExprChar; const Source: RegExprString): PRegExprChar; var i, Len : Integer; begin Len := length (Source); //###0.932 for i := 1 to Len do Dest [i - 1] := Source [i]; Dest [Len] := #0; Result := Dest; end; { of function StrPCopy --------------------------------------------------------------} function StrLCopy (Dest, Source: PRegExprChar; MaxLen: Cardinal): PRegExprChar; var i: Integer; begin for i := 0 to MaxLen - 1 do Dest [i] := Source [i]; Result := Dest; end; { of function StrLCopy --------------------------------------------------------------} function StrLen (Str: PRegExprChar): Cardinal; begin Result:=0; while Str [result] <> #0 do Inc (Result); end; { of function StrLen --------------------------------------------------------------} function StrPos (Str1, Str2: PRegExprChar): PRegExprChar; var n: Integer; begin Result := nil; n := Pos (RegExprString (Str2), RegExprString (Str1)); if n = 0 then EXIT; Result := Str1 + n - 1; end; { of function StrPos --------------------------------------------------------------} function StrLComp (Str1, Str2: PRegExprChar; MaxLen: Cardinal): Integer; var S1, S2: RegExprString; begin S1 := Str1; S2 := Str2; if Copy (S1, 1, MaxLen) > Copy (S2, 1, MaxLen) then Result := 1 else if Copy (S1, 1, MaxLen) < Copy (S2, 1, MaxLen) then Result := -1 else Result := 0; end; { function StrLComp --------------------------------------------------------------} function StrScan (Str: PRegExprChar; Chr: WideChar): PRegExprChar; begin Result := nil; while (Str^ <> #0) and (Str^ <> Chr) do Inc (Str); if (Str^ <> #0) then Result := Str; end; { of function StrScan --------------------------------------------------------------} {$ENDIF} {=============================================================} {===================== Global functions ======================} {=============================================================} function ExecRegExpr (const ARegExpr, AInputStr : RegExprString) : boolean; var r : TRegExpr; begin r := TRegExpr.Create; try r.Expression := ARegExpr; Result := r.Exec (AInputStr); finally r.Free; end; end; { of function ExecRegExpr --------------------------------------------------------------} procedure SplitRegExpr (const ARegExpr, AInputStr : RegExprString; APieces : TStrings); var r : TRegExpr; begin APieces.Clear; r := TRegExpr.Create; try r.Expression := ARegExpr; r.Split (AInputStr, APieces); finally r.Free; end; end; { of procedure SplitRegExpr --------------------------------------------------------------} function ReplaceRegExpr (const ARegExpr, AInputStr, AReplaceStr : RegExprString; AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; begin with TRegExpr.Create do try Expression := ARegExpr; Result := Replace (AInputStr, AReplaceStr, AUseSubstitution); finally Free; end; end; { of function ReplaceRegExpr --------------------------------------------------------------} function QuoteRegExprMetaChars (const AStr : RegExprString) : RegExprString; const RegExprMetaSet : RegExprString = '^$.[()|?+*'+EscChar+'{' + ']}'; // - this last are additional to META. // Very similar to META array, but slighly changed. // !Any changes in META array must be synchronized with this set. var i, i0, Len : integer; begin Result := ''; Len := length (AStr); i := 1; i0 := i; while i <= Len do begin if Pos (AStr [i], RegExprMetaSet) > 0 then begin Result := Result + System.Copy (AStr, i0, i - i0) + EscChar + AStr [i]; i0 := i + 1; end; inc (i); end; Result := Result + System.Copy (AStr, i0, MaxInt); // Tail end; { of function QuoteRegExprMetaChars --------------------------------------------------------------} function RegExprSubExpressions (const ARegExpr : string; ASubExprs : TStrings; AExtendedSyntax : boolean{$IFDEF DefParam}= False{$ENDIF}) : integer; type TStackItemRec = record //###0.945 SubExprIdx : integer; StartPos : integer; end; TStackArray = packed array [0 .. NSUBEXPMAX - 1] of TStackItemRec; var Len, SubExprLen : integer; i, i0 : integer; Modif : integer; Stack : ^TStackArray; //###0.945 StackIdx, StackSz : integer; begin Result := 0; // no unbalanced brackets found at this very moment ASubExprs.Clear; // I don't think that adding to non empty list // can be usefull, so I simplified algorithm to work only with empty list Len := length (ARegExpr); // some optimization tricks // first we have to calculate number of subexpression to reserve // space in Stack array (may be we'll reserve more then need, but // it's faster then memory reallocation during parsing) StackSz := 1; // add 1 for entire r.e. for i := 1 to Len do if ARegExpr [i] = '(' then inc (StackSz); // SetLength (Stack, StackSz); //###0.945 GetMem (Stack, SizeOf (TStackItemRec) * StackSz); try StackIdx := 0; i := 1; while (i <= Len) do begin case ARegExpr [i] of '(': begin if (i < Len) and (ARegExpr [i + 1] = '?') then begin // this is not subexpression, but comment or other // Perl extension. We must check is it (?ismxrg-ismxrg) // and change AExtendedSyntax if /x is changed. inc (i, 2); // skip '(?' i0 := i; while (i <= Len) and (ARegExpr [i] <> ')') do inc (i); if i > Len then Result := -1 // unbalansed '(' else if TRegExpr.ParseModifiersStr (System.Copy (ARegExpr, i, i - i0), Modif) then AExtendedSyntax := (Modif and MaskModX) <> 0; end else begin // subexpression starts ASubExprs.Add (''); // just reserve space with Stack [StackIdx] do begin SubExprIdx := ASubExprs.Count - 1; StartPos := i; end; inc (StackIdx); end; end; ')': begin if StackIdx = 0 then Result := i // unbalanced ')' else begin dec (StackIdx); with Stack [StackIdx] do begin SubExprLen := i - StartPos + 1; ASubExprs.Objects [SubExprIdx] := TObject (StartPos or (SubExprLen ShL 16)); ASubExprs [SubExprIdx] := System.Copy ( ARegExpr, StartPos + 1, SubExprLen - 2); // add without brackets end; end; end; EscChar: inc (i); // skip quoted symbol '[': begin // we have to skip character ranges at once, because they can // contain '#', and '#' in it must NOT be recognized as eXtended // comment beginning! i0 := i; inc (i); if ARegExpr [i] = ']' // cannot be 'emty' ranges - this interpretes then inc (i); // as ']' by itself while (i <= Len) and (ARegExpr [i] <> ']') do if ARegExpr [i] = EscChar //###0.942 then inc (i, 2) // skip 'escaped' char to prevent stopping at '\]' else inc (i); if (i > Len) or (ARegExpr [i] <> ']') //###0.942 then Result := - (i0 + 1); // unbalansed '[' //###0.942 end; '#': if AExtendedSyntax then begin // skip eXtended comments while (i <= Len) and (ARegExpr [i] <> #$d) and (ARegExpr [i] <> #$a) // do not use [#$d, #$a] due to UniCode compatibility do inc (i); while (i + 1 <= Len) and ((ARegExpr [i + 1] = #$d) or (ARegExpr [i + 1] = #$a)) do inc (i); // attempt to work with different kinds of line separators // now we are at the line separator that must be skipped. end; // here is no 'else' clause - we simply skip ordinary chars end; // of case inc (i); // skip scanned char // ! can move after Len due to skipping quoted symbol end; // check brackets balance if StackIdx <> 0 then Result := -1; // unbalansed '(' // check if entire r.e. added if (ASubExprs.Count = 0) or ((integer (ASubExprs.Objects [0]) and $FFFF) <> 1) or (((integer (ASubExprs.Objects [0]) ShR 16) and $FFFF) <> Len) // whole r.e. wasn't added because it isn't bracketed // well, we add it now: then ASubExprs.InsertObject (0, ARegExpr, TObject ((Len ShL 16) or 1)); finally FreeMem (Stack); end; end; { of function RegExprSubExpressions --------------------------------------------------------------} const MAGIC = TREOp (216);// programm signature // name opcode opnd? meaning EEND = TREOp (0); // - End of program BOL = TREOp (1); // - Match "" at beginning of line EOL = TREOp (2); // - Match "" at end of line ANY = TREOp (3); // - Match any one character ANYOF = TREOp (4); // Str Match any character in string Str ANYBUT = TREOp (5); // Str Match any char. not in string Str BRANCH = TREOp (6); // Node Match this alternative, or the next BACK = TREOp (7); // - Jump backward (Next < 0) EXACTLY = TREOp (8); // Str Match string Str NOTHING = TREOp (9); // - Match empty string STAR = TREOp (10); // Node Match this (simple) thing 0 or more times PLUS = TREOp (11); // Node Match this (simple) thing 1 or more times ANYDIGIT = TREOp (12); // - Match any digit (equiv [0-9]) NOTDIGIT = TREOp (13); // - Match not digit (equiv [0-9]) ANYLETTER = TREOp (14); // - Match any letter from property WordChars NOTLETTER = TREOp (15); // - Match not letter from property WordChars ANYSPACE = TREOp (16); // - Match any space char (see property SpaceChars) NOTSPACE = TREOp (17); // - Match not space char (see property SpaceChars) BRACES = TREOp (18); // Node,Min,Max Match this (simple) thing from Min to Max times. // Min and Max are TREBracesArg COMMENT = TREOp (19); // - Comment ;) EXACTLYCI = TREOp (20); // Str Match string Str case insensitive ANYOFCI = TREOp (21); // Str Match any character in string Str, case insensitive ANYBUTCI = TREOp (22); // Str Match any char. not in string Str, case insensitive LOOPENTRY = TREOp (23); // Node Start of loop (Node - LOOP for this loop) LOOP = TREOp (24); // Node,Min,Max,LoopEntryJmp - back jump for LOOPENTRY. // Min and Max are TREBracesArg // Node - next node in sequence, // LoopEntryJmp - associated LOOPENTRY node addr ANYOFTINYSET= TREOp (25); // Chrs Match any one char from Chrs (exactly TinySetLen chars) ANYBUTTINYSET=TREOp (26); // Chrs Match any one char not in Chrs (exactly TinySetLen chars) ANYOFFULLSET= TREOp (27); // Set Match any one char from set of char // - very fast (one CPU instruction !) but takes 32 bytes of p-code BSUBEXP = TREOp (28); // Idx Match previously matched subexpression #Idx (stored as REChar) //###0.936 BSUBEXPCI = TREOp (29); // Idx -"- in case-insensitive mode // Non-Greedy Style Ops //###0.940 STARNG = TREOp (30); // Same as START but in non-greedy mode PLUSNG = TREOp (31); // Same as PLUS but in non-greedy mode BRACESNG = TREOp (32); // Same as BRACES but in non-greedy mode LOOPNG = TREOp (33); // Same as LOOP but in non-greedy mode // Multiline mode \m BOLML = TREOp (34); // - Match "" at beginning of line EOLML = TREOp (35); // - Match "" at end of line ANYML = TREOp (36); // - Match any one character // Word boundary BOUND = TREOp (37); // Match "" between words //###0.943 NOTBOUND = TREOp (38); // Match "" not between words //###0.943 // !!! Change OPEN value if you add new opcodes !!! OPEN = TREOp (39); // - Mark this point in input as start of \n // OPEN + 1 is \1, etc. CLOSE = TREOp (ord (OPEN) + NSUBEXP); // - Analogous to OPEN. // !!! Don't add new OpCodes after CLOSE !!! // We work with p-code thru pointers, compatible with PRegExprChar. // Note: all code components (TRENextOff, TREOp, TREBracesArg, etc) // must have lengths that can be divided by SizeOf (REChar) ! // A node is TREOp of opcode followed Next "pointer" of TRENextOff type. // The Next is a offset from the opcode of the node containing it. // An operand, if any, simply follows the node. (Note that much of // the code generation knows about this implicit relationship!) // Using TRENextOff=integer speed up p-code processing. // Opcodes description: // // BRANCH The set of branches constituting a single choice are hooked // together with their "next" pointers, since precedence prevents // anything being concatenated to any individual branch. The // "next" pointer of the last BRANCH in a choice points to the // thing following the whole choice. This is also where the // final "next" pointer of each individual branch points; each // branch starts with the operand node of a BRANCH node. // BACK Normal "next" pointers all implicitly point forward; BACK // exists to make loop structures possible. // STAR,PLUS,BRACES '?', and complex '*' and '+', are implemented as // circular BRANCH structures using BACK. Complex '{min,max}' // - as pair LOOPENTRY-LOOP (see below). Simple cases (one // character per match) are implemented with STAR, PLUS and // BRACES for speed and to minimize recursive plunges. // LOOPENTRY,LOOP {min,max} are implemented as special pair // LOOPENTRY-LOOP. Each LOOPENTRY initialize loopstack for // current level. // OPEN,CLOSE are numbered at compile time. {=============================================================} {================== Error handling section ===================} {=============================================================} const reeOk = 0; reeCompNullArgument = 100; reeCompRegexpTooBig = 101; reeCompParseRegTooManyBrackets = 102; reeCompParseRegUnmatchedBrackets = 103; reeCompParseRegUnmatchedBrackets2 = 104; reeCompParseRegJunkOnEnd = 105; reePlusStarOperandCouldBeEmpty = 106; reeNestedSQP = 107; reeBadHexDigit = 108; reeInvalidRange = 109; reeParseAtomTrailingBackSlash = 110; reeNoHexCodeAfterBSlashX = 111; reeHexCodeAfterBSlashXTooBig = 112; reeUnmatchedSqBrackets = 113; reeInternalUrp = 114; reeQPSBFollowsNothing = 115; reeTrailingBackSlash = 116; reeRarseAtomInternalDisaster = 119; reeBRACESArgTooBig = 122; reeBracesMinParamGreaterMax = 124; reeUnclosedComment = 125; reeComplexBracesNotImplemented = 126; reeUrecognizedModifier = 127; reeBadLinePairedSeparator = 128; reeRegRepeatCalledInappropriately = 1000; reeMatchPrimMemoryCorruption = 1001; reeMatchPrimCorruptedPointers = 1002; reeNoExpression = 1003; reeCorruptedProgram = 1004; reeNoInpitStringSpecified = 1005; reeOffsetMustBeGreaterThen0 = 1006; reeExecNextWithoutExec = 1007; reeGetInputStringWithoutInputString = 1008; reeDumpCorruptedOpcode = 1011; reeModifierUnsupported = 1013; reeLoopStackExceeded = 1014; reeLoopWithoutEntry = 1015; reeBadPCodeImported = 2000; function TRegExpr.ErrorMsg (AErrorID : integer) : RegExprString; begin case AErrorID of reeOk: Result := 'No errors'; reeCompNullArgument: Result := 'TRegExpr(comp): Null Argument'; reeCompRegexpTooBig: Result := 'TRegExpr(comp): Regexp Too Big'; reeCompParseRegTooManyBrackets: Result := 'TRegExpr(comp): ParseReg Too Many ()'; reeCompParseRegUnmatchedBrackets: Result := 'TRegExpr(comp): ParseReg Unmatched ()'; reeCompParseRegUnmatchedBrackets2: Result := 'TRegExpr(comp): ParseReg Unmatched ()'; reeCompParseRegJunkOnEnd: Result := 'TRegExpr(comp): ParseReg Junk On End'; reePlusStarOperandCouldBeEmpty: Result := 'TRegExpr(comp): *+ Operand Could Be Empty'; reeNestedSQP: Result := 'TRegExpr(comp): Nested *?+'; reeBadHexDigit: Result := 'TRegExpr(comp): Bad Hex Digit'; reeInvalidRange: Result := 'TRegExpr(comp): Invalid [] Range'; reeParseAtomTrailingBackSlash: Result := 'TRegExpr(comp): Parse Atom Trailing \'; reeNoHexCodeAfterBSlashX: Result := 'TRegExpr(comp): No Hex Code After \x'; reeHexCodeAfterBSlashXTooBig: Result := 'TRegExpr(comp): Hex Code After \x Is Too Big'; reeUnmatchedSqBrackets: Result := 'TRegExpr(comp): Unmatched []'; reeInternalUrp: Result := 'TRegExpr(comp): Internal Urp'; reeQPSBFollowsNothing: Result := 'TRegExpr(comp): ?+*{ Follows Nothing'; reeTrailingBackSlash: Result := 'TRegExpr(comp): Trailing \'; reeRarseAtomInternalDisaster: Result := 'TRegExpr(comp): RarseAtom Internal Disaster'; reeBRACESArgTooBig: Result := 'TRegExpr(comp): BRACES Argument Too Big'; reeBracesMinParamGreaterMax: Result := 'TRegExpr(comp): BRACE Min Param Greater then Max'; reeUnclosedComment: Result := 'TRegExpr(comp): Unclosed (?#Comment)'; reeComplexBracesNotImplemented: Result := 'TRegExpr(comp): If you want take part in beta-testing BRACES ''{min,max}'' and non-greedy ops ''*?'', ''+?'', ''??'' for complex cases - remove ''.'' from {.$DEFINE ComplexBraces}'; reeUrecognizedModifier: Result := 'TRegExpr(comp): Urecognized Modifier'; reeBadLinePairedSeparator: Result := 'TRegExpr(comp): LinePairedSeparator must countain two different chars or no chars at all'; reeRegRepeatCalledInappropriately: Result := 'TRegExpr(exec): RegRepeat Called Inappropriately'; reeMatchPrimMemoryCorruption: Result := 'TRegExpr(exec): MatchPrim Memory Corruption'; reeMatchPrimCorruptedPointers: Result := 'TRegExpr(exec): MatchPrim Corrupted Pointers'; reeNoExpression: Result := 'TRegExpr(exec): Not Assigned Expression Property'; reeCorruptedProgram: Result := 'TRegExpr(exec): Corrupted Program'; reeNoInpitStringSpecified: Result := 'TRegExpr(exec): No Input String Specified'; reeOffsetMustBeGreaterThen0: Result := 'TRegExpr(exec): Offset Must Be Greater Then 0'; reeExecNextWithoutExec: Result := 'TRegExpr(exec): ExecNext Without Exec[Pos]'; reeGetInputStringWithoutInputString: Result := 'TRegExpr(exec): GetInputString Without InputString'; reeDumpCorruptedOpcode: Result := 'TRegExpr(dump): Corrupted Opcode'; reeLoopStackExceeded: Result := 'TRegExpr(exec): Loop Stack Exceeded'; reeLoopWithoutEntry: Result := 'TRegExpr(exec): Loop Without LoopEntry !'; reeBadPCodeImported: Result := 'TRegExpr(misc): Bad p-code imported'; else Result := 'Unknown error'; end; end; { of procedure TRegExpr.Error --------------------------------------------------------------} function TRegExpr.LastError : integer; begin Result := fLastError; fLastError := reeOk; end; { of function TRegExpr.LastError --------------------------------------------------------------} {=============================================================} {===================== Common section ========================} {=============================================================} class function TRegExpr.VersionMajor : integer; //###0.944 begin Result := TRegExprVersionMajor; end; { of class function TRegExpr.VersionMajor --------------------------------------------------------------} class function TRegExpr.VersionMinor : integer; //###0.944 begin Result := TRegExprVersionMinor; end; { of class function TRegExpr.VersionMinor --------------------------------------------------------------} constructor TRegExpr.Create; begin inherited; programm := nil; fExpression := nil; fInputString := nil; regexpbeg := nil; fExprIsCompiled := false; ModifierI := RegExprModifierI; ModifierR := RegExprModifierR; ModifierS := RegExprModifierS; ModifierG := RegExprModifierG; ModifierM := RegExprModifierM; //###0.940 SpaceChars := RegExprSpaceChars; //###0.927 WordChars := RegExprWordChars; //###0.929 fInvertCase := RegExprInvertCaseFunction; //###0.927 fLineSeparators := RegExprLineSeparators; //###0.941 LinePairedSeparator := RegExprLinePairedSeparator; //###0.941 end; { of constructor TRegExpr.Create --------------------------------------------------------------} destructor TRegExpr.Destroy; begin if programm <> nil then FreeMem (programm); if fExpression <> nil then FreeMem (fExpression); if fInputString <> nil then FreeMem (fInputString); end; { of destructor TRegExpr.Destroy --------------------------------------------------------------} class function TRegExpr.InvertCaseFunction (const Ch : REChar) : REChar; begin {$IFDEF UniCode} if Ch >= #128 then Result := Ch else {$ENDIF} begin Result := {$IFDEF FPC}AnsiUpperCase (Ch) [1]{$ELSE} REChar (CharUpper (PChar (Ch))){$ENDIF}; if Result = Ch then Result := {$IFDEF FPC}AnsiLowerCase (Ch) [1]{$ELSE} REChar (CharLower (PChar (Ch))){$ENDIF}; end; end; { of function TRegExpr.InvertCaseFunction --------------------------------------------------------------} function TRegExpr.GetExpression : RegExprString; begin if fExpression <> nil then Result := fExpression else Result := ''; end; { of function TRegExpr.GetExpression --------------------------------------------------------------} procedure TRegExpr.SetExpression (const s : RegExprString); var Len : integer; //###0.950 begin if (s <> fExpression) or not fExprIsCompiled then begin fExprIsCompiled := false; if fExpression <> nil then begin FreeMem (fExpression); fExpression := nil; end; if s <> '' then begin Len := length (s); //###0.950 GetMem (fExpression, (Len + 1) * SizeOf (REChar)); // StrPCopy (fExpression, s); //###0.950 replaced due to StrPCopy limitation of 255 chars {$IFDEF UniCode} StrPCopy (fExpression, Copy (s, 1, Len)); //###0.950 {$ELSE} StrLCopy (fExpression, PRegExprChar (s), Len); //###0.950 {$ENDIF UniCode} InvalidateProgramm; //###0.941 end; end; end; { of procedure TRegExpr.SetExpression --------------------------------------------------------------} function TRegExpr.GetSubExprMatchCount : integer; begin if Assigned (fInputString) then begin Result := NSUBEXP - 1; while (Result > 0) and ((startp [Result] = nil) or (endp [Result] = nil)) do dec (Result); end else Result := -1; end; { of function TRegExpr.GetSubExprMatchCount --------------------------------------------------------------} function TRegExpr.GetMatchPos (Idx : integer) : integer; begin if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) and Assigned (startp [Idx]) and Assigned (endp [Idx]) then begin Result := (startp [Idx] - fInputString) + 1; end else Result := -1; end; { of function TRegExpr.GetMatchPos --------------------------------------------------------------} function TRegExpr.GetMatchLen (Idx : integer) : integer; begin if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) and Assigned (startp [Idx]) and Assigned (endp [Idx]) then begin Result := endp [Idx] - startp [Idx]; end else Result := -1; end; { of function TRegExpr.GetMatchLen --------------------------------------------------------------} function TRegExpr.GetMatch (Idx : integer) : RegExprString; begin if (Idx >= 0) and (Idx < NSUBEXP) and Assigned (fInputString) and Assigned (startp [Idx]) and Assigned (endp [Idx]) //then Result := copy (fInputString, MatchPos [Idx], MatchLen [Idx]) //###0.929 then SetString (Result, startp [idx], endp [idx] - startp [idx]) else Result := ''; end; { of function TRegExpr.GetMatch --------------------------------------------------------------} function TRegExpr.GetModifierStr : RegExprString; begin Result := '-'; if ModifierI then Result := 'i' + Result else Result := Result + 'i'; if ModifierR then Result := 'r' + Result else Result := Result + 'r'; if ModifierS then Result := 's' + Result else Result := Result + 's'; if ModifierG then Result := 'g' + Result else Result := Result + 'g'; if ModifierM then Result := 'm' + Result else Result := Result + 'm'; if ModifierX then Result := 'x' + Result else Result := Result + 'x'; if Result [length (Result)] = '-' // remove '-' if all modifiers are 'On' then System.Delete (Result, length (Result), 1); end; { of function TRegExpr.GetModifierStr --------------------------------------------------------------} class function TRegExpr.ParseModifiersStr (const AModifiers : RegExprString; var AModifiersInt : integer) : boolean; // !!! Be carefull - this is class function and must not use object instance fields var i : integer; IsOn : boolean; Mask : integer; begin Result := true; IsOn := true; Mask := 0; // prevent compiler warning for i := 1 to length (AModifiers) do if AModifiers [i] = '-' then IsOn := false else begin if Pos (AModifiers [i], 'iI') > 0 then Mask := MaskModI else if Pos (AModifiers [i], 'rR') > 0 then Mask := MaskModR else if Pos (AModifiers [i], 'sS') > 0 then Mask := MaskModS else if Pos (AModifiers [i], 'gG') > 0 then Mask := MaskModG else if Pos (AModifiers [i], 'mM') > 0 then Mask := MaskModM else if Pos (AModifiers [i], 'xX') > 0 then Mask := MaskModX else begin Result := false; EXIT; end; if IsOn then AModifiersInt := AModifiersInt or Mask else AModifiersInt := AModifiersInt and not Mask; end; end; { of function TRegExpr.ParseModifiersStr --------------------------------------------------------------} procedure TRegExpr.SetModifierStr (const AModifiers : RegExprString); begin if not ParseModifiersStr (AModifiers, fModifiers) then Error (reeModifierUnsupported); end; { of procedure TRegExpr.SetModifierStr --------------------------------------------------------------} function TRegExpr.GetModifier (AIndex : integer) : boolean; var Mask : integer; begin Result := false; case AIndex of 1: Mask := MaskModI; 2: Mask := MaskModR; 3: Mask := MaskModS; 4: Mask := MaskModG; 5: Mask := MaskModM; 6: Mask := MaskModX; else begin Error (reeModifierUnsupported); EXIT; end; end; Result := (fModifiers and Mask) <> 0; end; { of function TRegExpr.GetModifier --------------------------------------------------------------} procedure TRegExpr.SetModifier (AIndex : integer; ASet : boolean); var Mask : integer; begin case AIndex of 1: Mask := MaskModI; 2: Mask := MaskModR; 3: Mask := MaskModS; 4: Mask := MaskModG; 5: Mask := MaskModM; 6: Mask := MaskModX; else begin Error (reeModifierUnsupported); EXIT; end; end; if ASet then fModifiers := fModifiers or Mask else fModifiers := fModifiers and not Mask; end; { of procedure TRegExpr.SetModifier --------------------------------------------------------------} {=============================================================} {==================== Compiler section =======================} {=============================================================} procedure TRegExpr.InvalidateProgramm; begin if programm <> nil then begin FreeMem (programm); programm := nil; end; end; { of procedure TRegExpr.InvalidateProgramm --------------------------------------------------------------} procedure TRegExpr.Compile; //###0.941 begin if fExpression = nil then begin // No Expression assigned Error (reeNoExpression); EXIT; end; CompileRegExpr (fExpression); end; { of procedure TRegExpr.Compile --------------------------------------------------------------} function TRegExpr.IsProgrammOk : boolean; {$IFNDEF UniCode} var i : integer; {$ENDIF} begin Result := false; // check modifiers if fModifiers <> fProgModifiers //###0.941 then InvalidateProgramm; // can we optimize line separators by using sets? {$IFNDEF UniCode} fLineSeparatorsSet := []; for i := 1 to length (fLineSeparators) do System.Include (fLineSeparatorsSet, fLineSeparators [i]); {$ENDIF} // [Re]compile if needed if programm = nil then Compile; //###0.941 // check [re]compiled programm if programm = nil then EXIT // error was set/raised by Compile (was reeExecAfterCompErr) else if programm [0] <> MAGIC // Program corrupted. then Error (reeCorruptedProgram) else Result := true; end; { of function TRegExpr.IsProgrammOk --------------------------------------------------------------} procedure TRegExpr.Tail (p : PRegExprChar; val : PRegExprChar); // set the next-pointer at the end of a node chain var scan : PRegExprChar; temp : PRegExprChar; // i : int64; begin if p = @regdummy then EXIT; // Find last node. scan := p; REPEAT temp := regnext (scan); if temp = nil then BREAK; scan := temp; UNTIL false; // Set Next 'pointer' if val < scan then PRENextOff (scan + REOpSz)^ := - (scan - val) //###0.948 // work around PWideChar subtraction bug (Delphi uses // shr after subtraction to calculate widechar distance %-( ) // so, if difference is negative we have .. the "feature" :( // I could wrap it in $IFDEF UniCode, but I didn't because // "P Q computes the difference between the address given // by P (the higher address) and the address given by Q (the // lower address)" - Delphi help quotation. else PRENextOff (scan + REOpSz)^ := val - scan; //###0.933 end; { of procedure TRegExpr.Tail --------------------------------------------------------------} procedure TRegExpr.OpTail (p : PRegExprChar; val : PRegExprChar); // regtail on operand of first argument; nop if operandless begin // "Operandless" and "op != BRANCH" are synonymous in practice. if (p = nil) or (p = @regdummy) or (PREOp (p)^ <> BRANCH) then EXIT; Tail (p + REOpSz + RENextOffSz, val); //###0.933 end; { of procedure TRegExpr.OpTail --------------------------------------------------------------} function TRegExpr.EmitNode (op : TREOp) : PRegExprChar; //###0.933 // emit a node, return location begin Result := regcode; if Result <> @regdummy then begin PREOp (regcode)^ := op; inc (regcode, REOpSz); PRENextOff (regcode)^ := 0; // Next "pointer" := nil inc (regcode, RENextOffSz); end else inc (regsize, REOpSz + RENextOffSz); // compute code size without code generation end; { of function TRegExpr.EmitNode --------------------------------------------------------------} procedure TRegExpr.EmitC (b : REChar); // emit a byte to code begin if regcode <> @regdummy then begin regcode^ := b; inc (regcode); end else inc (regsize); // Type of p-code pointer always is ^REChar end; { of procedure TRegExpr.EmitC --------------------------------------------------------------} procedure TRegExpr.InsertOperator (op : TREOp; opnd : PRegExprChar; sz : integer); // insert an operator in front of already-emitted operand // Means relocating the operand. var src, dst, place : PRegExprChar; i : integer; begin if regcode = @regdummy then begin inc (regsize, sz); EXIT; end; src := regcode; inc (regcode, sz); dst := regcode; while src > opnd do begin dec (dst); dec (src); dst^ := src^; end; place := opnd; // Op node, where operand used to be. PREOp (place)^ := op; inc (place, REOpSz); for i := 1 + REOpSz to sz do begin place^ := #0; inc (place); end; end; { of procedure TRegExpr.InsertOperator --------------------------------------------------------------} function strcspn (s1 : PRegExprChar; s2 : PRegExprChar) : integer; // find length of initial segment of s1 consisting // entirely of characters not from s2 var scan1, scan2 : PRegExprChar; begin Result := 0; scan1 := s1; while scan1^ <> #0 do begin scan2 := s2; while scan2^ <> #0 do if scan1^ = scan2^ then EXIT else inc (scan2); inc (Result); inc (scan1) end; end; { of function strcspn --------------------------------------------------------------} const // Flags to be passed up and down. HASWIDTH = 01; // Known never to match nil string. SIMPLE = 02; // Simple enough to be STAR/PLUS/BRACES operand. SPSTART = 04; // Starts with * or +. WORST = 0; // Worst case. META : array [0 .. 12] of REChar = ( '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{', #0); // Any modification must be synchronized with QuoteRegExprMetaChars !!! {$IFDEF UniCode} RusRangeLo : array [0 .. 33] of REChar = (#$430,#$431,#$432,#$433,#$434,#$435,#$451,#$436,#$437, #$438,#$439,#$43A,#$43B,#$43C,#$43D,#$43E,#$43F, #$440,#$441,#$442,#$443,#$444,#$445,#$446,#$447, #$448,#$449,#$44A,#$44B,#$44C,#$44D,#$44E,#$44F,#0); RusRangeHi : array [0 .. 33] of REChar = (#$410,#$411,#$412,#$413,#$414,#$415,#$401,#$416,#$417, #$418,#$419,#$41A,#$41B,#$41C,#$41D,#$41E,#$41F, #$420,#$421,#$422,#$423,#$424,#$425,#$426,#$427, #$428,#$429,#$42A,#$42B,#$42C,#$42D,#$42E,#$42F,#0); RusRangeLoLow = #$430{''}; RusRangeLoHigh = #$44F{''}; RusRangeHiLow = #$410{''}; RusRangeHiHigh = #$42F{''}; {$ELSE} RusRangeLo = ''; RusRangeHi = 'Ũ'; RusRangeLoLow = ''; RusRangeLoHigh = ''; RusRangeHiLow = ''; RusRangeHiHigh = ''; {$ENDIF} function TRegExpr.CompileRegExpr (exp : PRegExprChar) : boolean; // compile a regular expression into internal code // We can't allocate space until we know how big the compiled form will be, // but we can't compile it (and thus know how big it is) until we've got a // place to put the code. So we cheat: we compile it twice, once with code // generation turned off and size counting turned on, and once "for real". // This also means that we don't allocate space until we are sure that the // thing really will compile successfully, and we never have to move the // code and thus invalidate pointers into it. (Note that it has to be in // one piece because free() must be able to free it all.) // Beware that the optimization-preparation code in here knows about some // of the structure of the compiled regexp. var scan, longest : PRegExprChar; len : cardinal; flags : integer; begin Result := false; // life too dark regparse := nil; // for correct error handling regexpbeg := exp; try if programm <> nil then begin FreeMem (programm); programm := nil; end; if exp = nil then begin Error (reeCompNullArgument); EXIT; end; fProgModifiers := fModifiers; // well, may it's paranoia. I'll check it later... !!!!!!!! // First pass: determine size, legality. fCompModifiers := fModifiers; regparse := exp; regnpar := 1; regsize := 0; regcode := @regdummy; EmitC (MAGIC); if ParseReg (0, flags) = nil then EXIT; // Small enough for 2-bytes programm pointers ? // ###0.933 no real p-code length limits now :))) // if regsize >= 64 * 1024 then begin // Error (reeCompRegexpTooBig); // EXIT; // end; // Allocate space. GetMem (programm, regsize * SizeOf (REChar)); // Second pass: emit code. fCompModifiers := fModifiers; regparse := exp; regnpar := 1; regcode := programm; EmitC (MAGIC); if ParseReg (0, flags) = nil then EXIT; // Dig out information for optimizations. {$IFDEF UseFirstCharSet} //###0.929 FirstCharSet := []; FillFirstCharSet (programm + REOpSz); {$ENDIF} regstart := #0; // Worst-case defaults. reganch := #0; regmust := nil; regmlen := 0; scan := programm + REOpSz; // First BRANCH. if PREOp (regnext (scan))^ = EEND then begin // Only one top-level choice. scan := scan + REOpSz + RENextOffSz; // Starting-point info. if PREOp (scan)^ = EXACTLY then regstart := (scan + REOpSz + RENextOffSz)^ else if PREOp (scan)^ = BOL then inc (reganch); // If there's something expensive in the r.e., find the longest // literal string that must appear and make it the regmust. Resolve // ties in favor of later strings, since the regstart check works // with the beginning of the r.e. and avoiding duplication // strengthens checking. Not a strong reason, but sufficient in the // absence of others. if (flags and SPSTART) <> 0 then begin longest := nil; len := 0; while scan <> nil do begin if (PREOp (scan)^ = EXACTLY) and (strlen (scan + REOpSz + RENextOffSz) >= len) then begin longest := scan + REOpSz + RENextOffSz; len := strlen (longest); end; scan := regnext (scan); end; regmust := longest; regmlen := len; end; end; Result := true; finally begin if not Result then InvalidateProgramm; regexpbeg := nil; fExprIsCompiled := Result; //###0.944 end; end; end; { of function TRegExpr.CompileRegExpr --------------------------------------------------------------} function TRegExpr.ParseReg (paren : integer; var flagp : integer) : PRegExprChar; // regular expression, i.e. main body or parenthesized thing // Caller must absorb opening parenthesis. // Combining parenthesis handling with the base level of regular expression // is a trifle forced, but the need to tie the tails of the branches to what // follows makes it hard to avoid. var ret, br, ender : PRegExprChar; parno : integer; flags : integer; SavedModifiers : integer; begin Result := nil; flagp := HASWIDTH; // Tentatively. parno := 0; // eliminate compiler stupid warning SavedModifiers := fCompModifiers; // Make an OPEN node, if parenthesized. if paren <> 0 then begin if regnpar >= NSUBEXP then begin Error (reeCompParseRegTooManyBrackets); EXIT; end; parno := regnpar; inc (regnpar); ret := EmitNode (TREOp (ord (OPEN) + parno)); end else ret := nil; // Pick up the branches, linking them together. br := ParseBranch (flags); if br = nil then begin Result := nil; EXIT; end; if ret <> nil then Tail (ret, br) // OPEN -> first. else ret := br; if (flags and HASWIDTH) = 0 then flagp := flagp and not HASWIDTH; flagp := flagp or flags and SPSTART; while (regparse^ = '|') do begin inc (regparse); br := ParseBranch (flags); if br = nil then begin Result := nil; EXIT; end; Tail (ret, br); // BRANCH -> BRANCH. if (flags and HASWIDTH) = 0 then flagp := flagp and not HASWIDTH; flagp := flagp or flags and SPSTART; end; // Make a closing node, and hook it on the end. if paren <> 0 then ender := EmitNode (TREOp (ord (CLOSE) + parno)) else ender := EmitNode (EEND); Tail (ret, ender); // Hook the tails of the branches to the closing node. br := ret; while br <> nil do begin OpTail (br, ender); br := regnext (br); end; // Check for proper termination. if paren <> 0 then if regparse^ <> ')' then begin Error (reeCompParseRegUnmatchedBrackets); EXIT; end else inc (regparse); // skip trailing ')' if (paren = 0) and (regparse^ <> #0) then begin if regparse^ = ')' then Error (reeCompParseRegUnmatchedBrackets2) else Error (reeCompParseRegJunkOnEnd); EXIT; end; fCompModifiers := SavedModifiers; // restore modifiers of parent Result := ret; end; { of function TRegExpr.ParseReg --------------------------------------------------------------} function TRegExpr.ParseBranch (var flagp : integer) : PRegExprChar; // one alternative of an | operator // Implements the concatenation operator. var ret, chain, latest : PRegExprChar; flags : integer; begin flagp := WORST; // Tentatively. ret := EmitNode (BRANCH); chain := nil; while (regparse^ <> #0) and (regparse^ <> '|') and (regparse^ <> ')') do begin latest := ParsePiece (flags); if latest = nil then begin Result := nil; EXIT; end; flagp := flagp or flags and HASWIDTH; if chain = nil // First piece. then flagp := flagp or flags and SPSTART else Tail (chain, latest); chain := latest; end; if chain = nil // Loop ran zero times. then EmitNode (NOTHING); Result := ret; end; { of function TRegExpr.ParseBranch --------------------------------------------------------------} function TRegExpr.ParsePiece (var flagp : integer) : PRegExprChar; // something followed by possible [*+?{] // Note that the branching code sequences used for ? and the general cases // of * and + and { are somewhat optimized: they use the same NOTHING node as // both the endmarker for their branch list and the body of the last branch. // It might seem that this node could be dispensed with entirely, but the // endmarker role is not redundant. function parsenum (AStart, AEnd : PRegExprChar) : TREBracesArg; begin Result := 0; if AEnd - AStart + 1 > 8 then begin // prevent stupid scanning Error (reeBRACESArgTooBig); EXIT; end; while AStart <= AEnd do begin Result := Result * 10 + (ord (AStart^) - ord ('0')); inc (AStart); end; if (Result > MaxBracesArg) or (Result < 0) then begin Error (reeBRACESArgTooBig); EXIT; end; end; var op : REChar; NonGreedyOp, NonGreedyCh : boolean; //###0.940 TheOp : TREOp; //###0.940 NextNode : PRegExprChar; flags : integer; BracesMin, Bracesmax : TREBracesArg; p, savedparse : PRegExprChar; procedure EmitComplexBraces (ABracesMin, ABracesMax : TREBracesArg; ANonGreedyOp : boolean); //###0.940 {$IFDEF ComplexBraces} var off : integer; {$ENDIF} begin {$IFNDEF ComplexBraces} Error (reeComplexBracesNotImplemented); {$ELSE} if ANonGreedyOp then TheOp := LOOPNG else TheOp := LOOP; InsertOperator (LOOPENTRY, Result, REOpSz + RENextOffSz); NextNode := EmitNode (TheOp); if regcode <> @regdummy then begin off := (Result + REOpSz + RENextOffSz) - (regcode - REOpSz - RENextOffSz); // back to Atom after LOOPENTRY PREBracesArg (regcode)^ := ABracesMin; inc (regcode, REBracesArgSz); PREBracesArg (regcode)^ := ABracesMax; inc (regcode, REBracesArgSz); PRENextOff (regcode)^ := off; inc (regcode, RENextOffSz); end else inc (regsize, REBracesArgSz * 2 + RENextOffSz); Tail (Result, NextNode); // LOOPENTRY -> LOOP if regcode <> @regdummy then Tail (Result + REOpSz + RENextOffSz, NextNode); // Atom -> LOOP {$ENDIF} end; procedure EmitSimpleBraces (ABracesMin, ABracesMax : TREBracesArg; ANonGreedyOp : boolean); //###0.940 begin if ANonGreedyOp //###0.940 then TheOp := BRACESNG else TheOp := BRACES; InsertOperator (TheOp, Result, REOpSz + RENextOffSz + REBracesArgSz * 2); if regcode <> @regdummy then begin PREBracesArg (Result + REOpSz + RENextOffSz)^ := ABracesMin; PREBracesArg (Result + REOpSz + RENextOffSz + REBracesArgSz)^ := ABracesMax; end; end; begin Result := ParseAtom (flags); if Result = nil then EXIT; op := regparse^; if not ((op = '*') or (op = '+') or (op = '?') or (op = '{')) then begin flagp := flags; EXIT; end; if ((flags and HASWIDTH) = 0) and (op <> '?') then begin Error (reePlusStarOperandCouldBeEmpty); EXIT; end; case op of '*': begin flagp := WORST or SPSTART; NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 if (flags and SIMPLE) = 0 then begin if NonGreedyOp //###0.940 then EmitComplexBraces (0, MaxBracesArg, NonGreedyOp) else begin // Emit x* as (x&|), where & means "self". InsertOperator (BRANCH, Result, REOpSz + RENextOffSz); // Either x OpTail (Result, EmitNode (BACK)); // and loop OpTail (Result, Result); // back Tail (Result, EmitNode (BRANCH)); // or Tail (Result, EmitNode (NOTHING)); // nil. end end else begin // Simple if NonGreedyOp //###0.940 then TheOp := STARNG else TheOp := STAR; InsertOperator (TheOp, Result, REOpSz + RENextOffSz); end; if NonGreedyCh //###0.940 then inc (regparse); // Skip extra char ('?') end; { of case '*'} '+': begin flagp := WORST or SPSTART or HASWIDTH; NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 if (flags and SIMPLE) = 0 then begin if NonGreedyOp //###0.940 then EmitComplexBraces (1, MaxBracesArg, NonGreedyOp) else begin // Emit x+ as x(&|), where & means "self". NextNode := EmitNode (BRANCH); // Either Tail (Result, NextNode); Tail (EmitNode (BACK), Result); // loop back Tail (NextNode, EmitNode (BRANCH)); // or Tail (Result, EmitNode (NOTHING)); // nil. end end else begin // Simple if NonGreedyOp //###0.940 then TheOp := PLUSNG else TheOp := PLUS; InsertOperator (TheOp, Result, REOpSz + RENextOffSz); end; if NonGreedyCh //###0.940 then inc (regparse); // Skip extra char ('?') end; { of case '+'} '?': begin flagp := WORST; NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 if NonGreedyOp then begin //###0.940 // We emit x?? as x{0,1}? if (flags and SIMPLE) = 0 then EmitComplexBraces (0, 1, NonGreedyOp) else EmitSimpleBraces (0, 1, NonGreedyOp); end else begin // greedy '?' InsertOperator (BRANCH, Result, REOpSz + RENextOffSz); // Either x Tail (Result, EmitNode (BRANCH)); // or NextNode := EmitNode (NOTHING); // nil. Tail (Result, NextNode); OpTail (Result, NextNode); end; if NonGreedyCh //###0.940 then inc (regparse); // Skip extra char ('?') end; { of case '?'} '{': begin savedparse := regparse; // !!!!!!!!!!!! // Filip Jirsak's note - what will happen, when we are at the end of regparse? inc (regparse); p := regparse; while Pos (regparse^, '0123456789') > 0 // MUST appear do inc (regparse); if (regparse^ <> '}') and (regparse^ <> ',') or (p = regparse) then begin regparse := savedparse; flagp := flags; EXIT; end; BracesMin := parsenum (p, regparse - 1); if regparse^ = ',' then begin inc (regparse); p := regparse; while Pos (regparse^, '0123456789') > 0 do inc (regparse); if regparse^ <> '}' then begin regparse := savedparse; EXIT; end; if p = regparse then BracesMax := MaxBracesArg else BracesMax := parsenum (p, regparse - 1); end else BracesMax := BracesMin; // {n} == {n,n} if BracesMin > BracesMax then begin Error (reeBracesMinParamGreaterMax); EXIT; end; if BracesMin > 0 then flagp := WORST; if BracesMax > 0 then flagp := flagp or HASWIDTH or SPSTART; NonGreedyCh := (regparse + 1)^ = '?'; //###0.940 NonGreedyOp := NonGreedyCh or ((fCompModifiers and MaskModG) = 0); //###0.940 if (flags and SIMPLE) <> 0 then EmitSimpleBraces (BracesMin, BracesMax, NonGreedyOp) else EmitComplexBraces (BracesMin, BracesMax, NonGreedyOp); if NonGreedyCh //###0.940 then inc (regparse); // Skip extra char '?' end; { of case '{'} // else // here we can't be end; { of case op} inc (regparse); if (regparse^ = '*') or (regparse^ = '+') or (regparse^ = '?') or (regparse^ = '{') then begin Error (reeNestedSQP); EXIT; end; end; { of function TRegExpr.ParsePiece --------------------------------------------------------------} function TRegExpr.ParseAtom (var flagp : integer) : PRegExprChar; // the lowest level // Optimization: gobbles an entire sequence of ordinary characters so that // it can turn them into a single node, which is smaller to store and // faster to run. Backslashed characters are exceptions, each becoming a // separate node; the code is simpler that way and it's not worth fixing. var ret : PRegExprChar; flags : integer; RangeBeg, RangeEnd : REChar; CanBeRange : boolean; len : integer; ender : REChar; begmodfs : PRegExprChar; {$IFDEF UseSetOfChar} //###0.930 RangePCodeBeg : PRegExprChar; RangePCodeIdx : integer; RangeIsCI : boolean; RangeSet : TSetOfREChar; RangeLen : integer; RangeChMin, RangeChMax : REChar; {$ENDIF} procedure EmitExactly (ch : REChar); begin if (fCompModifiers and MaskModI) <> 0 then ret := EmitNode (EXACTLYCI) else ret := EmitNode (EXACTLY); EmitC (ch); EmitC (#0); flagp := flagp or HASWIDTH or SIMPLE; end; procedure EmitStr (const s : RegExprString); var i : integer; begin for i := 1 to length (s) do EmitC (s [i]); end; function HexDig (ch : REChar) : integer; begin Result := 0; if (ch >= 'a') and (ch <= 'f') then ch := REChar (ord (ch) - (ord ('a') - ord ('A'))); if (ch < '0') or (ch > 'F') or ((ch > '9') and (ch < 'A')) then begin Error (reeBadHexDigit); EXIT; end; Result := ord (ch) - ord ('0'); if ch >= 'A' then Result := Result - (ord ('A') - ord ('9') - 1); end; function EmitRange (AOpCode : REChar) : PRegExprChar; begin {$IFDEF UseSetOfChar} case AOpCode of ANYBUTCI, ANYBUT: Result := EmitNode (ANYBUTTINYSET); else // ANYOFCI, ANYOF Result := EmitNode (ANYOFTINYSET); end; case AOpCode of ANYBUTCI, ANYOFCI: RangeIsCI := True; else // ANYBUT, ANYOF RangeIsCI := False; end; RangePCodeBeg := regcode; RangePCodeIdx := regsize; RangeLen := 0; RangeSet := []; RangeChMin := #255; RangeChMax := #0; {$ELSE} Result := EmitNode (AOpCode); // ToDo: // !!!!!!!!!!!!! Implement ANYOF[BUT]TINYSET generation for UniCode !!!!!!!!!! {$ENDIF} end; {$IFDEF UseSetOfChar} procedure EmitRangeCPrim (b : REChar); //###0.930 begin if b in RangeSet then EXIT; inc (RangeLen); if b < RangeChMin then RangeChMin := b; if b > RangeChMax then RangeChMax := b; Include (RangeSet, b); end; {$ENDIF} procedure EmitRangeC (b : REChar); {$IFDEF UseSetOfChar} var Ch : REChar; {$ENDIF} begin CanBeRange := false; {$IFDEF UseSetOfChar} if b <> #0 then begin EmitRangeCPrim (b); //###0.930 if RangeIsCI then EmitRangeCPrim (InvertCase (b)); //###0.930 end else begin {$IFDEF UseAsserts} Assert (RangeLen > 0, 'TRegExpr.ParseAtom(subroutine EmitRangeC): empty range'); // impossible, but who knows.. Assert (RangeChMin <= RangeChMax, 'TRegExpr.ParseAtom(subroutine EmitRangeC): RangeChMin > RangeChMax'); // impossible, but who knows.. {$ENDIF} if RangeLen <= TinySetLen then begin // emit "tiny set" if regcode = @regdummy then begin regsize := RangePCodeIdx + TinySetLen; // RangeChMin/Max !!! EXIT; end; regcode := RangePCodeBeg; for Ch := RangeChMin to RangeChMax do //###0.930 if Ch in RangeSet then begin regcode^ := Ch; inc (regcode); end; // fill rest: while regcode < RangePCodeBeg + TinySetLen do begin regcode^ := RangeChMax; inc (regcode); end; end else begin if regcode = @regdummy then begin regsize := RangePCodeIdx + SizeOf (TSetOfREChar); EXIT; end; if (RangePCodeBeg - REOpSz - RENextOffSz)^ = ANYBUTTINYSET then RangeSet := [#0 .. #255] - RangeSet; PREOp (RangePCodeBeg - REOpSz - RENextOffSz)^ := ANYOFFULLSET; regcode := RangePCodeBeg; Move (RangeSet, regcode^, SizeOf (TSetOfREChar)); inc (regcode, SizeOf (TSetOfREChar)); end; end; {$ELSE} EmitC (b); {$ENDIF} end; procedure EmitSimpleRangeC (b : REChar); begin RangeBeg := b; EmitRangeC (b); CanBeRange := true; end; procedure EmitRangeStr (const s : RegExprString); var i : integer; begin for i := 1 to length (s) do EmitRangeC (s [i]); end; function UnQuoteChar (var APtr : PRegExprChar) : REChar; //###0.934 begin case APtr^ of 't': Result := #$9; // tab (HT/TAB) 'n': Result := #$a; // newline (NL) 'r': Result := #$d; // car.return (CR) 'f': Result := #$c; // form feed (FF) 'a': Result := #$7; // alarm (bell) (BEL) 'e': Result := #$1b; // escape (ESC) 'x': begin // hex char Result := #0; inc (APtr); if APtr^ = #0 then begin Error (reeNoHexCodeAfterBSlashX); EXIT; end; if APtr^ = '{' then begin // \x{nnnn} //###0.936 REPEAT inc (APtr); if APtr^ = #0 then begin Error (reeNoHexCodeAfterBSlashX); EXIT; end; if APtr^ <> '}' then begin if (Ord (Result) ShR (SizeOf (REChar) * 8 - 4)) and $F <> 0 then begin Error (reeHexCodeAfterBSlashXTooBig); EXIT; end; Result := REChar ((Ord (Result) ShL 4) or HexDig (APtr^)); // HexDig will cause Error if bad hex digit found end else BREAK; UNTIL False; end else begin Result := REChar (HexDig (APtr^)); // HexDig will cause Error if bad hex digit found inc (APtr); if APtr^ = #0 then begin Error (reeNoHexCodeAfterBSlashX); EXIT; end; Result := REChar ((Ord (Result) ShL 4) or HexDig (APtr^)); // HexDig will cause Error if bad hex digit found end; end; else Result := APtr^; end; end; begin Result := nil; flagp := WORST; // Tentatively. inc (regparse); case (regparse - 1)^ of '^': if ((fCompModifiers and MaskModM) = 0) or ((fLineSeparators = '') and not fLinePairedSeparatorAssigned) then ret := EmitNode (BOL) else ret := EmitNode (BOLML); '$': if ((fCompModifiers and MaskModM) = 0) or ((fLineSeparators = '') and not fLinePairedSeparatorAssigned) then ret := EmitNode (EOL) else ret := EmitNode (EOLML); '.': if (fCompModifiers and MaskModS) <> 0 then begin ret := EmitNode (ANY); flagp := flagp or HASWIDTH or SIMPLE; end else begin // not /s, so emit [^:LineSeparators:] ret := EmitNode (ANYML); flagp := flagp or HASWIDTH; // not so simple ;) // ret := EmitRange (ANYBUT); // EmitRangeStr (LineSeparators); //###0.941 // EmitRangeStr (LinePairedSeparator); // !!! isn't correct if have to accept only paired // EmitRangeC (#0); // flagp := flagp or HASWIDTH or SIMPLE; end; '[': begin if regparse^ = '^' then begin // Complement of range. if (fCompModifiers and MaskModI) <> 0 then ret := EmitRange (ANYBUTCI) else ret := EmitRange (ANYBUT); inc (regparse); end else if (fCompModifiers and MaskModI) <> 0 then ret := EmitRange (ANYOFCI) else ret := EmitRange (ANYOF); CanBeRange := false; if (regparse^ = ']') then begin EmitSimpleRangeC (regparse^); // []-a] -> ']' .. 'a' inc (regparse); end; while (regparse^ <> #0) and (regparse^ <> ']') do begin if (regparse^ = '-') and ((regparse + 1)^ <> #0) and ((regparse + 1)^ <> ']') and CanBeRange then begin inc (regparse); RangeEnd := regparse^; if RangeEnd = EscChar then begin {$IFDEF UniCode} //###0.935 if (ord ((regparse + 1)^) < 256) and (char ((regparse + 1)^) in ['d', 'D', 's', 'S', 'w', 'W']) then begin {$ELSE} if (regparse + 1)^ in ['d', 'D', 's', 'S', 'w', 'W'] then begin {$ENDIF} EmitRangeC ('-'); // or treat as error ?!! CONTINUE; end; inc (regparse); RangeEnd := UnQuoteChar (regparse); end; // r.e.ranges extension for russian if ((fCompModifiers and MaskModR) <> 0) and (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeLoHigh) then begin EmitRangeStr (RusRangeLo); end else if ((fCompModifiers and MaskModR) <> 0) and (RangeBeg = RusRangeHiLow) and (RangeEnd = RusRangeHiHigh) then begin EmitRangeStr (RusRangeHi); end else if ((fCompModifiers and MaskModR) <> 0) and (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeHiHigh) then begin EmitRangeStr (RusRangeLo); EmitRangeStr (RusRangeHi); end else begin // standard r.e. handling if RangeBeg > RangeEnd then begin Error (reeInvalidRange); EXIT; end; inc (RangeBeg); EmitRangeC (RangeEnd); // prevent infinite loop if RangeEnd=$ff while RangeBeg < RangeEnd do begin //###0.929 EmitRangeC (RangeBeg); inc (RangeBeg); end; end; inc (regparse); end else begin if regparse^ = EscChar then begin inc (regparse); if regparse^ = #0 then begin Error (reeParseAtomTrailingBackSlash); EXIT; end; case regparse^ of // r.e.extensions 'd': EmitRangeStr ('0123456789'); 'w': EmitRangeStr (WordChars); 's': EmitRangeStr (SpaceChars); else EmitSimpleRangeC (UnQuoteChar (regparse)); end; { of case} end else EmitSimpleRangeC (regparse^); inc (regparse); end; end; { of while} EmitRangeC (#0); if regparse^ <> ']' then begin Error (reeUnmatchedSqBrackets); EXIT; end; inc (regparse); flagp := flagp or HASWIDTH or SIMPLE; end; '(': begin if regparse^ = '?' then begin // check for extended Perl syntax : (?..) if (regparse + 1)^ = '#' then begin // (?#comment) inc (regparse, 2); // find closing ')' while (regparse^ <> #0) and (regparse^ <> ')') do inc (regparse); if regparse^ <> ')' then begin Error (reeUnclosedComment); EXIT; end; inc (regparse); // skip ')' ret := EmitNode (COMMENT); // comment end else begin // modifiers ? inc (regparse); // skip '?' begmodfs := regparse; while (regparse^ <> #0) and (regparse^ <> ')') do inc (regparse); if (regparse^ <> ')') or not ParseModifiersStr (copy (begmodfs, 1, (regparse - begmodfs)), fCompModifiers) then begin Error (reeUrecognizedModifier); EXIT; end; inc (regparse); // skip ')' ret := EmitNode (COMMENT); // comment // Error (reeQPSBFollowsNothing); // EXIT; end; end else begin ret := ParseReg (1, flags); if ret = nil then begin Result := nil; EXIT; end; flagp := flagp or flags and (HASWIDTH or SPSTART); end; end; #0, '|', ')': begin // Supposed to be caught earlier. Error (reeInternalUrp); EXIT; end; '?', '+', '*': begin Error (reeQPSBFollowsNothing); EXIT; end; EscChar: begin if regparse^ = #0 then begin Error (reeTrailingBackSlash); EXIT; end; case regparse^ of // r.e.extensions 'b': ret := EmitNode (BOUND); //###0.943 'B': ret := EmitNode (NOTBOUND); //###0.943 'A': ret := EmitNode (BOL); //###0.941 'Z': ret := EmitNode (EOL); //###0.941 'd': begin // r.e.extension - any digit ('0' .. '9') ret := EmitNode (ANYDIGIT); flagp := flagp or HASWIDTH or SIMPLE; end; 'D': begin // r.e.extension - not digit ('0' .. '9') ret := EmitNode (NOTDIGIT); flagp := flagp or HASWIDTH or SIMPLE; end; 's': begin // r.e.extension - any space char {$IFDEF UseSetOfChar} ret := EmitRange (ANYOF); EmitRangeStr (SpaceChars); EmitRangeC (#0); {$ELSE} ret := EmitNode (ANYSPACE); {$ENDIF} flagp := flagp or HASWIDTH or SIMPLE; end; 'S': begin // r.e.extension - not space char {$IFDEF UseSetOfChar} ret := EmitRange (ANYBUT); EmitRangeStr (SpaceChars); EmitRangeC (#0); {$ELSE} ret := EmitNode (NOTSPACE); {$ENDIF} flagp := flagp or HASWIDTH or SIMPLE; end; 'w': begin // r.e.extension - any english char / digit / '_' {$IFDEF UseSetOfChar} ret := EmitRange (ANYOF); EmitRangeStr (WordChars); EmitRangeC (#0); {$ELSE} ret := EmitNode (ANYLETTER); {$ENDIF} flagp := flagp or HASWIDTH or SIMPLE; end; 'W': begin // r.e.extension - not english char / digit / '_' {$IFDEF UseSetOfChar} ret := EmitRange (ANYBUT); EmitRangeStr (WordChars); EmitRangeC (#0); {$ELSE} ret := EmitNode (NOTLETTER); {$ENDIF} flagp := flagp or HASWIDTH or SIMPLE; end; '1' .. '9': begin //###0.936 if (fCompModifiers and MaskModI) <> 0 then ret := EmitNode (BSUBEXPCI) else ret := EmitNode (BSUBEXP); EmitC (REChar (ord (regparse^) - ord ('0'))); flagp := flagp or HASWIDTH or SIMPLE; end; else EmitExactly (UnQuoteChar (regparse)); end; { of case} inc (regparse); end; else begin dec (regparse); if ((fCompModifiers and MaskModX) <> 0) and // check for eXtended syntax ((regparse^ = '#') or ({$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 {$ELSE}regparse^ in XIgnoredChars{$ENDIF})) then begin //###0.941 \x if regparse^ = '#' then begin // Skip eXtended comment // find comment terminator (group of \n and/or \r) while (regparse^ <> #0) and (regparse^ <> #$d) and (regparse^ <> #$a) do inc (regparse); while (regparse^ = #$d) or (regparse^ = #$a) // skip comment terminator do inc (regparse); // attempt to support different type of line separators end else begin // Skip the blanks! while {$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 {$ELSE}regparse^ in XIgnoredChars{$ENDIF} do inc (regparse); end; ret := EmitNode (COMMENT); // comment end else begin len := strcspn (regparse, META); if len <= 0 then if regparse^ <> '{' then begin Error (reeRarseAtomInternalDisaster); EXIT; end else len := strcspn (regparse + 1, META) + 1; // bad {n,m} - compile as EXATLY ender := (regparse + len)^; if (len > 1) and ((ender = '*') or (ender = '+') or (ender = '?') or (ender = '{')) then dec (len); // Back off clear of ?+*{ operand. flagp := flagp or HASWIDTH; if len = 1 then flagp := flagp or SIMPLE; if (fCompModifiers and MaskModI) <> 0 then ret := EmitNode (EXACTLYCI) else ret := EmitNode (EXACTLY); while (len > 0) and (((fCompModifiers and MaskModX) = 0) or (regparse^ <> '#')) do begin if ((fCompModifiers and MaskModX) = 0) or not ( //###0.941 {$IFDEF UniCode}StrScan (XIgnoredChars, regparse^) <> nil //###0.947 {$ELSE}regparse^ in XIgnoredChars{$ENDIF} ) then EmitC (regparse^); inc (regparse); dec (len); end; EmitC (#0); end; { of if not comment} end; { of case else} end; { of case} Result := ret; end; { of function TRegExpr.ParseAtom --------------------------------------------------------------} function TRegExpr.GetCompilerErrorPos : integer; begin Result := 0; if (regexpbeg = nil) or (regparse = nil) then EXIT; // not in compiling mode ? Result := regparse - regexpbeg; end; { of function TRegExpr.GetCompilerErrorPos --------------------------------------------------------------} {=============================================================} {===================== Matching section ======================} {=============================================================} {$IFNDEF UseSetOfChar} function TRegExpr.StrScanCI (s : PRegExprChar; ch : REChar) : PRegExprChar; //###0.928 - now method of TRegExpr begin while (s^ <> #0) and (s^ <> ch) and (s^ <> InvertCase (ch)) do inc (s); if s^ <> #0 then Result := s else Result := nil; end; { of function TRegExpr.StrScanCI --------------------------------------------------------------} {$ENDIF} function TRegExpr.regrepeat (p : PRegExprChar; AMax : integer) : integer; // repeatedly match something simple, report how many var scan : PRegExprChar; opnd : PRegExprChar; TheMax : integer; {Ch,} InvCh : REChar; //###0.931 sestart, seend : PRegExprChar; //###0.936 begin Result := 0; scan := reginput; opnd := p + REOpSz + RENextOffSz; //OPERAND TheMax := fInputEnd - scan; if TheMax > AMax then TheMax := AMax; case PREOp (p)^ of ANY: begin // note - ANYML cannot be proceeded in regrepeat because can skip // more than one char at once Result := TheMax; inc (scan, Result); end; EXACTLY: begin // in opnd can be only ONE char !!! // Ch := opnd^; // store in register //###0.931 while (Result < TheMax) and (opnd^ = scan^) do begin inc (Result); inc (scan); end; end; EXACTLYCI: begin // in opnd can be only ONE char !!! // Ch := opnd^; // store in register //###0.931 while (Result < TheMax) and (opnd^ = scan^) do begin // prevent unneeded InvertCase //###0.931 inc (Result); inc (scan); end; if Result < TheMax then begin //###0.931 InvCh := InvertCase (opnd^); // store in register while (Result < TheMax) and ((opnd^ = scan^) or (InvCh = scan^)) do begin inc (Result); inc (scan); end; end; end; BSUBEXP: begin //###0.936 sestart := startp [ord (opnd^)]; if sestart = nil then EXIT; seend := endp [ord (opnd^)]; if seend = nil then EXIT; REPEAT opnd := sestart; while opnd < seend do begin if (scan >= fInputEnd) or (scan^ <> opnd^) then EXIT; inc (scan); inc (opnd); end; inc (Result); reginput := scan; UNTIL Result >= AMax; end; BSUBEXPCI: begin //###0.936 sestart := startp [ord (opnd^)]; if sestart = nil then EXIT; seend := endp [ord (opnd^)]; if seend = nil then EXIT; REPEAT opnd := sestart; while opnd < seend do begin if (scan >= fInputEnd) or ((scan^ <> opnd^) and (scan^ <> InvertCase (opnd^))) then EXIT; inc (scan); inc (opnd); end; inc (Result); reginput := scan; UNTIL Result >= AMax; end; ANYDIGIT: while (Result < TheMax) and (scan^ >= '0') and (scan^ <= '9') do begin inc (Result); inc (scan); end; NOTDIGIT: while (Result < TheMax) and ((scan^ < '0') or (scan^ > '9')) do begin inc (Result); inc (scan); end; {$IFNDEF UseSetOfChar} //###0.929 ANYLETTER: while (Result < TheMax) and (Pos (scan^, fWordChars) > 0) //###0.940 { ((scan^ >= 'a') and (scan^ <= 'z') !! I've forgotten (>='0') and (<='9') or (scan^ >= 'A') and (scan^ <= 'Z') or (scan^ = '_'))} do begin inc (Result); inc (scan); end; NOTLETTER: while (Result < TheMax) and (Pos (scan^, fWordChars) <= 0) //###0.940 { not ((scan^ >= 'a') and (scan^ <= 'z') !! I've forgotten (>='0') and (<='9') or (scan^ >= 'A') and (scan^ <= 'Z') or (scan^ = '_'))} do begin inc (Result); inc (scan); end; ANYSPACE: while (Result < TheMax) and (Pos (scan^, fSpaceChars) > 0) do begin inc (Result); inc (scan); end; NOTSPACE: while (Result < TheMax) and (Pos (scan^, fSpaceChars) <= 0) do begin inc (Result); inc (scan); end; {$ENDIF} ANYOFTINYSET: begin while (Result < TheMax) and //!!!TinySet ((scan^ = opnd^) or (scan^ = (opnd + 1)^) or (scan^ = (opnd + 2)^)) do begin inc (Result); inc (scan); end; end; ANYBUTTINYSET: begin while (Result < TheMax) and //!!!TinySet (scan^ <> opnd^) and (scan^ <> (opnd + 1)^) and (scan^ <> (opnd + 2)^) do begin inc (Result); inc (scan); end; end; {$IFDEF UseSetOfChar} //###0.929 ANYOFFULLSET: begin while (Result < TheMax) and (scan^ in PSetOfREChar (opnd)^) do begin inc (Result); inc (scan); end; end; {$ELSE} ANYOF: while (Result < TheMax) and (StrScan (opnd, scan^) <> nil) do begin inc (Result); inc (scan); end; ANYBUT: while (Result < TheMax) and (StrScan (opnd, scan^) = nil) do begin inc (Result); inc (scan); end; ANYOFCI: while (Result < TheMax) and (StrScanCI (opnd, scan^) <> nil) do begin inc (Result); inc (scan); end; ANYBUTCI: while (Result < TheMax) and (StrScanCI (opnd, scan^) = nil) do begin inc (Result); inc (scan); end; {$ENDIF} else begin // Oh dear. Called inappropriately. Result := 0; // Best compromise. Error (reeRegRepeatCalledInappropriately); EXIT; end; end; { of case} reginput := scan; end; { of function TRegExpr.regrepeat --------------------------------------------------------------} function TRegExpr.regnext (p : PRegExprChar) : PRegExprChar; // dig the "next" pointer out of a node var offset : TRENextOff; begin if p = @regdummy then begin Result := nil; EXIT; end; offset := PRENextOff (p + REOpSz)^; //###0.933 inlined NEXT if offset = 0 then Result := nil else Result := p + offset; end; { of function TRegExpr.regnext --------------------------------------------------------------} function TRegExpr.MatchPrim (prog : PRegExprChar) : boolean; // recursively matching routine // Conceptually the strategy is simple: check to see whether the current // node matches, call self recursively to see whether the rest matches, // and then act accordingly. In practice we make some effort to avoid // recursion, in particular by going through "ordinary" nodes (that don't // need to know whether the rest of the match failed) by a loop instead of // by recursion. var scan : PRegExprChar; // Current node. next : PRegExprChar; // Next node. len : integer; opnd : PRegExprChar; no : integer; save : PRegExprChar; nextch : REChar; BracesMin, BracesMax : integer; // we use integer instead of TREBracesArg for better support */+ {$IFDEF ComplexBraces} SavedLoopStack : array [1 .. LoopStackMax] of integer; // :(( very bad for recursion SavedLoopStackIdx : integer; //###0.925 {$ENDIF} begin Result := false; scan := prog; while scan <> nil do begin len := PRENextOff (scan + 1)^; //###0.932 inlined regnext if len = 0 then next := nil else next := scan + len; case scan^ of NOTBOUND, //###0.943 //!!! think about UseSetOfChar !!! BOUND: if (scan^ = BOUND) xor ( ((reginput = fInputStart) or (Pos ((reginput - 1)^, fWordChars) <= 0)) and (reginput^ <> #0) and (Pos (reginput^, fWordChars) > 0) or (reginput <> fInputStart) and (Pos ((reginput - 1)^, fWordChars) > 0) and ((reginput^ = #0) or (Pos (reginput^, fWordChars) <= 0))) then EXIT; BOL: if reginput <> fInputStart then EXIT; EOL: if reginput^ <> #0 then EXIT; BOLML: if reginput > fInputStart then begin nextch := (reginput - 1)^; if (nextch <> fLinePairedSeparatorTail) or ((reginput - 1) <= fInputStart) or ((reginput - 2)^ <> fLinePairedSeparatorHead) then begin if (nextch = fLinePairedSeparatorHead) and (reginput^ = fLinePairedSeparatorTail) then EXIT; // don't stop between paired separator if {$IFNDEF UniCode} not (nextch in fLineSeparatorsSet) {$ELSE} (pos (nextch, fLineSeparators) <= 0) {$ENDIF} then EXIT; end; end; EOLML: if reginput^ <> #0 then begin nextch := reginput^; if (nextch <> fLinePairedSeparatorHead) or ((reginput + 1)^ <> fLinePairedSeparatorTail) then begin if (nextch = fLinePairedSeparatorTail) and (reginput > fInputStart) and ((reginput - 1)^ = fLinePairedSeparatorHead) then EXIT; // don't stop between paired separator if {$IFNDEF UniCode} not (nextch in fLineSeparatorsSet) {$ELSE} (pos (nextch, fLineSeparators) <= 0) {$ENDIF} then EXIT; end; end; ANY: begin if reginput^ = #0 then EXIT; inc (reginput); end; ANYML: begin //###0.941 if (reginput^ = #0) or ((reginput^ = fLinePairedSeparatorHead) and ((reginput + 1)^ = fLinePairedSeparatorTail)) or {$IFNDEF UniCode} (reginput^ in fLineSeparatorsSet) {$ELSE} (pos (reginput^, fLineSeparators) > 0) {$ENDIF} then EXIT; inc (reginput); end; ANYDIGIT: begin if (reginput^ = #0) or (reginput^ < '0') or (reginput^ > '9') then EXIT; inc (reginput); end; NOTDIGIT: begin if (reginput^ = #0) or ((reginput^ >= '0') and (reginput^ <= '9')) then EXIT; inc (reginput); end; {$IFNDEF UseSetOfChar} //###0.929 ANYLETTER: begin if (reginput^ = #0) or (Pos (reginput^, fWordChars) <= 0) //###0.943 then EXIT; inc (reginput); end; NOTLETTER: begin if (reginput^ = #0) or (Pos (reginput^, fWordChars) > 0) //###0.943 then EXIT; inc (reginput); end; ANYSPACE: begin if (reginput^ = #0) or not (Pos (reginput^, fSpaceChars) > 0) //###0.943 then EXIT; inc (reginput); end; NOTSPACE: begin if (reginput^ = #0) or (Pos (reginput^, fSpaceChars) > 0) //###0.943 then EXIT; inc (reginput); end; {$ENDIF} EXACTLYCI: begin opnd := scan + REOpSz + RENextOffSz; // OPERAND // Inline the first character, for speed. if (opnd^ <> reginput^) and (InvertCase (opnd^) <> reginput^) then EXIT; len := strlen (opnd); //###0.929 begin no := len; save := reginput; while no > 1 do begin inc (save); inc (opnd); if (opnd^ <> save^) and (InvertCase (opnd^) <> save^) then EXIT; dec (no); end; //###0.929 end inc (reginput, len); end; EXACTLY: begin opnd := scan + REOpSz + RENextOffSz; // OPERAND // Inline the first character, for speed. if opnd^ <> reginput^ then EXIT; len := strlen (opnd); //###0.929 begin no := len; save := reginput; while no > 1 do begin inc (save); inc (opnd); if opnd^ <> save^ then EXIT; dec (no); end; //###0.929 end inc (reginput, len); end; BSUBEXP: begin //###0.936 no := ord ((scan + REOpSz + RENextOffSz)^); if startp [no] = nil then EXIT; if endp [no] = nil then EXIT; save := reginput; opnd := startp [no]; while opnd < endp [no] do begin if (save >= fInputEnd) or (save^ <> opnd^) then EXIT; inc (save); inc (opnd); end; reginput := save; end; BSUBEXPCI: begin //###0.936 no := ord ((scan + REOpSz + RENextOffSz)^); if startp [no] = nil then EXIT; if endp [no] = nil then EXIT; save := reginput; opnd := startp [no]; while opnd < endp [no] do begin if (save >= fInputEnd) or ((save^ <> opnd^) and (save^ <> InvertCase (opnd^))) then EXIT; inc (save); inc (opnd); end; reginput := save; end; ANYOFTINYSET: begin if (reginput^ = #0) or //!!!TinySet ((reginput^ <> (scan + REOpSz + RENextOffSz)^) and (reginput^ <> (scan + REOpSz + RENextOffSz + 1)^) and (reginput^ <> (scan + REOpSz + RENextOffSz + 2)^)) then EXIT; inc (reginput); end; ANYBUTTINYSET: begin if (reginput^ = #0) or //!!!TinySet (reginput^ = (scan + REOpSz + RENextOffSz)^) or (reginput^ = (scan + REOpSz + RENextOffSz + 1)^) or (reginput^ = (scan + REOpSz + RENextOffSz + 2)^) then EXIT; inc (reginput); end; {$IFDEF UseSetOfChar} //###0.929 ANYOFFULLSET: begin if (reginput^ = #0) or not (reginput^ in PSetOfREChar (scan + REOpSz + RENextOffSz)^) then EXIT; inc (reginput); end; {$ELSE} ANYOF: begin if (reginput^ = #0) or (StrScan (scan + REOpSz + RENextOffSz, reginput^) = nil) then EXIT; inc (reginput); end; ANYBUT: begin if (reginput^ = #0) or (StrScan (scan + REOpSz + RENextOffSz, reginput^) <> nil) then EXIT; inc (reginput); end; ANYOFCI: begin if (reginput^ = #0) or (StrScanCI (scan + REOpSz + RENextOffSz, reginput^) = nil) then EXIT; inc (reginput); end; ANYBUTCI: begin if (reginput^ = #0) or (StrScanCI (scan + REOpSz + RENextOffSz, reginput^) <> nil) then EXIT; inc (reginput); end; {$ENDIF} NOTHING: ; COMMENT: ; BACK: ; Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1) : begin //###0.929 no := ord (scan^) - ord (OPEN); // save := reginput; save := startp [no]; //###0.936 startp [no] := reginput; //###0.936 Result := MatchPrim (next); if not Result //###0.936 then startp [no] := save; // if Result and (startp [no] = nil) // then startp [no] := save; // Don't set startp if some later invocation of the same // parentheses already has. EXIT; end; Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): begin //###0.929 no := ord (scan^) - ord (CLOSE); // save := reginput; save := endp [no]; //###0.936 endp [no] := reginput; //###0.936 Result := MatchPrim (next); if not Result //###0.936 then endp [no] := save; // if Result and (endp [no] = nil) // then endp [no] := save; // Don't set endp if some later invocation of the same // parentheses already has. EXIT; end; BRANCH: begin if (next^ <> BRANCH) // No choice. then next := scan + REOpSz + RENextOffSz // Avoid recursion else begin REPEAT save := reginput; Result := MatchPrim (scan + REOpSz + RENextOffSz); if Result then EXIT; reginput := save; scan := regnext (scan); UNTIL (scan = nil) or (scan^ <> BRANCH); EXIT; end; end; {$IFDEF ComplexBraces} LOOPENTRY: begin //###0.925 no := LoopStackIdx; inc (LoopStackIdx); if LoopStackIdx > LoopStackMax then begin Error (reeLoopStackExceeded); EXIT; end; save := reginput; LoopStack [LoopStackIdx] := 0; // init loop counter Result := MatchPrim (next); // execute LOOP LoopStackIdx := no; // cleanup if Result then EXIT; reginput := save; EXIT; end; LOOP, LOOPNG: begin //###0.940 if LoopStackIdx <= 0 then begin Error (reeLoopWithoutEntry); EXIT; end; opnd := scan + PRENextOff (scan + REOpSz + RENextOffSz + 2 * REBracesArgSz)^; BracesMin := PREBracesArg (scan + REOpSz + RENextOffSz)^; BracesMax := PREBracesArg (scan + REOpSz + RENextOffSz + REBracesArgSz)^; save := reginput; if LoopStack [LoopStackIdx] >= BracesMin then begin // Min alredy matched - we can work if scan^ = LOOP then begin // greedy way - first try to max deep of greed ;) if LoopStack [LoopStackIdx] < BracesMax then begin inc (LoopStack [LoopStackIdx]); no := LoopStackIdx; Result := MatchPrim (opnd); LoopStackIdx := no; if Result then EXIT; reginput := save; end; dec (LoopStackIdx); // Fail. May be we are too greedy? ;) Result := MatchPrim (next); if not Result then reginput := save; EXIT; end else begin // non-greedy - try just now Result := MatchPrim (next); if Result then EXIT else reginput := save; // failed - move next and try again if LoopStack [LoopStackIdx] < BracesMax then begin inc (LoopStack [LoopStackIdx]); no := LoopStackIdx; Result := MatchPrim (opnd); LoopStackIdx := no; if Result then EXIT; reginput := save; end; dec (LoopStackIdx); // Failed - back up EXIT; end end else begin // first match a min_cnt times inc (LoopStack [LoopStackIdx]); no := LoopStackIdx; Result := MatchPrim (opnd); LoopStackIdx := no; if Result then EXIT; dec (LoopStack [LoopStackIdx]); reginput := save; EXIT; end; end; {$ENDIF} STAR, PLUS, BRACES, STARNG, PLUSNG, BRACESNG: begin // Lookahead to avoid useless match attempts when we know // what character comes next. nextch := #0; if next^ = EXACTLY then nextch := (next + REOpSz + RENextOffSz)^; BracesMax := MaxInt; // infinite loop for * and + //###0.92 if (scan^ = STAR) or (scan^ = STARNG) then BracesMin := 0 // STAR else if (scan^ = PLUS) or (scan^ = PLUSNG) then BracesMin := 1 // PLUS else begin // BRACES BracesMin := PREBracesArg (scan + REOpSz + RENextOffSz)^; BracesMax := PREBracesArg (scan + REOpSz + RENextOffSz + REBracesArgSz)^; end; save := reginput; opnd := scan + REOpSz + RENextOffSz; if (scan^ = BRACES) or (scan^ = BRACESNG) then inc (opnd, 2 * REBracesArgSz); if (scan^ = PLUSNG) or (scan^ = STARNG) or (scan^ = BRACESNG) then begin // non-greedy mode BracesMax := regrepeat (opnd, BracesMax); // don't repeat more than BracesMax // Now we know real Max limit to move forward (for recursion 'back up') // In some cases it can be faster to check only Min positions first, // but after that we have to check every position separtely instead // of fast scannig in loop. no := BracesMin; while no <= BracesMax do begin reginput := save + no; // If it could work, try it. if (nextch = #0) or (reginput^ = nextch) then begin {$IFDEF ComplexBraces} System.Move (LoopStack, SavedLoopStack, SizeOf (LoopStack)); //###0.925 SavedLoopStackIdx := LoopStackIdx; {$ENDIF} if MatchPrim (next) then begin Result := true; EXIT; end; {$IFDEF ComplexBraces} System.Move (SavedLoopStack, LoopStack, SizeOf (LoopStack)); LoopStackIdx := SavedLoopStackIdx; {$ENDIF} end; inc (no); // Couldn't or didn't - move forward. end; { of while} EXIT; end else begin // greedy mode no := regrepeat (opnd, BracesMax); // don't repeat more than max_cnt while no >= BracesMin do begin // If it could work, try it. if (nextch = #0) or (reginput^ = nextch) then begin {$IFDEF ComplexBraces} System.Move (LoopStack, SavedLoopStack, SizeOf (LoopStack)); //###0.925 SavedLoopStackIdx := LoopStackIdx; {$ENDIF} if MatchPrim (next) then begin Result := true; EXIT; end; {$IFDEF ComplexBraces} System.Move (SavedLoopStack, LoopStack, SizeOf (LoopStack)); LoopStackIdx := SavedLoopStackIdx; {$ENDIF} end; dec (no); // Couldn't or didn't - back up. reginput := save + no; end; { of while} EXIT; end; end; EEND: begin Result := true; // Success! EXIT; end; else begin Error (reeMatchPrimMemoryCorruption); EXIT; end; end; { of case scan^} scan := next; end; { of while scan <> nil} // We get here only if there's trouble -- normally "case EEND" is the // terminating point. Error (reeMatchPrimCorruptedPointers); end; { of function TRegExpr.MatchPrim --------------------------------------------------------------} {$IFDEF UseFirstCharSet} //###0.929 procedure TRegExpr.FillFirstCharSet (prog : PRegExprChar); var scan : PRegExprChar; // Current node. next : PRegExprChar; // Next node. opnd : PRegExprChar; min_cnt : integer; begin scan := prog; while scan <> nil do begin next := regnext (scan); case PREOp (scan)^ of BSUBEXP, BSUBEXPCI: begin //###0.938 FirstCharSet := [#0 .. #255]; // :((( we cannot // optimize r.e. if it starts with back reference EXIT; end; BOL, BOLML: ; // EXIT; //###0.937 EOL, EOLML: begin //###0.948 was empty in 0.947, was EXIT in 0.937 Include (FirstCharSet, #0); if ModifierM then begin opnd := PRegExprChar (LineSeparators); while opnd^ <> #0 do begin Include (FirstCharSet, opnd^); inc (opnd); end; end; EXIT; end; BOUND, NOTBOUND: ; //###0.943 ?!! ANY, ANYML: begin // we can better define ANYML !!! FirstCharSet := [#0 .. #255]; //###0.930 EXIT; end; ANYDIGIT: begin FirstCharSet := FirstCharSet + ['0' .. '9']; EXIT; end; NOTDIGIT: begin FirstCharSet := FirstCharSet + ([#0 .. #255] - ['0' .. '9']); //###0.948 FirstCharSet was forgotten EXIT; end; EXACTLYCI: begin Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); Include (FirstCharSet, InvertCase ((scan + REOpSz + RENextOffSz)^)); EXIT; end; EXACTLY: begin Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); EXIT; end; ANYOFFULLSET: begin FirstCharSet := FirstCharSet + PSetOfREChar (scan + REOpSz + RENextOffSz)^; EXIT; end; ANYOFTINYSET: begin //!!!TinySet Include (FirstCharSet, (scan + REOpSz + RENextOffSz)^); Include (FirstCharSet, (scan + REOpSz + RENextOffSz + 1)^); Include (FirstCharSet, (scan + REOpSz + RENextOffSz + 2)^); // ... // up to TinySetLen EXIT; end; ANYBUTTINYSET: begin //!!!TinySet FirstCharSet := FirstCharSet + ([#0 .. #255] - [ //###0.948 FirstCharSet was forgotten (scan + REOpSz + RENextOffSz)^, (scan + REOpSz + RENextOffSz + 1)^, (scan + REOpSz + RENextOffSz + 2)^]); // ... // up to TinySetLen EXIT; end; NOTHING: ; COMMENT: ; BACK: ; Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1) : begin //###0.929 FillFirstCharSet (next); EXIT; end; Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): begin //###0.929 FillFirstCharSet (next); EXIT; end; BRANCH: begin if (PREOp (next)^ <> BRANCH) // No choice. then next := scan + REOpSz + RENextOffSz // Avoid recursion. else begin REPEAT FillFirstCharSet (scan + REOpSz + RENextOffSz); scan := regnext (scan); UNTIL (scan = nil) or (PREOp (scan)^ <> BRANCH); EXIT; end; end; {$IFDEF ComplexBraces} LOOPENTRY: begin //###0.925 // LoopStack [LoopStackIdx] := 0; //###0.940 line removed FillFirstCharSet (next); // execute LOOP EXIT; end; LOOP, LOOPNG: begin //###0.940 opnd := scan + PRENextOff (scan + REOpSz + RENextOffSz + REBracesArgSz * 2)^; min_cnt := PREBracesArg (scan + REOpSz + RENextOffSz)^; FillFirstCharSet (opnd); if min_cnt = 0 then FillFirstCharSet (next); EXIT; end; {$ENDIF} STAR, STARNG: //###0.940 FillFirstCharSet (scan + REOpSz + RENextOffSz); PLUS, PLUSNG: begin //###0.940 FillFirstCharSet (scan + REOpSz + RENextOffSz); EXIT; end; BRACES, BRACESNG: begin //###0.940 opnd := scan + REOpSz + RENextOffSz + REBracesArgSz * 2; min_cnt := PREBracesArg (scan + REOpSz + RENextOffSz)^; // BRACES FillFirstCharSet (opnd); if min_cnt > 0 then EXIT; end; EEND: begin FirstCharSet := [#0 .. #255]; //###0.948 EXIT; end; else begin Error (reeMatchPrimMemoryCorruption); EXIT; end; end; { of case scan^} scan := next; end; { of while scan <> nil} end; { of procedure FillFirstCharSet --------------------------------------------------------------} {$ENDIF} function TRegExpr.Exec (const AInputString : RegExprString) : boolean; begin InputString := AInputString; Result := ExecPrim (1); end; { of function TRegExpr.Exec --------------------------------------------------------------} {$IFDEF OverMeth} {$IFNDEF FPC} function TRegExpr.Exec : boolean; begin Result := ExecPrim (1); end; { of function TRegExpr.Exec --------------------------------------------------------------} {$ENDIF} function TRegExpr.Exec (AOffset: integer) : boolean; begin Result := ExecPrim (AOffset); end; { of function TRegExpr.Exec --------------------------------------------------------------} {$ENDIF} function TRegExpr.ExecPos (AOffset: integer {$IFDEF DefParam}= 1{$ENDIF}) : boolean; begin Result := ExecPrim (AOffset); end; { of function TRegExpr.ExecPos --------------------------------------------------------------} function TRegExpr.ExecPrim (AOffset: integer) : boolean; procedure ClearMatchs; // Clears matchs array var i : integer; begin for i := 0 to NSUBEXP - 1 do begin startp [i] := nil; endp [i] := nil; end; end; { of procedure ClearMatchs; ..............................................................} function RegMatch (str : PRegExprChar) : boolean; // try match at specific point begin //###0.949 removed clearing of start\endp reginput := str; Result := MatchPrim (programm + REOpSz); if Result then begin startp [0] := str; endp [0] := reginput; end; end; { of function RegMatch ..............................................................} var s : PRegExprChar; StartPtr: PRegExprChar; InputLen : integer; begin Result := false; // Be paranoid... ClearMatchs; //###0.949 // ensure that Match cleared either if optimization tricks or some error // will lead to leaving ExecPrim without actual search. That is // importent for ExecNext logic and so on. if not IsProgrammOk //###0.929 then EXIT; // Check InputString presence if not Assigned (fInputString) then begin Error (reeNoInpitStringSpecified); EXIT; end; InputLen := length (fInputString); //Check that the start position is not negative if AOffset < 1 then begin Error (reeOffsetMustBeGreaterThen0); EXIT; end; // Check that the start position is not longer than the line // If so then exit with nothing found if AOffset > (InputLen + 1) // for matching empty string after last char. then EXIT; StartPtr := fInputString + AOffset - 1; // If there is a "must appear" string, look for it. if regmust <> nil then begin s := StartPtr; REPEAT s := StrScan (s, regmust [0]); if s <> nil then begin if StrLComp (s, regmust, regmlen) = 0 then BREAK; // Found it. inc (s); end; UNTIL s = nil; if s = nil // Not present. then EXIT; end; // Mark beginning of line for ^ . fInputStart := fInputString; // Pointer to end of input stream - for // pascal-style string processing (may include #0) fInputEnd := fInputString + InputLen; {$IFDEF ComplexBraces} // no loops started LoopStackIdx := 0; //###0.925 {$ENDIF} // Simplest case: anchored match need be tried only once. if reganch <> #0 then begin Result := RegMatch (StartPtr); EXIT; end; // Messy cases: unanchored match. s := StartPtr; if regstart <> #0 then // We know what char it must start with. REPEAT s := StrScan (s, regstart); if s <> nil then begin Result := RegMatch (s); if Result then EXIT else ClearMatchs; //###0.949 inc (s); end; UNTIL s = nil else begin // We don't - general case. repeat //###0.948 {$IFDEF UseFirstCharSet} if s^ in FirstCharSet then Result := RegMatch (s); {$ELSE} Result := RegMatch (s); {$ENDIF} if Result or (s^ = #0) // Exit on a match or after testing the end-of-string. then EXIT else ClearMatchs; //###0.949 inc (s); until false; (* optimized and fixed by Martin Fuller - empty strings were not allowed to pass thru in UseFirstCharSet mode {$IFDEF UseFirstCharSet} //###0.929 while s^ <> #0 do begin if s^ in FirstCharSet then Result := RegMatch (s); if Result then EXIT; inc (s); end; {$ELSE} REPEAT Result := RegMatch (s); if Result then EXIT; inc (s); UNTIL s^ = #0; {$ENDIF} *) end; // Failure end; { of function TRegExpr.ExecPrim --------------------------------------------------------------} function TRegExpr.ExecNext : boolean; var offset : integer; begin Result := false; if not Assigned (startp[0]) or not Assigned (endp[0]) then begin Error (reeExecNextWithoutExec); EXIT; end; // Offset := MatchPos [0] + MatchLen [0]; // if MatchLen [0] = 0 Offset := endp [0] - fInputString + 1; //###0.929 if endp [0] = startp [0] //###0.929 then inc (Offset); // prevent infinite looping if empty string match r.e. Result := ExecPrim (Offset); end; { of function TRegExpr.ExecNext --------------------------------------------------------------} function TRegExpr.GetInputString : RegExprString; begin if not Assigned (fInputString) then begin Error (reeGetInputStringWithoutInputString); EXIT; end; Result := fInputString; end; { of function TRegExpr.GetInputString --------------------------------------------------------------} procedure TRegExpr.SetInputString (const AInputString : RegExprString); var Len : integer; i : integer; begin // clear Match* - before next Exec* call it's undefined for i := 0 to NSUBEXP - 1 do begin startp [i] := nil; endp [i] := nil; end; // need reallocation of input string buffer ? Len := length (AInputString); if Assigned (fInputString) and (Length (fInputString) <> Len) then begin FreeMem (fInputString); fInputString := nil; end; // buffer [re]allocation if not Assigned (fInputString) then GetMem (fInputString, (Len + 1) * SizeOf (REChar)); // copy input string into buffer {$IFDEF UniCode} StrPCopy (fInputString, Copy (AInputString, 1, Len)); //###0.927 {$ELSE} StrLCopy (fInputString, PRegExprChar (AInputString), Len); {$ENDIF} { fInputString : string; fInputStart, fInputEnd : PRegExprChar; SetInputString: fInputString := AInputString; UniqueString (fInputString); fInputStart := PChar (fInputString); Len := length (fInputString); fInputEnd := PRegExprChar (integer (fInputStart) + Len); ?? !! startp/endp ? } end; { of procedure TRegExpr.SetInputString --------------------------------------------------------------} procedure TRegExpr.SetLineSeparators (const AStr : RegExprString); begin if AStr <> fLineSeparators then begin fLineSeparators := AStr; InvalidateProgramm; end; end; { of procedure TRegExpr.SetLineSeparators --------------------------------------------------------------} procedure TRegExpr.SetLinePairedSeparator (const AStr : RegExprString); begin if length (AStr) = 2 then begin if AStr [1] = AStr [2] then begin // it's impossible for our 'one-point' checking to support // two chars separator for identical chars Error (reeBadLinePairedSeparator); EXIT; end; if not fLinePairedSeparatorAssigned or (AStr [1] <> fLinePairedSeparatorHead) or (AStr [2] <> fLinePairedSeparatorTail) then begin fLinePairedSeparatorAssigned := true; fLinePairedSeparatorHead := AStr [1]; fLinePairedSeparatorTail := AStr [2]; InvalidateProgramm; end; end else if length (AStr) = 0 then begin if fLinePairedSeparatorAssigned then begin fLinePairedSeparatorAssigned := false; InvalidateProgramm; end; end else Error (reeBadLinePairedSeparator); end; { of procedure TRegExpr.SetLinePairedSeparator --------------------------------------------------------------} function TRegExpr.GetLinePairedSeparator : RegExprString; begin if fLinePairedSeparatorAssigned then begin {$IFDEF UniCode} // Here is some UniCode 'magic' // If You do know better decision to concatenate // two WideChars, please, let me know! Result := fLinePairedSeparatorHead; //###0.947 Result := Result + fLinePairedSeparatorTail; {$ELSE} Result := fLinePairedSeparatorHead + fLinePairedSeparatorTail; {$ENDIF} end else Result := ''; end; { of function TRegExpr.GetLinePairedSeparator --------------------------------------------------------------} function TRegExpr.Substitute (const ATemplate : RegExprString) : RegExprString; // perform substitutions after a regexp match // completely rewritten in 0.929 var TemplateLen : integer; TemplateBeg, TemplateEnd : PRegExprChar; p, p0, ResultPtr : PRegExprChar; ResultLen : integer; n : integer; Ch : REChar; function ParseVarName (var APtr : PRegExprChar) : integer; // extract name of variable (digits, may be enclosed with // curly braces) from APtr^, uses TemplateEnd !!! const Digits = ['0' .. '9']; var p : PRegExprChar; Delimited : boolean; begin Result := 0; p := APtr; Delimited := (p < TemplateEnd) and (p^ = '{'); if Delimited then inc (p); // skip left curly brace if (p < TemplateEnd) and (p^ = '&') then inc (p) // this is '$&' or '${&}' else while (p < TemplateEnd) and {$IFDEF UniCode} //###0.935 (ord (p^) < 256) and (char (p^) in Digits) {$ELSE} (p^ in Digits) {$ENDIF} do begin Result := Result * 10 + (ord (p^) - ord ('0')); //###0.939 inc (p); end; if Delimited then if (p < TemplateEnd) and (p^ = '}') then inc (p) // skip right curly brace else p := APtr; // isn't properly terminated if p = APtr then Result := -1; // no valid digits found or no right curly brace APtr := p; end; begin // Check programm and input string if not IsProgrammOk then EXIT; if not Assigned (fInputString) then begin Error (reeNoInpitStringSpecified); EXIT; end; // Prepare for working TemplateLen := length (ATemplate); if TemplateLen = 0 then begin // prevent nil pointers Result := ''; EXIT; end; TemplateBeg := pointer (ATemplate); TemplateEnd := TemplateBeg + TemplateLen; // Count result length for speed optimization. ResultLen := 0; p := TemplateBeg; while p < TemplateEnd do begin Ch := p^; inc (p); if Ch = '$' then n := ParseVarName (p) else n := -1; if n >= 0 then begin if (n < NSUBEXP) and Assigned (startp [n]) and Assigned (endp [n]) then inc (ResultLen, endp [n] - startp [n]); end else begin if (Ch = EscChar) and (p < TemplateEnd) then inc (p); // quoted or special char followed inc (ResultLen); end; end; // Get memory. We do it once and it significant speed up work ! if ResultLen = 0 then begin Result := ''; EXIT; end; SetString (Result, nil, ResultLen); // Fill Result ResultPtr := pointer (Result); p := TemplateBeg; while p < TemplateEnd do begin Ch := p^; inc (p); if Ch = '$' then n := ParseVarName (p) else n := -1; if n >= 0 then begin p0 := startp [n]; if (n < NSUBEXP) and Assigned (p0) and Assigned (endp [n]) then while p0 < endp [n] do begin ResultPtr^ := p0^; inc (ResultPtr); inc (p0); end; end else begin if (Ch = EscChar) and (p < TemplateEnd) then begin // quoted or special char followed Ch := p^; inc (p); end; ResultPtr^ := Ch; inc (ResultPtr); end; end; end; { of function TRegExpr.Substitute --------------------------------------------------------------} procedure TRegExpr.Split (AInputStr : RegExprString; APieces : TStrings); var PrevPos : integer; begin PrevPos := 1; if Exec (AInputStr) then REPEAT APieces.Add (System.Copy (AInputStr, PrevPos, MatchPos [0] - PrevPos)); PrevPos := MatchPos [0] + MatchLen [0]; UNTIL not ExecNext; APieces.Add (System.Copy (AInputStr, PrevPos, MaxInt)); // Tail end; { of procedure TRegExpr.Split --------------------------------------------------------------} function TRegExpr.Replace (AInputStr : RegExprString; const AReplaceStr : RegExprString; AUseSubstitution : boolean{$IFDEF DefParam}= False{$ENDIF}) : RegExprString; var PrevPos : integer; begin Result := ''; PrevPos := 1; if Exec (AInputStr) then REPEAT Result := Result + System.Copy (AInputStr, PrevPos, MatchPos [0] - PrevPos); if AUseSubstitution //###0.946 then Result := Result + Substitute (AReplaceStr) else Result := Result + AReplaceStr; PrevPos := MatchPos [0] + MatchLen [0]; UNTIL not ExecNext; Result := Result + System.Copy (AInputStr, PrevPos, MaxInt); // Tail end; { of function TRegExpr.Replace --------------------------------------------------------------} function TRegExpr.ReplaceEx (AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString; var PrevPos : integer; begin Result := ''; PrevPos := 1; if Exec (AInputStr) then REPEAT Result := Result + System.Copy (AInputStr, PrevPos, MatchPos [0] - PrevPos) + AReplaceFunc (Self); PrevPos := MatchPos [0] + MatchLen [0]; UNTIL not ExecNext; Result := Result + System.Copy (AInputStr, PrevPos, MaxInt); // Tail end; { of function TRegExpr.ReplaceEx --------------------------------------------------------------} {$IFDEF OverMeth} function TRegExpr.Replace (AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString; begin ReplaceEx (AInputStr, AReplaceFunc); end; { of function TRegExpr.Replace --------------------------------------------------------------} {$ENDIF} {=============================================================} {====================== Debug section ========================} {=============================================================} {$IFDEF RegExpPCodeDump} function TRegExpr.DumpOp (op : TREOp) : RegExprString; // printable representation of opcode begin case op of BOL: Result := 'BOL'; EOL: Result := 'EOL'; BOLML: Result := 'BOLML'; EOLML: Result := 'EOLML'; BOUND: Result := 'BOUND'; //###0.943 NOTBOUND: Result := 'NOTBOUND'; //###0.943 ANY: Result := 'ANY'; ANYML: Result := 'ANYML'; //###0.941 ANYLETTER: Result := 'ANYLETTER'; NOTLETTER: Result := 'NOTLETTER'; ANYDIGIT: Result := 'ANYDIGIT'; NOTDIGIT: Result := 'NOTDIGIT'; ANYSPACE: Result := 'ANYSPACE'; NOTSPACE: Result := 'NOTSPACE'; ANYOF: Result := 'ANYOF'; ANYBUT: Result := 'ANYBUT'; ANYOFCI: Result := 'ANYOF/CI'; ANYBUTCI: Result := 'ANYBUT/CI'; BRANCH: Result := 'BRANCH'; EXACTLY: Result := 'EXACTLY'; EXACTLYCI: Result := 'EXACTLY/CI'; NOTHING: Result := 'NOTHING'; COMMENT: Result := 'COMMENT'; BACK: Result := 'BACK'; EEND: Result := 'END'; BSUBEXP: Result := 'BSUBEXP'; BSUBEXPCI: Result := 'BSUBEXP/CI'; Succ (OPEN) .. TREOp (Ord (OPEN) + NSUBEXP - 1): //###0.929 Result := Format ('OPEN[%d]', [ord (op) - ord (OPEN)]); Succ (CLOSE) .. TREOp (Ord (CLOSE) + NSUBEXP - 1): //###0.929 Result := Format ('CLOSE[%d]', [ord (op) - ord (CLOSE)]); STAR: Result := 'STAR'; PLUS: Result := 'PLUS'; BRACES: Result := 'BRACES'; {$IFDEF ComplexBraces} LOOPENTRY: Result := 'LOOPENTRY'; //###0.925 LOOP: Result := 'LOOP'; //###0.925 LOOPNG: Result := 'LOOPNG'; //###0.940 {$ENDIF} ANYOFTINYSET: Result:= 'ANYOFTINYSET'; ANYBUTTINYSET:Result:= 'ANYBUTTINYSET'; {$IFDEF UseSetOfChar} //###0.929 ANYOFFULLSET: Result:= 'ANYOFFULLSET'; {$ENDIF} STARNG: Result := 'STARNG'; //###0.940 PLUSNG: Result := 'PLUSNG'; //###0.940 BRACESNG: Result := 'BRACESNG'; //###0.940 else Error (reeDumpCorruptedOpcode); end; {of case op} Result := ':' + Result; end; { of function TRegExpr.DumpOp --------------------------------------------------------------} function TRegExpr.Dump : RegExprString; // dump a regexp in vaguely comprehensible form var s : PRegExprChar; op : TREOp; // Arbitrary non-END op. next : PRegExprChar; i : integer; Diff : integer; {$IFDEF UseSetOfChar} //###0.929 Ch : REChar; {$ENDIF} begin if not IsProgrammOk //###0.929 then EXIT; op := EXACTLY; Result := ''; s := programm + REOpSz; while op <> EEND do begin // While that wasn't END last time... op := s^; Result := Result + Format ('%2d%s', [s - programm, DumpOp (s^)]); // Where, what. next := regnext (s); if next = nil // Next ptr. then Result := Result + ' (0)' else begin if next > s //###0.948 PWideChar subtraction workaround (see comments in Tail method for details) then Diff := next - s else Diff := - (s - next); Result := Result + Format (' (%d) ', [(s - programm) + Diff]); end; inc (s, REOpSz + RENextOffSz); if (op = ANYOF) or (op = ANYOFCI) or (op = ANYBUT) or (op = ANYBUTCI) or (op = EXACTLY) or (op = EXACTLYCI) then begin // Literal string, where present. while s^ <> #0 do begin Result := Result + s^; inc (s); end; inc (s); end; if (op = ANYOFTINYSET) or (op = ANYBUTTINYSET) then begin for i := 1 to TinySetLen do begin Result := Result + s^; inc (s); end; end; if (op = BSUBEXP) or (op = BSUBEXPCI) then begin Result := Result + ' \' + IntToStr (Ord (s^)); inc (s); end; {$IFDEF UseSetOfChar} //###0.929 if op = ANYOFFULLSET then begin for Ch := #0 to #255 do if Ch in PSetOfREChar (s)^ then if Ch < ' ' then Result := Result + '#' + IntToStr (Ord (Ch)) //###0.936 else Result := Result + Ch; inc (s, SizeOf (TSetOfREChar)); end; {$ENDIF} if (op = BRACES) or (op = BRACESNG) then begin //###0.941 // show min/max argument of BRACES operator Result := Result + Format ('{%d,%d}', [PREBracesArg (s)^, PREBracesArg (s + REBracesArgSz)^]); inc (s, REBracesArgSz * 2); end; {$IFDEF ComplexBraces} if (op = LOOP) or (op = LOOPNG) then begin //###0.940 Result := Result + Format (' -> (%d) {%d,%d}', [ (s - programm - (REOpSz + RENextOffSz)) + PRENextOff (s + 2 * REBracesArgSz)^, PREBracesArg (s)^, PREBracesArg (s + REBracesArgSz)^]); inc (s, 2 * REBracesArgSz + RENextOffSz); end; {$ENDIF} Result := Result + #$d#$a; end; { of while} // Header fields of interest. if regstart <> #0 then Result := Result + 'start ' + regstart; if reganch <> #0 then Result := Result + 'anchored '; if regmust <> nil then Result := Result + 'must have ' + regmust; {$IFDEF UseFirstCharSet} //###0.929 Result := Result + #$d#$a'FirstCharSet:'; for Ch := #0 to #255 do if Ch in FirstCharSet then begin if Ch < ' ' then Result := Result + '#' + IntToStr(Ord(Ch)) //###0.948 else Result := Result + Ch; end; {$ENDIF} Result := Result + #$d#$a; end; { of function TRegExpr.Dump --------------------------------------------------------------} {$ENDIF} {$IFDEF reRealExceptionAddr} {$OPTIMIZATION ON} // ReturnAddr works correctly only if compiler optimization is ON // I placed this method at very end of unit because there are no // way to restore compiler optimization flag ... {$ENDIF} procedure TRegExpr.Error (AErrorID : integer); {$IFDEF reRealExceptionAddr} function ReturnAddr : pointer; //###0.938 asm mov eax,[ebp+4] end; {$ENDIF} var e : ERegExpr; begin fLastError := AErrorID; // dummy stub - useless because will raise exception if AErrorID < 1000 // compilation error ? then e := ERegExpr.Create (ErrorMsg (AErrorID) // yes - show error pos + ' (pos ' + IntToStr (CompilerErrorPos) + ')') else e := ERegExpr.Create (ErrorMsg (AErrorID)); e.ErrorCode := AErrorID; e.CompilerErrorPos := CompilerErrorPos; raise e {$IFDEF reRealExceptionAddr} At ReturnAddr; //###0.938 {$ENDIF} end; { of procedure TRegExpr.Error --------------------------------------------------------------} (* PCode persistence: FirstCharSet programm, regsize regstart // -> programm reganch // -> programm regmust, regmlen // -> programm fExprIsCompiled *) // be carefull - placed here code will be always compiled with // compiler optimization flag {$IFDEF FPC} initialization RegExprInvertCaseFunction := TRegExpr.InvertCaseFunction; {$ENDIF} end. ================================================ FILE: impls/objpascal/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/objpascal/step0_repl.pas ================================================ program Mal; {$H+} // Use AnsiString Uses mal_readline; var Repl_Env: string = ''; Line : string; // read function READ(const Str: string) : string; begin READ := Str; end; // eval function EVAL(Ast: string; Env: string) : string; begin EVAL := Ast; end; // print function PRINT(Exp: string) : string; begin PRINT := Exp; end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; begin while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); end; end; end. ================================================ FILE: impls/objpascal/step1_read_print.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, mal_readline, mal_types, reader, printer; var Repl_Env : string = ''; Line : string; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: string) : TMal; begin EVAL := Ast; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; begin while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step2_eval.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, mal_readline, mal_types, mal_func, reader, printer; type TEnv = specialize TFPGMap; var Repl_Env : TEnv; Line : string; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: TEnv) : TMal; var Arr : TMalArray; Arr1 : TMalArray; Sym : string; Cond : TMal; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; I : longint; begin // WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin Sym := (Ast as TMalSymbol).Val; if Env.IndexOf(Sym) < 0 then raise Exception.Create('''' + Sym + ''' not found') else Exit(Env[Sym]); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Arr := (Ast as TMalList).Val; if Length(Arr) = 0 then Exit(Ast); Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := (Cond as TMalFunc); for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); EVAL := Fn.Val(Args) end else raise Exception.Create('invalid apply'); end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function add(Args: TMalArray) : TMal; begin add := TMalInt.Create((Args[0] as TMalInt).Val + (Args[1] as TMalInt).Val); end; function subtract(Args: TMalArray) : TMal; begin subtract := TMalInt.Create((Args[0] as TMalInt).Val - (Args[1] as TMalInt).Val); end; function multiply(Args: TMalArray) : TMal; begin multiply := TMalInt.Create((Args[0] as TMalInt).Val * (Args[1] as TMalInt).Val); end; function divide(Args: TMalArray) : TMal; begin divide := TMalInt.Create((Args[0] as TMalInt).Val div (Args[1] as TMalInt).Val); end; begin Repl_Env := TEnv.Create; Repl_Env.Add('+', TMalFunc.Create(@add)); Repl_Env.Add('-', TMalFunc.Create(@subtract)); Repl_Env.Add('*', TMalFunc.Create(@multiply)); Repl_Env.Add('/', TMalFunc.Create(@divide)); while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step3_env.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, mal_readline, mal_types, mal_func, reader, printer, mal_env; var Repl_Env : TEnv; Line : string; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: TEnv) : TMal; var Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; Fn : TMalCallable; Args : TMalArray; OldDict, NewDict : TMalDict; I : longint; begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Arr := (Ast as TMalList).Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; EVAL := EVAL(Arr[2], LetEnv); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := (Cond as TMalFunc).Val; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); EVAL := Fn(Args) end else raise Exception.Create('invalid apply'); end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function add(Args: TMalArray) : TMal; begin add := TMalInt.Create((Args[0] as TMalInt).Val + (Args[1] as TMalInt).Val); end; function subtract(Args: TMalArray) : TMal; begin subtract := TMalInt.Create((Args[0] as TMalInt).Val - (Args[1] as TMalInt).Val); end; function multiply(Args: TMalArray) : TMal; begin multiply := TMalInt.Create((Args[0] as TMalInt).Val * (Args[1] as TMalInt).Val); end; function divide(Args: TMalArray) : TMal; begin divide := TMalInt.Create((Args[0] as TMalInt).Val div (Args[1] as TMalInt).Val); end; begin Repl_Env := TEnv.Create; Repl_Env.Add(TMalSymbol.Create('+'), TMalFunc.Create(@add)); Repl_Env.Add(TMalSymbol.Create('-'), TMalFunc.Create(@subtract)); Repl_Env.Add(TMalSymbol.Create('*'), TMalFunc.Create(@multiply)); Repl_Env.Add(TMalSymbol.Create('/'), TMalFunc.Create(@divide)); while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step4_if_fn_do.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; FnEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; EVAL := EVAL(Arr[2], LetEnv); end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); EVAL := EVAL(Arr[Length(Arr)-1], Env); end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then EVAL := EVAL(Arr[3], Env) else EVAL := TMalNil.Create else EVAL := EVAL(Arr[2], Env); end; 'fn*': begin EVAL := TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList)) end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then EVAL := Fn.Val(Args) else begin FnEnv := TEnv.Create(Fn.Env, Fn.Params, Args); EVAL := EVAL(Fn.Ast, FnEnv); end end else raise Exception.Create('invalid apply'); end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; begin Repl_Env := TEnv.Create; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step5_tco.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; begin Repl_Env := TEnv.Create; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step6_file.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, math, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; CmdArgs : TMalArray; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function do_eval(Args : TMalArray) : TMal; begin do_eval := EVAL(Args[0], Repl_Env); end; begin Repl_Env := TEnv.Create; core.EVAL := @EVAL; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); SetLength(CmdArgs, Max(0, ParamCount-1)); for I := 2 to ParamCount do CmdArgs[I-2] := TMalString.Create(ParamStr(I)); Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); if ParamCount >= 1 then begin REP('(load-file "' + ParamStr(1) + '")'); ExitCode := 0; Exit; end; while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step7_quote.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, math, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; CmdArgs : TMalArray; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function starts_with(Ast: TMal; Sym: String) : Boolean; var Arr : TMalArray; A0 : TMal; begin 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 : TMalArray; Res, Elt : TMal; I : longint; begin 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 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 EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'quote': Exit(Arr[1]); 'quasiquote': Ast := quasiquote(Arr[1]); 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function do_eval(Args : TMalArray) : TMal; begin do_eval := EVAL(Args[0], Repl_Env); end; begin Repl_Env := TEnv.Create; core.EVAL := @EVAL; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); SetLength(CmdArgs, Max(0, ParamCount-1)); for I := 2 to ParamCount do CmdArgs[I-2] := TMalString.Create(ParamStr(I)); Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); if ParamCount >= 1 then begin REP('(load-file "' + ParamStr(1) + '")'); ExitCode := 0; Exit; end; while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step8_macros.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, math, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; CmdArgs : TMalArray; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function starts_with(Ast: TMal; Sym: String) : Boolean; var Arr : TMalArray; A0 : TMal; begin 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 : TMalArray; Res, Elt : TMal; I : longint; begin 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 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 EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'quote': Exit(Arr[1]); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': begin Fn := EVAL(Arr[2], ENV) as TMalFunc; Fn := TMalFunc.Clone(Fn); Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; if Fn.isMacro then begin if Fn.Ast =nil then Ast := Fn.Val(Args) else Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); continue; // TCO end; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function do_eval(Args : TMalArray) : TMal; begin do_eval := EVAL(Args[0], Repl_Env); end; begin Repl_Env := TEnv.Create; core.EVAL := @EVAL; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); SetLength(CmdArgs, Max(0, ParamCount-1)); for I := 2 to ParamCount do CmdArgs[I-2] := TMalString.Create(ParamStr(I)); Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); if ParamCount >= 1 then begin REP('(load-file "' + ParamStr(1) + '")'); ExitCode := 0; Exit; end; while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/step9_try.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, math, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; CmdArgs : TMalArray; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function starts_with(Ast: TMal; Sym: String) : Boolean; var Arr : TMalArray; A0 : TMal; begin 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 : TMalArray; Res, Elt : TMal; I : longint; begin 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 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 EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'quote': Exit(Arr[1]); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': begin Fn := EVAL(Arr[2], ENV) as TMalFunc; Fn := TMalFunc.Clone(Fn); Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; 'try*': begin try Exit(EVAL(Arr[1], Env)); except On E : Exception do begin if Length(Arr) < 3 then raise; SetLength(Err, 1); if E.ClassType = TMalException then Err[0] := (E as TMalException).Val else Err[0] := TMalString.Create(E.message); Arr := (Arr[2] as TMalList).Val; Exit(EVAL(Arr[2], TEnv.Create(Env, _list(Arr[1]), Err))); end; end; end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; if Fn.isMacro then begin if Fn.Ast =nil then Ast := Fn.Val(Args) else Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); continue; // TCO end; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function do_eval(Args : TMalArray) : TMal; begin do_eval := EVAL(Args[0], Repl_Env); end; begin Repl_Env := TEnv.Create; core.EVAL := @EVAL; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); SetLength(CmdArgs, Max(0, ParamCount-1)); for I := 2 to ParamCount do CmdArgs[I-2] := TMalString.Create(ParamStr(I)); Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); if ParamCount >= 1 then begin REP('(load-file "' + ParamStr(1) + '")'); ExitCode := 0; Exit; end; while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin if E.ClassType = TMalException then WriteLn('Error: ' + pr_str((E as TMalException).Val, True)) else WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/stepA_mal.pas ================================================ program Mal; {$H+} // Use AnsiString Uses sysutils, fgl, math, mal_readline, mal_types, mal_func, reader, printer, mal_env, core; var Repl_Env : TEnv; Line : string; I : longint; Key : string; CmdArgs : TMalArray; // read function READ(const Str: string) : TMal; begin READ := read_str(Str); end; // eval function starts_with(Ast: TMal; Sym: String) : Boolean; var Arr : TMalArray; A0 : TMal; begin 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 : TMalArray; Res, Elt : TMal; I : longint; begin 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 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 EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; Arr : TMalArray; Arr1 : TMalArray; A0Sym : string; LetEnv : TEnv; Cond : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; OldDict, NewDict : TMalDict; begin while true do begin Cond := Env.Get('DEBUG-EVAL'); if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then WriteLn('EVAL: ' + pr_str(Ast, True)); if Ast is TMalSymbol then begin A0Sym := (Ast as TMalSymbol).Val; Cond := Env.Get(A0Sym); if Cond = nil then raise Exception.Create('''' + A0Sym+ ''' not found'); Exit(Cond); end else if Ast is TMalVector then begin Arr := (Ast as TMalVector).Val; SetLength(Arr1, Length(Arr)); for I := 0 to Length(Arr)-1 do Arr1[I]:= EVAL(Arr[I], Env); Exit(TMalVector.Create(Arr1)); end else if Ast is TMalHashMap then begin OldDict := (Ast as TMalHashMap).Val; NewDict := TMalDict.Create; for I := 0 to OldDict.Count-1 do NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); Exit(TMalHashMap.Create(NewDict)); end else if not (Ast is TMalList) then Exit(Ast); // Apply list Lst := (Ast as TMalList); Arr := Lst.Val; if Length(Arr) = 0 then Exit(Ast); if Arr[0] is TMalSymbol then A0Sym := (Arr[0] as TMalSymbol).Val else A0Sym := '__<*fn*>__'; case A0Sym of 'def!': Exit(Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV))); 'let*': begin LetEnv := TEnv.Create(Env); Arr1 := (Arr[1] as TMalList).Val; I := 0; while I < Length(Arr1) do begin LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); Inc(I,2); end; Env := LetEnv; Ast := Arr[2]; // TCO end; 'quote': Exit(Arr[1]); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': begin Fn := EVAL(Arr[2], ENV) as TMalFunc; Fn := TMalFunc.Clone(Fn); Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; 'try*': begin try Exit(EVAL(Arr[1], Env)); except On E : Exception do begin if Length(Arr) < 3 then raise; SetLength(Err, 1); if E.ClassType = TMalException then Err[0] := (E as TMalException).Val else Err[0] := TMalString.Create(E.message); Arr := (Arr[2] as TMalList).Val; Exit(EVAL(Arr[2], TEnv.Create(Env, _list(Arr[1]), Err))); end; end; end; 'do': begin for I := 1 to Length(Arr) - 2 do Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': begin Cond := EVAL(Arr[1], Env); if (Cond is TMalNil) or (Cond is TMalFalse) then if Length(Arr) > 3 then Ast := Arr[3] // TCO else Exit(TMalNil.Create) else Ast := Arr[2]; // TCO end; 'fn*': begin Exit(TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList))); end; else begin Cond := EVAL(Arr[0], Env); Args := copy(Arr, 1, Length(Arr) - 1); if Cond is TMalFunc then begin Fn := Cond as TMalFunc; if Fn.isMacro then begin if Fn.Ast =nil then Ast := Fn.Val(Args) else Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); continue; // TCO end; for I := 0 to Length(Args) - 1 do Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else begin Env := TEnv.Create(Fn.Env, Fn.Params, Args); Ast := Fn.Ast; // TCO end end else raise Exception.Create('invalid apply'); end; end; end; end; // print function PRINT(Exp: TMal) : string; begin PRINT := pr_str(Exp, True); end; // repl function REP(Str: string) : string; begin REP := PRINT(EVAL(READ(Str), Repl_Env)); end; function do_eval(Args : TMalArray) : TMal; begin do_eval := EVAL(Args[0], Repl_Env); end; begin Repl_Env := TEnv.Create; core.EVAL := @EVAL; // core.pas: defined using Pascal for I := 0 to core.NS.Count-1 do begin Key := core.NS.Keys[I]; Repl_Env.Add(TMalSymbol.Create(Key), TMalFunc.Create(core.NS[Key])); end; Repl_Env.Add(TMalSymbol.Create('eval'), TMalFunc.Create(@do_eval)); SetLength(CmdArgs, Max(0, ParamCount-1)); for I := 2 to ParamCount do CmdArgs[I-2] := TMalString.Create(ParamStr(I)); Repl_Env.Add(TMalSymbol.Create('*ARGV*'), TMalList.Create(CmdArgs)); Repl_Env.Add(TMalSymbol.Create('*host-language*'), TMalString.Create('Object Pascal')); // core.mal: defined using language itself REP('(def! not (fn* (a) (if a false true)))'); REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); if ParamCount >= 1 then begin REP('(load-file "' + ParamStr(1) + '")'); ExitCode := 0; Exit; end; REP('(println (str "Mal [" *host-language* "]"))'); while True do begin try Line := _readline('user> '); if Line = '' then continue; WriteLn(REP(Line)) except On E : MalEOF do Halt(0); On E : Exception do begin if E.ClassType = TMalException then WriteLn('Error: ' + pr_str((E as TMalException).Val, True)) else WriteLn('Error: ' + E.message); WriteLn('Backtrace:'); WriteLn(GetBacktrace(E)); end; end; end; end. ================================================ FILE: impls/objpascal/tests/step5_tco.mal ================================================ ;; Object Pascal: skipping non-TCO recursion ;; Reason: completes at 10,000, unrecoverable segfault at 20,000 ================================================ FILE: impls/ocaml/Dockerfile ================================================ FROM ubuntu:25.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install ocaml ================================================ FILE: impls/ocaml/Makefile ================================================ STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml \ step4_if_fn_do.ml step5_tco.ml step6_file.ml step7_quote.ml \ step8_macros.ml step9_try.ml stepA_mal.ml MODULES = types.ml reader.ml printer.ml env.ml core.ml LIBS = str.cmxa unix.cmxa MAL_LIB = mal_lib.cmxa # Apparently necessary with caml 5.0: OPTIONS = -I +str -I +unix STEP_BINS = $(STEPS:%.ml=%) LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS)) all: $(STEP_BINS) dist: mal mal: $(LAST_STEP_BIN) cp $< $@ # ocaml repl apparently needs bytecode, not native, compilation. # Just do it all right here: repl: ocamlc -c $(LIBS:%.cmxa=%.cma) $(MODULES) $(STEPS) rlwrap ocaml $(LIBS:%.cmxa=%.cma) $(MODULES:%.ml=%.cmo) $(MAL_LIB): $(MODULES) ocamlopt -a $(MODULES) -o $@ $(OPTIONS) $(STEP_BINS): %: %.ml $(MAL_LIB) ocamlopt $(LIBS) $(MAL_LIB) $< -o $@ $(OPTIONS) clean: rm -f $(STEP_BINS) mal mal_lib.* *.cmo *.cmx *.cmi *.o format: ocamlformat --inplace --enable-outside-detected-project *.ml .PHONY: all repl clean format ================================================ FILE: impls/ocaml/core.ml ================================================ module T = Types.Types let ns = Env.make None let kw_macro = T.Keyword "macro" let num_fun t f = Types.fn (function | [ T.Int a; T.Int b ] -> t (f a b) | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) let mk_int x = T.Int x let mk_bool x = T.Bool x let rec mal_equal a b = match (a, b) with | T.List { T.value = xs }, T.List { T.value = ys } | T.List { T.value = xs }, T.Vector { T.value = ys } | T.Vector { T.value = xs }, T.List { T.value = ys } | T.Vector { T.value = xs }, T.Vector { T.value = ys } -> List.equal mal_equal xs ys | T.Map { T.value = xs }, T.Map { T.value = ys } -> Types.MalMap.equal mal_equal xs ys | _ -> a = b let seq = function | T.List { T.value = xs } -> xs | T.Vector { T.value = xs } -> xs | _ -> [] let mal_seq = function | [ (T.List { T.value = xs } as lst) ] when not (List.is_empty xs) -> lst | [ T.Vector { T.value = xs } ] when not (List.is_empty xs) -> Types.list xs | [ T.String s ] when 0 < String.length s -> Types.list (List.map (fun x -> T.String x) (Str.split (Str.regexp "") s)) | _ -> T.Nil let rec assoc = function | T.Map { T.value = m } :: xs -> Types.list_into_map m xs | _ -> T.Nil let rec dissoc = function | T.Map { T.value = m } :: xs -> Types.map (List.fold_left (fun k m -> Types.MalMap.remove m k) m xs) | _ -> T.Nil let rec conj = function | c :: x :: (_ :: _ as xs) -> conj (conj [ c; x ] :: xs) | [ T.List { T.value = c; T.meta }; x ] -> T.List { T.value = x :: c; T.meta } | [ T.Vector { T.value = c; T.meta }; x ] -> T.Vector { T.value = c @ [ x ]; T.meta } | _ -> T.Nil let init env = Env.set env "throw" (Types.fn (function [ ast ] -> raise (Types.MalExn ast) | _ -> T.Nil)); Env.set env "+" (num_fun mk_int ( + )); Env.set env "-" (num_fun mk_int ( - )); Env.set env "*" (num_fun mk_int ( * )); Env.set env "/" (num_fun mk_int ( / )); Env.set env "<" (num_fun mk_bool ( < )); Env.set env "<=" (num_fun mk_bool ( <= )); Env.set env ">" (num_fun mk_bool ( > )); Env.set env ">=" (num_fun mk_bool ( >= )); Env.set env "list" (Types.fn (function xs -> Types.list xs)); Env.set env "list?" (Types.fn (function [ T.List _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "vector" (Types.fn (function xs -> Types.vector xs)); Env.set env "vector?" (Types.fn (function [ T.Vector _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "empty?" (Types.fn (function | [ T.List { T.value = [] } ] -> T.Bool true | [ T.Vector { T.value = [] } ] -> T.Bool true | _ -> T.Bool false)); Env.set env "count" (Types.fn (function | [ T.List { T.value = xs } ] | [ T.Vector { T.value = xs } ] -> T.Int (List.length xs) | _ -> T.Int 0)); Env.set env "=" (Types.fn (function | [ a; b ] -> T.Bool (mal_equal a b) | _ -> T.Bool false)); Env.set env "pr-str" (Types.fn (function xs -> T.String (Format.asprintf "%a" (Printer.pr_list true true) xs))); Env.set env "str" (Types.fn (function xs -> T.String (Format.asprintf "%a" (Printer.pr_list false false) xs))); Env.set env "prn" (Types.fn (function xs -> Format.printf "%a\n" (Printer.pr_list true true) xs; T.Nil)); Env.set env "println" (Types.fn (function xs -> Format.printf "%a\n" (Printer.pr_list false true) xs; T.Nil)); Env.set env "compare" (Types.fn (function [ a; b ] -> T.Int (compare a b) | _ -> T.Nil)); Env.set env "with-meta" (Types.fn (function | [ T.List v; m ] -> T.List { v with T.meta = m } | [ T.Map v; m ] -> T.Map { v with T.meta = m } | [ T.Vector v; m ] -> T.Vector { v with T.meta = m } | [ T.Fn v; m ] -> T.Fn { v with meta = m } | _ -> T.Nil)); Env.set env "meta" (Types.fn (function | [ T.List { T.meta } ] -> meta | [ T.Map { T.meta } ] -> meta | [ T.Vector { T.meta } ] -> meta | [ T.Fn { meta } ] -> meta | _ -> T.Nil)); Env.set env "read-string" (Types.fn (function [ T.String x ] -> Reader.read_str x | _ -> T.Nil)); Env.set env "slurp" (Types.fn (function | [ T.String x ] -> let chan = open_in x in let b = Buffer.create 27 in Buffer.add_channel b chan (in_channel_length chan); close_in chan; T.String (Buffer.contents b) | _ -> T.Nil)); Env.set env "cons" (Types.fn (function [ x; xs ] -> Types.list (x :: seq xs) | _ -> T.Nil)); Env.set env "concat" (Types.fn (let rec concat = function | x :: y :: more -> concat (Types.list (seq x @ seq y) :: more) | [ (T.List _ as x) ] -> x | [ x ] -> Types.list (seq x) | [] -> Types.list [] in concat)); Env.set env "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 "nth" (Types.fn (function | [ xs; T.Int i ] -> ( try List.nth (seq xs) i with _ -> raise (Invalid_argument "nth: index out of range")) | _ -> T.Nil)); Env.set env "first" (Types.fn (function | [ xs ] -> ( match seq xs with x :: _ -> x | _ -> T.Nil) | _ -> T.Nil)); Env.set env "rest" (Types.fn (function | [ xs ] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) | _ -> T.Nil)); Env.set env "string?" (Types.fn (function [ T.String _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "symbol" (Types.fn (function [ T.String x ] -> T.Symbol x | _ -> T.Nil)); Env.set env "symbol?" (Types.fn (function [ T.Symbol _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "keyword" (Types.fn (function | [ T.String x ] -> T.Keyword x | [ T.Keyword x ] -> T.Keyword x | _ -> T.Nil)); Env.set env "keyword?" (Types.fn (function [ T.Keyword _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "number?" (Types.fn (function [ T.Int _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "fn?" (Types.fn (function | [ T.Fn { macro = false } ] -> T.Bool true | _ -> T.Bool false)); Env.set env "macro?" (Types.fn (function | [ T.Fn { macro = true } ] -> T.Bool true | _ -> T.Bool false)); Env.set env "nil?" (Types.fn (function [ T.Nil ] -> T.Bool true | _ -> T.Bool false)); Env.set env "true?" (Types.fn (function [ T.Bool true ] -> T.Bool true | _ -> T.Bool false)); Env.set env "false?" (Types.fn (function [ T.Bool false ] -> T.Bool true | _ -> T.Bool false)); Env.set env "sequential?" (Types.fn (function | [ T.List _ ] | [ T.Vector _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "apply" (Types.fn (function | T.Fn { value = f } :: apply_args -> ( match List.rev apply_args with | last_arg :: rev_args -> f (List.rev rev_args @ seq last_arg) | [] -> f []) | _ -> raise (Invalid_argument "First arg to apply must be a fn"))); Env.set env "map" (Types.fn (function | [ T.Fn { value = f }; xs ] -> Types.list (List.map (fun x -> f [ x ]) (seq xs)) | _ -> T.Nil)); Env.set env "readline" (Types.fn (function | [ T.String x ] -> Format.printf "%s%!" x; T.String (read_line ()) | _ -> T.String (read_line ()))); Env.set env "map?" (Types.fn (function [ T.Map _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "hash-map" (Types.fn (Types.list_into_map Types.MalMap.empty)); Env.set env "assoc" (Types.fn assoc); Env.set env "dissoc" (Types.fn dissoc); Env.set env "get" (Types.fn (function | [ T.Map { T.value = m }; k ] -> ( try Types.MalMap.find k m with _ -> T.Nil) | _ -> T.Nil)); Env.set env "keys" (Types.fn (function | [ T.Map { T.value = m } ] -> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m []) | _ -> T.Nil)); Env.set env "vals" (Types.fn (function | [ T.Map { T.value = m } ] -> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m []) | _ -> T.Nil)); Env.set env "contains?" (Types.fn (function | [ T.Map { T.value = m }; k ] -> T.Bool (Types.MalMap.mem k m) | _ -> T.Bool false)); Env.set env "conj" (Types.fn conj); Env.set env "seq" (Types.fn mal_seq); Env.set env "atom?" (Types.fn (function [ T.Atom _ ] -> T.Bool true | _ -> T.Bool false)); Env.set env "atom" (Types.fn (function [ x ] -> T.Atom (ref x) | _ -> T.Nil)); Env.set env "deref" (Types.fn (function [ T.Atom x ] -> !x | _ -> T.Nil)); Env.set env "reset!" (Types.fn (function | [ T.Atom x; v ] -> x := v; v | _ -> T.Nil)); Env.set env "swap!" (Types.fn (function | T.Atom x :: T.Fn { value = f } :: args -> let v = f (!x :: args) in x := v; v | _ -> T.Nil)); Env.set env "time-ms" (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))) ================================================ FILE: impls/ocaml/env.ml ================================================ module T = Types.Types module Data = Map.Make (String) type env = { outer : env option; data : Types.mal_type Data.t ref } let make outer = { outer; data = ref Data.empty } let set env key value = env.data := Data.add key value !(env.data) let rec get env key = match Data.find_opt key !(env.data) with | Some _ as v -> v | None -> ( match env.outer with Some outer -> get outer key | None -> None) ================================================ FILE: impls/ocaml/printer.ml ================================================ open Format module T = Types.Types (* Compile the regex once and for all *) let _pr_escape_re = Str.regexp "\\([\"\\\n]\\)" let _pr_escape_chunk out = function | Str.Text s -> fprintf out "%s" s | Str.Delim "\n" -> fprintf out "\\n" | Str.Delim s -> fprintf out "\\%s" s let _pr_escape_string out s = List.iter (_pr_escape_chunk out) (Str.full_split _pr_escape_re s) let rec pr_str readably out mal_obj = match mal_obj with | T.Int i -> fprintf out "%i" i | T.Keyword s -> fprintf out ":%s" s | T.Nil -> fprintf out "nil" | T.Bool b -> fprintf out "%B" b | T.String s when readably -> fprintf out "\"%a\"" _pr_escape_string s | T.String s | T.Symbol s -> fprintf out "%s" s | T.List { T.value = xs } -> fprintf out "(%a)" (pr_list readably true) xs | T.Vector { T.value = xs } -> fprintf out "[%a]" (pr_list readably true) xs | T.Map { T.value = xs } -> fprintf out "{%a}" (_pr_map readably) xs | T.Fn _ -> fprintf out "#" | T.Atom x -> fprintf out "(atom %a)" (pr_str readably) !x and pr_list readably spaced out = List.iter (let sep = ref "" in fun x -> fprintf out "%s%a" !sep (pr_str readably) x; if spaced && !sep == "" then sep := " " else ()) and _pr_map readably out = Types.MalMap.iter (let sep = ref "" in fun k v -> fprintf out "%s%a %a" !sep (pr_str readably) k (pr_str readably) v; if !sep == "" then sep := " " else ()) ================================================ FILE: impls/ocaml/reader.ml ================================================ open Str (* not reentrant, but simple and always available *) open Types let separator_re = regexp "\\([, \t\n]\\|;[^\n]*\\)+" let number_re = regexp "-?[0-9]+" let chars = "[^][, \t\n;(){}'`~@^\"]+" let keyword_re = regexp (":\\(" ^ chars ^ "\\)") let symbol_re = regexp chars let string_re = regexp {|"\(\(\\[\\n"]\|[^\\"]\)*\)"|} let escape_re = regexp {|\\.|} let quote_re = regexp_string "'" let quasiquote_re = regexp_string "`" let deref_re = regexp_string "@" let unquote_re = regexp_string "~" let sp_unq_re = regexp_string "~@" let with_meta_re = regexp_string "^" let list_re = regexp_string "(" let map_re = regexp_string "{" let vector_re = regexp_string "[" let close_re = regexp "[])}]" (* so "[1 2)" is accepted as a vector *) let unescape str = let e = match_end () - 1 in if str.[e] == 'n' then "\n" else String.sub str e 1 let read_str str = (* !p is the currently parsed position inside str *) let rec read pattern p = let result = string_match pattern str !p in if result then p := match_end (); result and read_list p = ignore (read separator_re p); if read close_re p then [] else (* Parse the first form before the rest of the list *) let first = read_form p in first :: read_list p and read_form p = ignore (read separator_re p); if read number_re p then Types.Int (int_of_string (matched_string str)) else if read keyword_re p then Keyword (matched_group 1 str) else if read symbol_re p then match matched_string str with | "nil" -> Nil | "true" -> Bool true | "false" -> Bool false | t -> Symbol t else if read string_re p then String (global_substitute escape_re unescape (matched_group 1 str)) else if read quote_re p then list [ Symbol "quote"; read_form p ] else if read quasiquote_re p then list [ Symbol "quasiquote"; read_form p ] else if read deref_re p then list [ Symbol "deref"; read_form p ] else if read sp_unq_re p then list [ Symbol "splice-unquote"; read_form p ] else if read unquote_re p then list [ Symbol "unquote"; read_form p ] else if read with_meta_re p then (* Parse the metadata before the value *) let meta = read_form p in list [ Symbol "with-meta"; read_form p; meta ] else if read list_re p then list (read_list p) else if read vector_re p then vector (read_list p) else if read map_re p then list_into_map MalMap.empty (read_list p) else raise (Invalid_argument "unexpected EOF ] } ) or string escape") in read_form (ref 0) ================================================ FILE: impls/ocaml/run ================================================ #!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/ocaml/step0_repl.ml ================================================ (* To try things at the ocaml repl: rlwrap ocaml To see type signatures of all functions: ocamlc -i step0_repl.ml To run the program: ocaml step0_repl.ml *) let eval ast = ast let read str = str let print exp = exp let rep str = print (eval (read str)) let main = try while true do Format.printf "user> %!"; let line = read_line () in Format.printf "%s\n" (rep line) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step1_read_print.ml ================================================ let eval ast = ast let read str = Reader.read_str str let print = Printer.pr_str true let main = try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step2_eval.ml ================================================ module T = Types.Types module Env = Map.Make (String) let num_fun f = Types.fn (function | [ T.Int a; T.Int b ] -> T.Int (f a b) | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) let repl_env = Env.of_list [ ("+", num_fun ( + )); ("-", num_fun ( - )); ("*", num_fun ( * )); ("/", num_fun ( / )); ] let rec eval env ast = (* Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); *) match ast with | T.Symbol s -> ( match Env.find_opt s env with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let main = try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step3_env.ml ================================================ module T = Types.Types let num_fun f = Types.fn (function | [ T.Int a; T.Int b ] -> T.Int (f a b) | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) let repl_env = Env.make None let init_repl env = Env.set env "+" (num_fun ( + )); Env.set env "-" (num_fun ( - )); Env.set env "*" (num_fun ( * )); Env.set env "/" (num_fun ( / )) let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let main = init_repl repl_env; try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step4_if_fn_do.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; re "(def! not (fn* (a) (if a false true)))"; try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step6_file.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))) else [])); Env.set repl_env "eval" (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); re "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ nil)\")))))"; re "(def! not (fn* (a) (if a false true)))"; if Array.length Sys.argv > 1 then re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) else try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step7_quote.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x | T.List { T.value = xs } -> qq_list xs | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] | _ -> ast and qq_list xs = List.fold_right qq_folder xs (Types.list []) and qq_folder elt acc = match elt with | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> Types.list [ T.Symbol "concat"; x; acc ] | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> eval env (quasiquote ast) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))) else [])); Env.set repl_env "eval" (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); re "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ nil)\")))))"; re "(def! not (fn* (a) (if a false true)))"; if Array.length Sys.argv > 1 then re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) else try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step8_macros.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x | T.List { T.value = xs } -> qq_list xs | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] | _ -> ast and qq_list xs = List.fold_right qq_folder xs (Types.list []) and qq_folder elt acc = match elt with | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> Types.list [ T.Symbol "concat"; x; acc ] | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( match eval env expr with | T.Fn ({ macro = false } as f) -> let fn = T.Fn { f with macro = true } in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> eval env (quasiquote ast) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f; macro = true } -> eval env (f args) | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))) else [])); Env.set repl_env "eval" (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); re "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ nil)\")))))"; re "(def! not (fn* (a) (if a false true)))"; re "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ (cons 'cond (rest (rest xs)))))))"; if Array.length Sys.argv > 1 then re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) else try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/step9_try.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x | T.List { T.value = xs } -> qq_list xs | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] | _ -> ast and qq_list xs = List.fold_right qq_folder xs (Types.list []) and qq_folder elt acc = match elt with | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> Types.list [ T.Symbol "concat"; x; acc ] | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( match eval env expr with | T.Fn ({ macro = false } as f) -> let fn = T.Fn { f with macro = true } in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> eval env (quasiquote ast) | T.List { T.value = [ T.Symbol "try*"; scary ] } -> eval env scary | T.List { T.value = [ T.Symbol "try*"; scary; T.List { T.value = [ T.Symbol "catch*"; T.Symbol local; handler ] }; ]; } -> ( try eval env scary with exn -> let value = match exn with | Types.MalExn value -> value | Invalid_argument msg -> T.String msg | e -> T.String (Printexc.to_string e) in let sub_env = Env.make (Some env) in Env.set sub_env local value; eval sub_env handler) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f; macro = true } -> eval env (f args) | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))) else [])); Env.set repl_env "eval" (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); re "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ nil)\")))))"; re "(def! not (fn* (a) (if a false true)))"; re "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ (cons 'cond (rest (rest xs)))))))"; if Array.length Sys.argv > 1 then re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) else try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n" ================================================ FILE: impls/ocaml/stepA_mal.ml ================================================ module T = Types.Types let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [ T.Symbol "unquote"; x ] } -> x | T.List { T.value = xs } -> qq_list xs | T.Vector { T.value = xs } -> Types.list [ T.Symbol "vec"; qq_list xs ] | T.Map _ | T.Symbol _ -> Types.list [ T.Symbol "quote"; ast ] | _ -> ast and qq_list xs = List.fold_right qq_folder xs (Types.list []) and qq_folder elt acc = match elt with | T.List { T.value = [ T.Symbol "splice-unquote"; x ] } -> Types.list [ T.Symbol "concat"; x; acc ] | _ -> Types.list [ T.Symbol "cons"; quasiquote elt; acc ] let rec eval env ast = (match Env.get env "DEBUG-EVAL" with | None | Some T.Nil | Some (T.Bool false) -> () | Some _ -> Format.printf "EVAL: %a\n" (Printer.pr_str true) ast); match ast with | T.Symbol s -> ( match Env.get env s with | Some v -> v | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs } -> Types.vector (List.map (eval env) xs) | T.Map { T.value = xs } -> Types.map (Types.MalMap.map (eval env) xs) | T.List { T.value = [ T.Symbol "def!"; T.Symbol key; expr ] } -> let value = eval env expr in Env.set env key value; value | T.List { T.value = [ T.Symbol "defmacro!"; T.Symbol key; expr ] } -> ( match eval env expr with | T.Fn ({ macro = false } as f) -> let fn = T.Fn { f with macro = true } in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) | T.List { T.value = [ T.Symbol "let*"; T.Vector { T.value = bindings }; body ] } | T.List { T.value = [ T.Symbol "let*"; T.List { T.value = bindings }; body ] } -> let sub_env = Env.make (Some env) in let rec bind_pairs = function | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval sub_env expr); bind_pairs more | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _ :: [] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> () in bind_pairs bindings; eval sub_env body | T.List { T.value = T.Symbol "do" :: body } -> List.fold_left (fun _ -> eval env) T.Nil body | T.List { T.value = [ T.Symbol "if"; test; then_expr; else_expr ] } -> eval env (match eval env test with | T.Nil | T.Bool false -> else_expr | _ -> then_expr) | T.List { T.value = [ T.Symbol "if"; test; then_expr ] } -> ( match eval env test with | T.Nil | T.Bool false -> T.Nil | _ -> eval env then_expr) | T.List { T.value = [ T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr ] } | T.List { T.value = [ T.Symbol "fn*"; T.List { T.value = arg_names }; expr ] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = match (a, b) with | [ T.Symbol "&"; T.Symbol name ], args -> Env.set sub_env name (Types.list args) | T.Symbol name :: names, arg :: args -> Env.set sub_env name arg; bind_args names args | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call") in bind_args arg_names args; eval sub_env expr) | T.List { T.value = [ T.Symbol "quote"; ast ] } -> ast | T.List { T.value = [ T.Symbol "quasiquote"; ast ] } -> eval env (quasiquote ast) | T.List { T.value = [ T.Symbol "try*"; scary ] } -> eval env scary | T.List { T.value = [ T.Symbol "try*"; scary; T.List { T.value = [ T.Symbol "catch*"; T.Symbol local; handler ] }; ]; } -> ( try eval env scary with exn -> let value = match exn with | Types.MalExn value -> value | Invalid_argument msg -> T.String msg | e -> T.String (Printexc.to_string e) in let sub_env = Env.make (Some env) in Env.set sub_env local value; eval sub_env handler) | T.List { T.value = a0 :: args } -> ( match eval env a0 with | T.Fn { value = f; macro = true } -> eval env (f args) | T.Fn { value = f } -> f (List.map (eval env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast let read str = Reader.read_str str let print = Printer.pr_str true let re str = ignore (eval repl_env (read str)) let main = Core.init Core.ns; Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))) else [])); Env.set repl_env "eval" (Types.fn (function [ ast ] -> eval repl_env ast | _ -> T.Nil)); re "(def! *host-language* \"ocaml\")"; re "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\n\ nil)\")))))"; re "(def! not (fn* (a) (if a false true)))"; re "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if \ (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) \ (cons 'cond (rest (rest xs)))))))"; if Array.length Sys.argv > 1 then re (Format.asprintf "(load-file \"%s\")" Sys.argv.(1)) else ( re "(println (str \"Mal [\" *host-language* \"]\"))"; try while true do Format.printf "user> %!"; let line = read_line () in try Format.printf "%a\n" print (eval repl_env (read line)) with | Types.MalExn exc -> Format.printf "mal exception: %a\n" print exc | e -> Format.printf "ocaml exception: %s\n" (Printexc.to_string e) done with End_of_file -> Format.printf "\n") ================================================ FILE: impls/ocaml/tests/step5_tco.mal ================================================ ;; Ocaml skipping non-TCO recursion ;; Reason: completes at 50,000, unrecoverable segfaul at 100,000 ================================================ FILE: impls/ocaml/types.ml ================================================ module rec Types : sig type 'a with_meta = { value : 'a; meta : t } and t = | List of t list with_meta | Vector of t list with_meta | Map of t MalMap.t with_meta | Int of int | Symbol of string | Keyword of string | Nil | Bool of bool | String of string | Fn of { value : t list -> t; meta : t; macro : bool } | Atom of t ref end = Types and MalValue : sig type t = Types.t val compare : t -> t -> int end = struct type t = Types.t let compare = compare end and MalMap : (Map.S with type key = MalValue.t) = Map.Make (MalValue) exception MalExn of Types.t type mal_type = MalValue.t let list x = Types.List { Types.value = x; meta = Types.Nil } let map x = Types.Map { Types.value = x; meta = Types.Nil } let vector x = Types.Vector { Types.value = x; meta = Types.Nil } let fn f = Types.Fn { macro = false; value = f; meta = Types.Nil } let rec list_into_map target source = match source with | k :: v :: more -> list_into_map (MalMap.add k v target) more | [] -> map target | _ :: [] -> raise (Invalid_argument "Literal maps must contain an even number of forms") ================================================ FILE: impls/perl/Core.pm ================================================ package Core; use re '/msx'; use strict; use warnings; use English '-no_match_vars'; use Hash::Util qw(fieldhash); use Time::HiRes qw(time); use Readline qw(mal_readline); use Types qw(equal_q thaw_key nil true false); use Reader qw(read_str); use Printer qw(pr_list); use Interop qw(pl_to_mal); use Exporter 'import'; our @EXPORT_OK = qw(%NS); # String functions sub pr_str { my @args = @_; return Mal::String->new( pr_list( q{ }, 1, @args ) ); } sub str { my @args = @_; return Mal::String->new( pr_list( q{}, 0, @args ) ); } sub prn { my @args = @_; print pr_list( q{ }, 1, @args ), "\n" or die $ERRNO; return nil; } sub println { my @args = @_; print pr_list( q{ }, 0, @args ), "\n" or die $ERRNO; return nil; } sub core_readline { my ($prompt) = @_; my $line = mal_readline( ${$prompt} ); return defined $line ? Mal::String->new($line) : nil; } sub slurp { my ($filename) = @_; local $INPUT_RECORD_SEPARATOR = undef; open my $fh, q{<}, ${$filename} or die $ERRNO; my $data = <$fh>; close $fh or die $ERRNO; return Mal::String->new($data); } # Hash Map functions sub assoc { my ( $src_hsh, @keys ) = @_; return Mal::HashMap->new( { %{$src_hsh}, @keys } ); } sub dissoc { my ( $map, @keys ) = @_; my $new_hsh = { %{$map} }; delete @{$new_hsh}{@keys}; return Mal::HashMap->new($new_hsh); } sub get { my ( $hsh, $key ) = @_; return $hsh->{$key} // nil; } sub contains_q { my ( $hsh, $key ) = @_; return mal_bool( exists $hsh->{$key} ); } sub mal_keys { my ($map) = @_; return Mal::List->new( [ map { thaw_key($_) } keys %{$map} ] ); } sub mal_vals { my ($map) = @_; return Mal::List->new( [ values %{$map} ] ); } # Sequence functions sub cons { my ( $a, $b ) = @_; return Mal::List->new( [ $a, @{$b} ] ); } sub concat { my @args = @_; return Mal::List->new( [ map { @{$_} } @args ] ); } sub nth { my ( $seq, $i ) = @_; return $seq->[ ${$i} ] // die 'nth: index out of bounds'; } sub first { my ($seq) = @_; return $seq->[0] // nil; } sub rest { my ($l) = @_; return Mal::List->new( [ @{$l}[ 1 .. $#{$l} ] ] ); } sub apply { my ( $f, @args ) = @_; my $more_args = pop @args; return $f->( @args, @{$more_args} ); } sub mal_map { my ( $f, $args ) = @_; return Mal::List->new( [ map { $f->($_) } @{$args} ] ); } sub conj { my ( $seq, @items ) = @_; if ( $seq->isa('Mal::List') ) { return Mal::List->new( [ reverse(@items), @{$seq} ] ); } else { return Mal::Vector->new( [ @{$seq}, @items ] ); } } sub seq { my ($arg) = @_; if ( $arg->isa('Mal::List') and @{$arg} ) { return $arg; } if ( $arg->isa('Mal::Vector') and @{$arg} ) { return Mal::List->new( [ @{$arg} ] ); } if ( $arg->isa('Mal::String') and length ${$arg} ) { return Mal::List->new( [ map { Mal::String->new($_) } split //, ${$arg} ] ); } return nil; } fieldhash my %meta; # Metadata functions sub with_meta { my ( $old, $new_meta ) = @_; my $new_obj = $old->clone; $meta{$new_obj} = $new_meta; return $new_obj; } # Atom functions sub swap_bang { my ( $atm, $f, @args ) = @_; return ${$atm} = $f->( ${$atm}, @args ); } # Interop # Force array context so that undef is a valid result. sub pl_star { my ($perl) = @_; ## no critic (BuiltinFunctions::ProhibitStringyEval) my @result = eval ${$perl}; ## use critic @result or die $EVAL_ERROR; return pl_to_mal( $result[0] ); } sub mal_bool { my ($test) = @_; return $test ? true : false; } our %NS = ( q{=} => sub { mal_bool( equal_q( $_[0], $_[1] ) ) }, 'throw' => sub { die $_[0] }, 'nil?' => sub { mal_bool( $_[0]->isa('Mal::Nil') ) }, 'true?' => sub { mal_bool( $_[0]->isa('Mal::True') ) }, 'false?' => sub { mal_bool( $_[0]->isa('Mal::False') ) }, 'number?' => sub { mal_bool( $_[0]->isa('Mal::Integer') ) }, 'symbol' => sub { Mal::Symbol->new( ${ $_[0] } ) }, 'symbol?' => sub { mal_bool( $_[0]->isa('Mal::Symbol') ) }, 'string?' => sub { mal_bool( $_[0]->isa('Mal::String') ) }, 'keyword' => sub { Mal::Keyword->new( ${ $_[0] } ) }, 'keyword?' => sub { mal_bool( $_[0]->isa('Mal::Keyword') ) }, 'fn?' => sub { mal_bool( $_[0]->isa('Mal::Function') ) }, 'macro?' => sub { mal_bool( $_[0]->isa('Mal::Macro') ) }, 'pr-str' => \&pr_str, 'str' => \&str, 'prn' => \&prn, 'println' => \&println, 'readline' => \&core_readline, 'read-string' => sub { read_str( ${ $_[0] } ) }, 'slurp' => \&slurp, '<' => sub { mal_bool( ${ $_[0] } < ${ $_[1] } ) }, '<=' => sub { mal_bool( ${ $_[0] } <= ${ $_[1] } ) }, '>' => sub { mal_bool( ${ $_[0] } > ${ $_[1] } ) }, '>=' => sub { mal_bool( ${ $_[0] } >= ${ $_[1] } ) }, q{+} => sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) }, q{-} => sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) }, q{*} => sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) }, q{/} => sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) }, ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 'time-ms' => sub { Mal::Integer->new( int( time() * 1000 ) ) }, ## use critic 'list' => sub { Mal::List->new( \@_ ) }, 'list?' => sub { mal_bool( $_[0]->isa('Mal::List') ) }, 'vector' => sub { Mal::Vector->new( \@_ ) }, 'vector?' => sub { mal_bool( $_[0]->isa('Mal::Vector') ) }, 'hash-map' => sub { Mal::HashMap->new( {@_} ) }, 'map?' => sub { mal_bool( $_[0]->isa('Mal::HashMap') ) }, 'assoc' => \&assoc, 'dissoc' => \&dissoc, 'get' => \&get, 'contains?' => \&contains_q, 'keys' => \&mal_keys, 'vals' => \&mal_vals, 'sequential?' => sub { mal_bool( $_[0]->isa('Mal::Sequence') ) }, 'nth' => \&nth, 'first' => \&first, 'rest' => \&rest, 'cons' => \&cons, 'concat' => \&concat, 'vec' => sub { Mal::Vector->new( [ @{ $_[0] } ] ) }, 'empty?' => sub { mal_bool( not @{ $_[0] } ) }, 'count' => sub { Mal::Integer->new( scalar @{ $_[0] } ) }, 'apply' => \&apply, 'map' => \&mal_map, 'conj' => \&conj, 'seq' => \&seq, 'with-meta' => \&with_meta, 'meta' => sub { $meta{ $_[0] } // nil }, 'atom' => sub { Mal::Atom->new( $_[0] ) }, 'atom?' => sub { mal_bool( $_[0]->isa('Mal::Atom') ) }, 'deref' => sub { ${ $_[0] } }, 'reset!' => sub { ${ $_[0] } = $_[1] }, 'swap!' => \&swap_bang, 'pl*' => \&pl_star, ); 1; ================================================ FILE: impls/perl/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install perl # For style checks in Makefile. # RUN apt-get -y install libperl-critic-perl perltidy ================================================ FILE: impls/perl/Env.pm ================================================ package Env; use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = (); use Types; sub new { my ( $class, $outer, $binds, $exprs ) = @_; my $data = { __outer__ => $outer }; if ($binds) { for my $i ( 0 .. $#{$binds} ) { if ( ${ $binds->[$i] } eq q{&} ) { # variable length arguments $data->{ ${ $binds->[ $i + 1 ] } } = Mal::List->new( [ @{$exprs}[ $i .. $#{$exprs} ] ] ); last; } $data->{ ${ $binds->[$i] } } = $exprs->[$i]; } } return bless $data => $class; } sub get { my ( $self, $key ) = @_; while ( not $self->{$key} ) { $self = $self->{__outer__} // return; } return $self->{$key}; } ## no critic (NamingConventions::ProhibitAmbiguousNames) sub set { ## use critic my ( $self, $key, $value ) = @_; $self->{$key} = $value; return $value; } #my $e1 = Env->new(); #print Dumper($e1); # #my $e2 = Env->new(); #$e2->set('abc', 123); #$e2->set('def', 456); #print Dumper($e2); # #my $e3 = Env->new($e2); #$e3->set('abc', 789); #$e3->set('ghi', 1024); #print Dumper($e3); # #print Dumper($e3->get('abc')); #print Dumper($e3->get('def')); 1; ================================================ FILE: impls/perl/Interop.pm ================================================ package Interop; use re '/msx'; use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( pl_to_mal ); use Scalar::Util qw(looks_like_number); use Types qw(nil); sub pl_to_mal { my ($obj) = @_; defined $obj or return nil; $_ = ref $obj; if (/^ARRAY/) { return Mal::List->new( [ map { pl_to_mal($_) } @{$obj} ] ); } if (/^HASH/) { return Mal::HashMap->new( { map { pl_to_mal($_) } %{$obj} } ); } if ( $_ eq q{} ) { if ( looks_like_number $obj ) { return Mal::Integer->new($obj); } return Mal::String->new($obj); } die 'Failed to convert a perl object to mal.'; } 1; ================================================ FILE: impls/perl/Makefile ================================================ SOURCES_BASE = \ Readline.pm \ Types.pm \ Reader.pm \ Printer.pm \ Interop.pm SOURCES_LISP = \ Env.pm \ Core.pm \ stepA_mal.pl SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: dist: mal.pl mal mal.pl: $(SOURCES) #fatpack pack ./stepA_mal.pl > $@ fatpack trace ./stepA_mal.pl fatpack packlists-for `cat fatpacker.trace` > packlists fatpack tree `cat packlists` cp $+ fatlib/ (fatpack file; cat ./stepA_mal.pl) > mal.pl mal: mal.pl echo "#!/usr/bin/env perl" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.pl mal fatpacker.trace packlists fatlib/* *-lint [ -d fatlib ] && rmdir fatlib || true no_critic := \ ErrorHandling::RequireCarping \ RequireVersionVar \ # EOL lint-all: $(addsuffix -lint,$(wildcard *.pl *.pm)) lint: $(SOURCES:%=%-lint) %-lint: % Makefile perl -c -I. $* perltidy -st $* | diff -u $* - perlcritic -1 --verbose 11 $(no_critic:%=--exclude=%) $* touch $@ ================================================ FILE: impls/perl/Printer.pm ================================================ package Printer; use re '/msx'; use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( pr_list pr_str ); use Types qw(thaw_key); use List::Util qw(pairmap); sub pr_str { my ( $obj, $print_readably ) = @_; my $_r = $print_readably // 1; if ( $obj->isa('Mal::List') ) { return '(' . pr_list( q{ }, $_r, @{$obj} ) . ')'; } if ( $obj->isa('Mal::Vector') ) { return '[' . pr_list( q{ }, $_r, @{$obj} ) . ']'; } if ( $obj->isa('Mal::HashMap') ) { return '{' . pr_list( q{ }, $_r, pairmap { thaw_key($a) => $b } %{$obj} ) . '}'; } if ( $obj->isa('Mal::Keyword') ) { return ":${$obj}"; } if ( $obj->isa('Mal::String') ) { if ($_r) { my $str = ${$obj}; $str =~ s/\\/\\\\/g; $str =~ s/"/\\"/g; $str =~ s/\n/\\n/g; return qq{"$str"}; } else { return ${$obj}; } } if ( $obj->isa('Mal::Atom') ) { return '(atom ' . pr_str( ${$obj} ) . ')'; } if ( $obj->isa('Mal::Function') ) { return ""; } if ( $obj->isa('Mal::Macro') ) { return ""; } return ${$obj}; } sub pr_list { my ( $separator, $readably, @objs ) = @_; return join $separator, map { pr_str( $_, $readably ) } @objs; } 1; ================================================ FILE: impls/perl/README.md ================================================ # Notes on the mal implementation in Perl5. This implementation should work in any perl from 5.19.3 onwards. Earlier versions are likely to work too as long as you install a new List::Util. The implementation uses the experimental `switch` feature, which may make it vulnerable to future changes in perl. Mal objects are all in subclasses of `Mal::Type`, and can be treated as scalar, array, or hash references as appropriate. Metadata support uses `Hash::Util::FieldHash` to attach external metadata to objects. This means that in the metadata system imposes no overhead on the normal use of objects. Hash-maps are slightly magical. They're keyed by the stringified versions of mal objects, and `Mal::Scalar` overloads stringification so that this works properly. Tail-call optimisation uses Perl's built-in `goto &NAME` syntax for explicit tail calls. This allows functions defined by `fn*` to be implemented as functions at the Perl layer. Perl's garbage-collection is based on reference counting. This means that reference loops will cause memory leaks, and in particular using `def!` to define a function will cause that function to have a reference to the environment it's defined in, making a small reference loop and hence a memory leak. This can be avoided by carefully undefining any function before it goes out of scope. ================================================ FILE: impls/perl/Reader.pm ================================================ package Reader; use re '/msx'; use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( read_str ); use Types qw(nil true false); my $separators = <<'EOF'; (?: [\s,] | ; [^\n]* \n )* EOF my $normal = <<'EOF'; [^\s,;'`~@^()[\]{}"] EOF sub read_list { my ( $str, $end ) = @_; # print "read_list: /${$str}/$end/\n"; my @lst; while () { ${$str} =~ s/ \A $separators //; ${$str} or die "expected '$end', got EOF"; last if ( ${$str} =~ s/ \A $end // ); push @lst, read_form($str); } return \@lst; } sub quote { my ( $quoter, @args ) = @_; # print "read_form: quote/$quoter/\n"; return Mal::List->new( [ Mal::Symbol->new($quoter), @args ] ); } sub read_form { my $str = shift; # print "read_form: /${$str}/\n"; # Always skip initial separators. ${$str} =~ s/ \A $separators //; if ( ${$str} =~ s/ \A ' // ) { return quote( 'quote', read_form($str) ); } if ( ${$str} =~ s/ \A ` // ) { return quote( 'quasiquote', read_form($str) ); } if ( ${$str} =~ s/ \A ~ // ) { return quote( ${$str} =~ s/ \A @ // ? 'splice-unquote' : 'unquote', read_form($str) ); } if ( ${$str} =~ s/ \A \^ // ) { my $meta = read_form($str); return quote( 'with-meta', read_form($str), $meta ); } if ( ${$str} =~ s/ \A @ // ) { return quote( 'deref', read_form($str) ); } if ( ${$str} =~ s/ \A [(] // ) { return Mal::List->new( read_list( $str, '\)' ) ); } if ( ${$str} =~ s/ \A \[ // ) { return Mal::Vector->new( read_list( $str, '\]' ) ); } if ( ${$str} =~ s/ \A [{] // ) { return Mal::HashMap->new( { @{ read_list( $str, '\}' ) } } ); } if ( ${$str} =~ s/ \A ( -? \d+ ) // ) { return Mal::Integer->new($1); } if ( ${$str} =~ s/ \A " // ) { ${$str} =~ s/ \A ( (?: \\ . | [^\\"] )* ) " // or die 'expected ", got EOF'; return Mal::String->new( $1 =~ s/ \\ (.) / $1 =~ tr|n|\n|r /ger ); } if ( ${$str} =~ s/ \A : // ) { ${$str} =~ s/ \A ( $normal + ) // or die 'letters expected after a colon'; return Mal::Keyword->new($1); } if ( ${$str} =~ s/ \A ( $normal+ ) // ) { if ( $1 eq 'nil' ) { return nil; } if ( $1 eq 'true' ) { return true; } if ( $1 eq 'false' ) { return false; } return Mal::Symbol->new($1); } if ( ${$str} =~ / \A [)\]}] / ) { die "unexpected '$1'"; } die "Failed to parse '${$str}'"; } sub read_str { my $str = shift; return read_form( \$str ); } #print Dumper(read_str("123")); #print Dumper(read_str("+")); #print Dumper(read_str("\"abc\"")); #print Dumper(read_str("nil")); #print Dumper(read_str("true")); #print Dumper(read_str("false")); #print Dumper(read_str("(+ 2 3)")); #print Dumper(read_str("(foo 2 (3 4))")); 1; ================================================ FILE: impls/perl/Readline.pm ================================================ # To get readline line editing functionality, please install # Term::ReadKey and either Term::ReadLine::Gnu (GPL) or # Term::ReadLine::Perl (GPL, Artistic) from CPAN. package Readline; use re '/msx'; use strict; use warnings; use English '-no_match_vars'; use Term::ReadLine; use Exporter 'import'; our @EXPORT_OK = qw( mal_readline set_rl_mode ); my $_rl = Term::ReadLine->new('Mal'); $_rl->ornaments(0); #print "Using ReadLine implementation: " . $_rl->ReadLine() . "\n"; my $OUT = $_rl->OUT || \*STDOUT; my $_history_loaded = 0; my $history_file = "$ENV{'HOME'}/.mal-history"; sub save_line { my ($line) = @_; open my $fh, '>>', $history_file or return; print {$fh} "$line\n" or die $ERRNO; close $fh or die $ERRNO; return; } sub load_history { open my $fh, q{<}, $history_file or return; while ( my $line = <$fh> ) { chomp $line; $line =~ /\S/ or next; $_rl->addhistory($line); } close $fh or die $ERRNO; return; } my $rl_mode = 'terminal'; sub set_rl_mode { my ($mode) = @_; $rl_mode = $mode; return; } sub mal_readline { my ($prompt) = @_; my $line; if ( !$_history_loaded ) { $_history_loaded = 1; load_history(); } if ( $rl_mode eq 'terminal' ) { $line = $_rl->readline($prompt); } else { print $prompt or die $ERRNO; $line = readline *STDIN; } if ($line) { chomp $line; if ($line) { save_line($line); } } return $line; } 1; ================================================ FILE: impls/perl/Types.pm ================================================ package Types; use re '/msx'; use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw(equal_q thaw_key nil true false); ## no critic (Modules::ProhibitMultiplePackages) # General functions sub equal_q { my ( $a, $b ) = @_; if ( $a->isa('Mal::Sequence') ) { $b->isa('Mal::Sequence') or return 0; scalar @{$a} == scalar @{$b} or return 0; for ( 0 .. $#{$a} ) { equal_q( $a->[$_], $b->[$_] ) or return 0; } return 1; } ref $b eq ref $a or return 0; if ( $a->isa('Mal::HashMap') ) { scalar keys %{$a} == scalar keys %{$b} or return 0; while ( my ( $k, $v ) = each %{$a} ) { equal_q( $v, $b->{$k} ) or return 0; } return 1; } return ${$a} eq ${$b}; } # Superclass for all kinds of mal value { package Mal::Type; } # Scalars { package Mal::Scalar; use parent -norequire, 'Mal::Type'; # Overload stringification so that its result is something # suitable for use as a hash-map key. The important thing here is # that strings and keywords are distinct: support for other kinds # of scalar is a bonus. use overload '""' => sub { my $self = shift; ref($self) . q{ } . ${$self} }, fallback => 1; sub new { my ( $class, $value ) = @_; return bless \$value, $class; } } # This function converts hash-map keys back into full objects sub thaw_key { my ($key) = @_; my ( $class, $value ) = split m/[ ]/, $key, 2; return $class->new($value); } { package Mal::Nil; use parent -norequire, 'Mal::Scalar'; # Allow nil to be treated as an empty list or hash-map. use overload '@{}' => sub { [] }, '%{}' => sub { {} }, fallback => 1; } { package Mal::True; use parent -norequire, 'Mal::Scalar'; } { package Mal::False; use parent -norequire, 'Mal::Scalar'; } my $nil = Mal::Nil->new('nil'); my $true = Mal::True->new('true'); my $false = Mal::False->new('false'); sub nil { return $nil; } sub true { return $true; } sub false { return $false; } { package Mal::Integer; use parent -norequire, 'Mal::Scalar'; } { package Mal::Symbol; use parent -norequire, 'Mal::Scalar'; } { package Mal::String; use parent -norequire, 'Mal::Scalar'; } { package Mal::Keyword; use parent -norequire, 'Mal::Scalar'; } # Sequences { package Mal::Sequence; use parent -norequire, 'Mal::Type'; sub new { my ( $class, $data ) = @_; return bless $data, $class; } sub clone { my $self = shift; return ref($self)->new( [ @{$self} ] ); } } # Lists { package Mal::List; use parent -norequire, 'Mal::Sequence'; } # Vectors { package Mal::Vector; use parent -norequire, 'Mal::Sequence'; } # Hash-maps { package Mal::HashMap; use parent -norequire, 'Mal::Type'; sub new { my ( $class, $src ) = @_; return bless $src, $class; } sub clone { my $self = shift; return ref($self)->new( { %{$self} } ); } } # Functions { package Mal::Callable; use parent -norequire, 'Mal::Type'; sub new { my ( $class, $data ) = @_; return bless $data, $class; } sub clone { my $self = shift; return bless sub { goto &{$self} }, ref $self; } } { package Mal::Function; use parent -norequire, 'Mal::Callable'; } { package Mal::Macro; use parent -norequire, 'Mal::Callable'; } # Atoms { package Mal::Atom; use parent -norequire, 'Mal::Type'; sub new { my ( $class, $val ) = @_; return bless \$val, $class; } } 1; ================================================ FILE: impls/perl/run ================================================ #!/usr/bin/env bash exec perl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" ================================================ FILE: impls/perl/step0_repl.pl ================================================ #!/usr/bin/perl use strict; use warnings; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use Readline qw(mal_readline set_rl_mode); # read sub READ { my $str = shift; return $str; } # eval sub EVAL { my ($ast) = @_; return $ast; } # print sub PRINT { my $exp = shift; return $exp; } # repl sub REP { my $str = shift; return PRINT( EVAL( READ($str) ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } while ( defined( my $line = mal_readline('user> ') ) ) { print REP($line), "\n" or die $ERRNO; } ================================================ FILE: impls/perl/step1_read_print.pl ================================================ #!/usr/bin/perl use strict; use warnings; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use Readline qw(mal_readline set_rl_mode); use Reader qw(read_str); use Printer qw(pr_str); # read sub READ { my $str = shift; return read_str($str); } # eval sub EVAL { my ($ast) = @_; return $ast; } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl sub REP { my $str = shift; return PRINT( EVAL( READ($str) ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step2_eval.pl ================================================ #!/usr/bin/perl use strict; use warnings; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(); use Reader qw(read_str); use Printer qw(pr_str); # read sub READ { my $str = shift; return read_str($str); } # eval sub EVAL { my ( $ast, $env ) = @_; #print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; if ( $ast->isa('Mal::Symbol') ) { return $env->{ ${$ast} } // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; my $f = EVAL( $a0, $env ); return $f->( map { EVAL( $_, $env ) } @args ); } return $ast; } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = { q{+} => sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) }, q{-} => sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) }, q{*} => sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) }, q{/} => sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) }, }; sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step3_env.pl ================================================ #!/usr/bin/perl use strict; use warnings; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; # read sub READ { my $str = shift; return read_str($str); } # eval my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { return $sf->( $env, @args ); } my $f = EVAL( $a0, $env ); return $f->( map { EVAL( $_, $env ) } @args ); } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } return EVAL( $body, $let_env ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); $repl_env->set( q{+}, sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) } ); $repl_env->set( q{-}, sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) } ); $repl_env->set( q{*}, sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) } ); $repl_env->set( q{/}, sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) } ); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step4_if_fn_do.pl ================================================ #!/usr/bin/perl use strict; use warnings; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # read sub READ { my $str = shift; return read_str($str); } # eval my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { return $sf->( $env, @args ); } my $f = EVAL( $a0, $env ); return $f->( map { EVAL( $_, $env ) } @args ); } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } return EVAL( $body, $let_env ); } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } return EVAL( $final, $env ); } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { return EVAL( $then, $env ); } if ($else) { return EVAL( $else, $env ); } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { return EVAL( $body, Env->new( $env, $params, \@_ ) ); } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step5_tco.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step6_file.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } my $script_file = shift @ARGV; # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } $repl_env->set( 'eval', Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); $repl_env->set( '*ARGV*', Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); REP(<<'EOF'); (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) EOF if ( defined $script_file ) { REP(qq[(load-file "$script_file")]); exit 0; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step7_quote.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval 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 ( $ast->isa('Mal::Vector') ) { return Mal::List->new( [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); } if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); } if ( $ast->isa('Mal::List') ) { if ( starts_with( $ast, 'unquote' ) ) { return $ast->[1]; } return quasiquote_loop($ast); } return $ast; } my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, 'quasiquote' => \&special_quasiquote, 'quote' => \&special_quote, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_quote { my ( $env, $quoted ) = @_; return $quoted; } sub special_quasiquote { my ( $env, $quoted ) = @_; @_ = ( quasiquote($quoted), $env ); goto &EVAL; } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } my $script_file = shift @ARGV; # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } $repl_env->set( 'eval', Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); $repl_env->set( '*ARGV*', Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); REP(<<'EOF'); (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) EOF if ( defined $script_file ) { REP(qq[(load-file "$script_file")]); exit 0; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step8_macros.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval 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 ( $ast->isa('Mal::Vector') ) { return Mal::List->new( [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); } if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); } if ( $ast->isa('Mal::List') ) { if ( starts_with( $ast, 'unquote' ) ) { return $ast->[1]; } return quasiquote_loop($ast); } return $ast; } my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, 'quasiquote' => \&special_quasiquote, 'quote' => \&special_quote, 'defmacro!' => \&special_defmacro, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); if ( $f->isa('Mal::Macro') ) { @_ = ( $f->(@args), $env ); goto &EVAL; } @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_quote { my ( $env, $quoted ) = @_; return $quoted; } sub special_quasiquote { my ( $env, $quoted ) = @_; @_ = ( quasiquote($quoted), $env ); goto &EVAL; } sub special_defmacro { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } my $script_file = shift @ARGV; # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } $repl_env->set( 'eval', Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); $repl_env->set( '*ARGV*', Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); REP(<<'EOF'); (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) EOF REP(<<'EOF'); (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))))))) EOF if ( defined $script_file ) { REP(qq[(load-file "$script_file")]); exit 0; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/step9_try.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Scalar::Util qw(blessed); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval 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 ( $ast->isa('Mal::Vector') ) { return Mal::List->new( [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); } if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); } if ( $ast->isa('Mal::List') ) { if ( starts_with( $ast, 'unquote' ) ) { return $ast->[1]; } return quasiquote_loop($ast); } return $ast; } my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, 'quasiquote' => \&special_quasiquote, 'quote' => \&special_quote, 'defmacro!' => \&special_defmacro, 'try*' => \&special_try, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); if ( $f->isa('Mal::Macro') ) { @_ = ( $f->(@args), $env ); goto &EVAL; } @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_quote { my ( $env, $quoted ) = @_; return $quoted; } sub special_quasiquote { my ( $env, $quoted ) = @_; @_ = ( quasiquote($quoted), $env ); goto &EVAL; } sub special_defmacro { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); } sub special_try { my ( $env, $try, $catch ) = @_; if ($catch) { my ( undef, $binding, $body ) = @{$catch}; if ( my $ret = eval { EVAL( $try, $env ) } ) { return $ret; } my $exc = $EVAL_ERROR; if ( not blessed($exc) or not $exc->isa('Mal::Type') ) { chomp $exc; $exc = Mal::String->new($exc); } my $catch_env = Env->new( $env, [$binding], [$exc] ); @_ = ( $body, $catch_env ); goto &EVAL; } @_ = ( $try, $env ); goto &EVAL; } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } my $script_file = shift @ARGV; # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } $repl_env->set( 'eval', Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); $repl_env->set( '*ARGV*', Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); REP(<<'EOF'); (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) EOF REP(<<'EOF'); (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))))))) EOF if ( defined $script_file ) { REP(qq[(load-file "$script_file")]); exit 0; } while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; if ( defined blessed($err) and $err->isa('Mal::Type') ) { $err = pr_str($err) . "\n"; } print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/stepA_mal.pl ================================================ #!/usr/bin/perl use strict; use warnings FATAL => 'recursion'; use File::Basename 'dirname'; use lib dirname(__FILE__); use English '-no_match_vars'; use List::Util qw(pairs pairmap); use Scalar::Util qw(blessed); use Readline qw(mal_readline set_rl_mode); use Types qw(nil false); use Reader qw(read_str); use Printer qw(pr_str); use Env; use Core qw(%NS); # False positives because of TCO. ## no critic (Subroutines::RequireArgUnpacking) # read sub READ { my $str = shift; return read_str($str); } # eval 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 ( $ast->isa('Mal::Vector') ) { return Mal::List->new( [ Mal::Symbol->new('vec'), quasiquote_loop($ast) ] ); } if ( $ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol') ) { return Mal::List->new( [ Mal::Symbol->new('quote'), $ast ] ); } if ( $ast->isa('Mal::List') ) { if ( starts_with( $ast, 'unquote' ) ) { return $ast->[1]; } return quasiquote_loop($ast); } return $ast; } my %special_forms = ( 'def!' => \&special_def, 'let*' => \&special_let, 'do' => \&special_do, 'if' => \&special_if, 'fn*' => \&special_fn, 'quasiquote' => \&special_quasiquote, 'quote' => \&special_quote, 'defmacro!' => \&special_defmacro, 'try*' => \&special_try, ); sub EVAL { my ( $ast, $env ) = @_; my $dbgeval = $env->get('DEBUG-EVAL'); if ( $dbgeval and not $dbgeval->isa('Mal::Nil') and not $dbgeval->isa('Mal::False') ) { print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; } if ( $ast->isa('Mal::Symbol') ) { return $env->get( ${$ast} ) // die "'${$ast}' not found\n"; } if ( $ast->isa('Mal::Vector') ) { return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); } if ( $ast->isa('Mal::HashMap') ) { return Mal::HashMap->new( { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); } if ( $ast->isa('Mal::List') and @{$ast} ) { my ( $a0, @args ) = @{$ast}; if ( $a0->isa('Mal::Symbol') and my $sf = $special_forms{ ${$a0} } ) { @_ = ( $env, @args ); goto &{$sf}; } my $f = EVAL( $a0, $env ); if ( $f->isa('Mal::Macro') ) { @_ = ( $f->(@args), $env ); goto &EVAL; } @_ = map { EVAL( $_, $env ) } @args; goto &{$f}; } return $ast; } sub special_def { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, EVAL( $val, $env ) ); } sub special_let { my ( $env, $bindings, $body ) = @_; my $let_env = Env->new($env); foreach my $pair ( pairs @{$bindings} ) { my ( $k, $v ) = @{$pair}; $let_env->set( ${$k}, EVAL( $v, $let_env ) ); } @_ = ( $body, $let_env ); goto &EVAL; } sub special_quote { my ( $env, $quoted ) = @_; return $quoted; } sub special_quasiquote { my ( $env, $quoted ) = @_; @_ = ( quasiquote($quoted), $env ); goto &EVAL; } sub special_defmacro { my ( $env, $sym, $val ) = @_; return $env->set( ${$sym}, Mal::Macro->new( EVAL( $val, $env )->clone ) ); } sub special_try { my ( $env, $try, $catch ) = @_; if ($catch) { my ( undef, $binding, $body ) = @{$catch}; if ( my $ret = eval { EVAL( $try, $env ) } ) { return $ret; } my $exc = $EVAL_ERROR; if ( not blessed($exc) or not $exc->isa('Mal::Type') ) { chomp $exc; $exc = Mal::String->new($exc); } my $catch_env = Env->new( $env, [$binding], [$exc] ); @_ = ( $body, $catch_env ); goto &EVAL; } @_ = ( $try, $env ); goto &EVAL; } sub special_do { my ( $env, @todo ) = @_; my $final = pop @todo; for (@todo) { EVAL( $_, $env ); } @_ = ( $final, $env ); goto &EVAL; } sub special_if { my ( $env, $if, $then, $else ) = @_; my $cond = EVAL( $if, $env ); if ( not $cond->isa('Mal::Nil') and not $cond->isa('Mal::False') ) { @_ = ( $then, $env ); goto &EVAL; } if ($else) { @_ = ( $else, $env ); goto &EVAL; } return nil; } sub special_fn { my ( $env, $params, $body ) = @_; return Mal::Function->new( sub { @_ = ( $body, Env->new( $env, $params, \@_ ) ); goto &EVAL; } ); } # print sub PRINT { my $exp = shift; return pr_str($exp); } # repl my $repl_env = Env->new(); sub REP { my $str = shift; return PRINT( EVAL( READ($str), $repl_env ) ); } # Command line arguments if ( $ARGV[0] eq '--raw' ) { set_rl_mode('raw'); shift @ARGV; } my $script_file = shift @ARGV; # core.pl: defined using perl while ( my ( $k, $v ) = each %NS ) { $repl_env->set( $k, Mal::Function->new($v) ); } $repl_env->set( 'eval', Mal::Function->new( sub { EVAL( $_[0], $repl_env ) } ) ); $repl_env->set( '*ARGV*', Mal::List->new( [ map { Mal::String->new($_) } @ARGV ] ) ); # core.mal: defined using the language itself REP(q[(def! *host-language* "perl")]); REP(q[(def! not (fn* (a) (if a false true)))]); REP(<<'EOF'); (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) EOF REP(<<'EOF'); (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))))))) EOF if ( defined $script_file ) { REP(qq[(load-file "$script_file")]); exit 0; } REP(q[(println (str "Mal [" *host-language* "]"))]); while ( defined( my $line = mal_readline('user> ') ) ) { eval { print REP($line), "\n" or die $ERRNO; 1; } or do { my $err = $EVAL_ERROR; if ( defined blessed($err) and $err->isa('Mal::Type') ) { $err = pr_str($err) . "\n"; } print 'Error: ', $err or die $ERRNO; }; } ================================================ FILE: impls/perl/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/perl/tests/stepA_mal.mal ================================================ ;; Testing types returned from pl* (pl* "123") ;=>123 (pl* "\"abc\"") ;=>"abc" (pl* "{'abc'=>123}") ;=>{"abc" 123} (pl* "['abc', 123]") ;=>("abc" 123) (pl* "2+3") ;=>5 (pl* "undef") ;=>nil ;; Testing eval of print statement (pl* "print 'hello\n';") ;/hello ;=>1 ;; Testing exceptions passing through pl* (try* (pl* "die \"pop!\\n\"") (catch* e e)) ;=>"pop!" ================================================ FILE: impls/perl6/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Perl6 build deps RUN apt-get -y install rakudo ================================================ FILE: impls/perl6/Makefile ================================================ all: @true clean: ================================================ FILE: impls/perl6/core.pm ================================================ unit module core; use types; use printer; use reader; sub equal ($a, $b) { if $a ~~ MalSequence && $b ~~ MalSequence { return $FALSE if $a.elems != $b.elems; for |$a Z |$b -> ($a_el, $b_el) { return $FALSE if equal($a_el, $b_el) ~~ $FALSE; } return $TRUE; } elsif $a ~~ MalHashMap && $b ~~ MalHashMap { return $FALSE if $a.elems != $b.elems; for $a.pairs { return $FALSE if !$b{.key} || equal(.value, $b{.key}) ~~ $FALSE; } return $TRUE; } else { return $a.^name eq $b.^name && $a.val ~~ $b.val ?? $TRUE !! $FALSE; } } sub perl6-eval ($code) { my &convert = -> $data { given $data { when Array|List { MalList($_.map({&convert($_)}).Array) } when Hash { MalHashMap($_.map({.key => &convert(.value)}).Hash) } when Bool { $_ ?? $TRUE !! $FALSE } when Int { MalNumber($_) } when Nil { $NIL } default { $_.^name eq 'Any' ?? $NIL !! MalString($_.gist) } } }; use MONKEY-SEE-NO-EVAL; return &convert(EVAL($code)); } our %ns = ( '+' => MalCode({ MalNumber($^a.val + $^b.val) }), '-' => MalCode({ MalNumber($^a.val - $^b.val) }), '*' => MalCode({ MalNumber($^a.val * $^b.val) }), '/' => MalCode({ MalNumber(($^a.val / $^b.val).Int) }), '<' => MalCode({ $^a.val < $^b.val ?? $TRUE !! $FALSE }), '<=' => MalCode({ $^a.val <= $^b.val ?? $TRUE !! $FALSE }), '>' => MalCode({ $^a.val > $^b.val ?? $TRUE !! $FALSE }), '>=' => MalCode({ $^a.val >= $^b.val ?? $TRUE !! $FALSE }), '=' => MalCode({ equal($^a, $^b) }), prn => MalCode({ say @_.map({ pr_str($_, True) }).join(' '); $NIL }), println => MalCode({ say @_.map({ pr_str($_) }).join(' '); $NIL }), pr-str => MalCode({ MalString(@_.map({ pr_str($_, True) }).join(' ') ) }), str => MalCode({ MalString(@_.map({ pr_str($_) }).join) }), read-string => MalCode({ read_str($^a.val) }), slurp => MalCode({ MalString($^a.val.IO.slurp) }), list => MalCode({ MalList(@_) }), 'list?' => MalCode({ $^a ~~ MalList ?? $TRUE !! $FALSE }), 'empty?' => MalCode({ $^a.elems ?? $FALSE !! $TRUE }), count => MalCode({ MalNumber($^a ~~ $NIL ?? 0 !! $^a.elems) }), atom => MalCode({ MalAtom($^a) }), 'atom?' => MalCode({ $^a ~~ MalAtom ?? $TRUE !! $FALSE }), deref => MalCode({ $^a.val }), 'reset!' => MalCode({ $^a.val = $^b }), '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..*]]) }), throw => MalCode({ die X::MalThrow.new(value => $^a) }), apply => MalCode(-> $func, *@args { $func.apply(|@args[0..*-2], |@args[*-1].val) }), map => MalCode(-> $func, $list { MalList([$list.map({ $func.apply($_) })]) }), 'nil?' => MalCode({ $^a ~~ MalNil ?? $TRUE !! $FALSE }), 'true?' => MalCode({ $^a ~~ MalTrue ?? $TRUE !! $FALSE }), 'false?' => MalCode({ $^a ~~ MalFalse ?? $TRUE !! $FALSE }), 'symbol?' => MalCode({ $^a ~~ MalSymbol ?? $TRUE !! $FALSE }), symbol => MalCode({ MalSymbol($^a.val) }), keyword => MalCode({ $^a.val ~~ /^\x29E/ ?? $^a !! MalString("\x29E" ~ $^a.val) }), 'keyword?' => MalCode({ $^a.val ~~ /^\x29E/ ?? $TRUE !! $FALSE }), 'number?' => MalCode({ $^a ~~ MalNumber ?? $TRUE !! $FALSE }), 'fn?' => MalCode({ ($^a ~~ MalCallable && !$^a.?is_macro) ?? $TRUE !! $FALSE }), 'macro?' => MalCode({ $^a.?is_macro ?? $TRUE !! $FALSE }), vector => MalCode({ MalVector(@_) }), 'vector?' => MalCode({ $^a ~~ MalVector ?? $TRUE !! $FALSE }), hash-map => MalCode({ MalHashMap(@_.map({ $^a.val => $^b }).Hash) }), 'map?' => MalCode({ $^a ~~ MalHashMap ?? $TRUE !! $FALSE }), assoc => MalCode(-> $map, *@kv { MalHashMap(Hash.new(|$map.kv, |@kv.map({$^a.val, $^b}))) }), dissoc => MalCode(-> $map, *@keys { my %h = $map.val.clone; %h{@keys.map(*.val)}:delete; MalHashMap(%h) }), get => MalCode({ $^a.val{$^b.val} // $NIL }), 'contains?' => MalCode({ $^a.val{$^b.val}:exists ?? $TRUE !! $FALSE }), keys => MalCode({ MalList([$^a.keys.map({ MalString($_) })]) }), vals => MalCode({ MalList([$^a.values]) }), 'sequential?' => MalCode({ $^a ~~ MalList|MalVector ?? $TRUE !! $FALSE }), readline => MalCode({ with prompt($^a.val) { MalString($_) } else { $NIL } }), time-ms => MalCode({ MalNumber((now * 1000).Int) }), conj => MalCode(-> $seq, *@args { $seq.conj(@args) }), 'string?' => MalCode({ $^a ~~ MalString && $^a.val !~~ /^\x29E/ ?? $TRUE !! $FALSE }), seq => MalCode({ $^a.seq }), with-meta => MalCode({ return $NIL if !$^a.can('meta'); my $x = $^a.clone; $x.meta = $^b; $x }), meta => MalCode({ $^a.?meta // $NIL }), perl6-eval => MalCode({ perl6-eval($^a.val) }), ); ================================================ FILE: impls/perl6/env.pm ================================================ unit class MalEnv; use types; has $.outer; has %.data; has @.binds; has @.exprs; method new ($outer?, @binds?, @exprs?) { self.bless(:$outer, :@binds, :@exprs); } submethod BUILD (:@!binds, :@!exprs, :$!outer, :%!data) { for @!binds.kv -> $idx, $key { if $key eq '&' { my $value = MalList([@!exprs[$idx..*]]); self.set(@!binds[$idx+1], $value); last; } my $value = @!exprs[$idx]; self.set($key, $value); } } method set ($key, $value) { %.data{$key} = $value; } method get ($key) { return %.data{$key} if %.data{$key}; return $.outer.get($key) if $.outer; return 0; } ================================================ FILE: impls/perl6/printer.pm ================================================ unit module printer; use types; sub pr_str ($exp, $print_readably = False) is export { given $exp { when MalFunction { "#" } when MalCode { "#" } when MalList { '(' ~ join(' ', |$exp.map({ pr_str($_, $print_readably) })) ~ ')'; } when MalVector { '[' ~ join(' ', |$exp.map({ pr_str($_, $print_readably) })) ~ ']'; } when MalHashMap { '{' ~ $exp.kv.flatmap({ MalString($^a), $^b }).map({ pr_str($_, $print_readably) }) ~ '}' } when MalString { my $str = $exp.val; if $str ~~ s/^\x29E/:/ || !$print_readably { $str; } else { '"' ~ $str.trans(/\\/ => '\\\\', /\"/ => '\\"', /\n/ => '\\n') ~ '"'; } } when MalAtom { "(atom {pr_str($exp.val, $print_readably)})" } when MalValue { $exp.val } } } ================================================ FILE: impls/perl6/reader.pm ================================================ unit module reader; use types; class Reader { has @.tokens; has $!position = 0; method peek { @.tokens[$!position] } method next { @.tokens[$!position++] } } sub read_form ($rdr) { given $rdr.peek { when "'" { $rdr.next; MalList([MalSymbol('quote'), read_form($rdr)]) } when '`' { $rdr.next; MalList([MalSymbol('quasiquote'), read_form($rdr)]) } when '~' { $rdr.next; MalList([MalSymbol('unquote'), read_form($rdr)]) } when '~@' { $rdr.next; MalList([MalSymbol('splice-unquote'), read_form($rdr)]) } when '@' { $rdr.next; MalList([MalSymbol('deref'), read_form($rdr)]) } when '^' { $rdr.next; my $meta = read_form($rdr); MalList([MalSymbol('with-meta'), read_form($rdr), $meta]); } when ')'|']'|'}' { die X::MalUnexpected.new(token => $_) } when '(' { MalList(read_list($rdr, ')')) } when '[' { MalVector(read_list($rdr, ']')) } when '{' { MalHashMap(read_list($rdr, '}').map({ $^a.val => $^b }).Hash) } default { read_atom($rdr) } } } sub read_list ($rdr, $end) { my @list; my $token = $rdr.next; loop { $token = $rdr.peek; die X::MalIncomplete.new(end => $end) if !$token.defined; last if $token eq $end; @list.push(read_form($rdr)); } $rdr.next; return @list; } sub read_atom ($rdr) { my $atom = $rdr.next; given $atom { when /^'"' [ \\. || <-[\"\\]> ]* '"'$/ { s:g/^\"|\"$//; MalString(.trans(/\\\"/ => '"', /\\n/ => "\n", /\\\\/ => '\\')); } when /^\"/ { die X::MalIncomplete.new(end => '"'); } when /^\:(.*)/ { MalString("\x29E$0") } when /^'-'? <[0..9]>+$/ { MalNumber($_) } when 'nil' { $NIL } when 'true' { $TRUE } when 'false' { $FALSE } default { MalSymbol($_) } } } my regex mal { [ <[\s,]>* # whitespace/commas $=( || '~@' # ~@ || <[\[\]{}()'`~^@]> # special single-char tokens || '"' [ \\. || <-[\"\\]> ]* '"'? # double-quoted strings || ';'<-[\n]>* # comments || <-[\s\[\]{}('"`,;)]>+ # symbols ) ]+ } sub tokenizer ($str) { return [] if !$str.match(/^/); return grep { ! /^\;/ }, $.map({~$_}); } sub read_str ($str) is export { my @tokens = tokenizer($str); die X::MalNoTokens.new if !@tokens; return read_form(Reader.new(tokens => @tokens)); } ================================================ FILE: impls/perl6/run ================================================ #!/usr/bin/env bash exec perl6 $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" ================================================ FILE: impls/perl6/step0_repl.pl ================================================ use v6; #use Linenoise; sub read ($str) { return $str; } sub eval ($ast) { return $ast; } sub print ($exp) { return $exp; } sub rep ($str) { return print(eval(read($str))); } sub MAIN { #while (my $line = linenoise('user> ')).defined { # say rep($line); #} while (my $line = prompt 'user> ').defined { say rep($line); } } ================================================ FILE: impls/perl6/step1_read_print.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; sub read ($str) { return read_str($str); } sub eval ($ast) { return $ast; } sub print ($exp) { return pr_str($exp, True); } sub rep ($str) { return print(eval(read($str))); } sub MAIN { while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step2_eval.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; sub read ($str) { return read_str($str); } sub eval ($ast, $env) { # say "EVAL: " ~ print($ast); given $ast { when MalSymbol { return $env{$ast.val} || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($func, @args) = $ast.map({ eval($_, $env) }); my $arglist = MalList(@args); return $func.apply($arglist); } sub print ($exp) { return pr_str($exp, True); } my $repl_env; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN { $repl_env<+> = MalCode({ MalNumber($^a[0].val + $^a[1].val) }); $repl_env<-> = MalCode({ MalNumber($^a[0].val - $^a[1].val) }); $repl_env<*> = MalCode({ MalNumber($^a[0].val * $^a[1].val) }); $repl_env = MalCode({ MalNumber(($^a[0].val / $^a[1].val).Int) }); while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step3_env.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; sub read ($str) { return read_str($str); } sub eval ($ast, $env) { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } return eval($a2, $new_env); } default { my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(@args); } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN { $repl_env.set('+', MalCode({ MalNumber($^a.val + $^b.val) })); $repl_env.set('-', MalCode({ MalNumber($^a.val - $^b.val) })); $repl_env.set('*', MalCode({ MalNumber($^a.val * $^b.val) })); $repl_env.set('/', MalCode({ MalNumber(($^a.val / $^b.val).Int) })); while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step4_if_fn_do.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } sub eval ($ast, $env) { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } return eval($a2, $new_env); } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); return eval($ast[*-1], $env); } when 'if' { return eval($a1, $env) !~~ MalNil|MalFalse ?? return eval($a2, $env) !! return $a3 ?? eval($a3, $env) !! $NIL; } when 'fn*' { return MalCode(-> *@args { my @binds = $a1 ?? $a1.map(*.val) !! (); eval($a2, MalEnv.new($env, @binds, @args)); }); } default { my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args); } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN { $repl_env.set(.key, .value) for %core::ns; rep(q{(def! not (fn* (a) (if a false true)))}); while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step5_tco.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } default { my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN { $repl_env.set(.key, .value) for %core::ns; rep(q{(def! not (fn* (a) (if a false true)))}); while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step6_file.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } default { my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN ($source_file?, *@args) { $repl_env.set(.key, .value) for %core::ns; $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); rep(q{(def! not (fn* (a) (if a false true)))}); rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); if ($source_file.defined) { rep("(load-file \"$source_file\")"); exit; } while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step7_quote.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } 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) { 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 } } } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } when 'quasiquote' { $ast = quasiquote($a1) } default { my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN ($source_file?, *@args) { $repl_env.set(.key, .value) for %core::ns; $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); rep(q{(def! not (fn* (a) (if a false true)))}); rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); if ($source_file.defined) { rep("(load-file \"$source_file\")"); exit; } while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step8_macros.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } 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) { 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 } } } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); $func.is_macro = True; return $env.set($a1.val, $func); } default { my $func = eval($a0, $env); my @args = $ast[1..*]; if $func.?is_macro { $ast = $func.apply(@args); next; } @args = @args.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN ($source_file?, *@args) { $repl_env.set(.key, .value) for %core::ns; $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); rep(q{(def! not (fn* (a) (if a false true)))}); rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); if ($source_file.defined) { rep("(load-file \"$source_file\")"); exit; } while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalException { .Str.say } } } } ================================================ FILE: impls/perl6/step9_try.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } 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) { 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 } } } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); $func.is_macro = True; return $env.set($a1.val, $func); } when 'try*' { return eval($a1, $env); CATCH { .rethrow if !$a2; my $ex = $_ ~~ X::MalThrow ?? .value !! MalString(.Str); my $new_env = $env; $env.set($a2[1].val, $ex); return eval($a2[2], $new_env); } } default { my $func = eval($a0, $env); my @args = $ast[1..*]; if $func.?is_macro { $ast = $func.apply(@args); next; } @args = @args.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN ($source_file?, *@args) { $repl_env.set(.key, .value) for %core::ns; $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); rep(q{(def! not (fn* (a) (if a false true)))}); rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); if ($source_file.defined) { rep("(load-file \"$source_file\")"); exit; } while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalThrow { say "Error: " ~ pr_str(.value, True) } when X::MalException { say "Error: " ~ .Str } } } } ================================================ FILE: impls/perl6/stepA_mal.pl ================================================ use v6; use lib IO::Path.new($?FILE).dirname; use reader; use printer; use types; use env; use core; sub read ($str) { return read_str($str); } 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) { 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 } } } sub eval ($ast is copy, $env is copy) { loop { say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; given $ast { when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } when MalList { } when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } default { return $ast // $NIL } } return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; given $a0.val { when 'def!' { return $env.set($a1.val, eval($a2, $env)); } when 'let*' { my $new_env = MalEnv.new($env); for |$a1.val -> $key, $value { $new_env.set($key.val, eval($value, $new_env)); } $env = $new_env; $ast = $a2; } when 'do' { $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { if eval($a1, $env) ~~ MalNil|MalFalse { return $NIL if $a3 ~~ $NIL; $ast = $a3; } else { $ast = $a2; } } when 'fn*' { my @binds = $a1 ?? $a1.map(*.val) !! (); my &fn = -> *@args { eval($a2, MalEnv.new($env, @binds, @args)); }; return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); $func = MalFunction($func.ast, $func.env, $func.params, $func.fn); $func.is_macro = True; return $env.set($a1.val, $func); } when 'try*' { return eval($a1, $env); CATCH { .rethrow if !$a2; my $ex = $_ ~~ X::MalThrow ?? .value !! MalString(.Str); my $new_env = $env; $env.set($a2[1].val, $ex); return eval($a2[2], $new_env); } } default { my $func = eval($a0, $env); my @args = $ast[1..*]; if $func.?is_macro { $ast = $func.apply(@args); next; } @args = @args.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); } } } } sub print ($exp) { return pr_str($exp, True); } my $repl_env = MalEnv.new; sub rep ($str) { return print(eval(read($str), $repl_env)); } sub MAIN ($source_file?, *@args) { $repl_env.set(.key, .value) for %core::ns; $repl_env.set('eval', MalCode({ eval($^a, $repl_env) })); $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })])); $repl_env.set('*host-language*', MalString('perl6')); rep(q{(def! not (fn* (a) (if a false true)))}); rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))}); rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))}); if ($source_file.defined) { rep("(load-file \"$source_file\")"); exit; } rep(q{(println (str "Mal [" *host-language* "]"))}); while (my $line = prompt 'user> ').defined { say rep($line); CATCH { when X::MalThrow { say "Error: " ~ pr_str(.value, True) } when X::MalException { say "Error: " ~ .Str } } } } ================================================ FILE: impls/perl6/tests/stepA_mal.mal ================================================ ;; Testing basic Perl 6 interop (perl6-eval "7") ;=>7 (perl6-eval "'7'") ;=>"7" (perl6-eval "123 == 123") ;=>true (perl6-eval "123 == 456") ;=>false (perl6-eval "(7,8,9)") ;=>(7 8 9) (perl6-eval "[7,8,9]") ;=>(7 8 9) (perl6-eval "{abc => 789}") ;=>{"abc" 789} (perl6-eval "Nil") ;=>nil (perl6-eval "True") ;=>true (perl6-eval "False") ;=>false (perl6-eval "my $foo") ;=>nil (perl6-eval "say 'hello' ") ;/hello ;=>true (perl6-eval "sub { my $foo = 8 }()") ;=>8 (perl6-eval "'This sentence has five words'.subst(/\w+/, :g, {'*' ~ $^a.chars ~ '*'})") ;=>"*4* *8* *3* *4* *5*" (perl6-eval "<3 a 45 b>.join: '|'") ;=>"3|a|45|b" ================================================ FILE: impls/perl6/types.pm ================================================ unit module types; class X::MalException is Exception is export {} class X::MalNoTokens is X::MalException is export { method message() { "got no tokens" } } class X::MalIncomplete is X::MalException is export { has $.end; method message() { "expected '$.end', got EOF" } } class X::MalUnexpected is X::MalException is export { has $.token; method message() { "unexpected '$.token'" } } class X::MalNotFound is X::MalException is export { has $.name; method message() { "'$.name' not found" } } class X::MalOutOfRange is X::MalException is export { method message() { "nth: index out of range" } } class X::MalThrow is X::MalException is export { has $.value; } role MalValue is export { has $.val is rw; method CALL-ME ($val) { self.new(:$val) } } role MalSequence is export { has $.val handles ; has $.meta is rw; method CALL-ME ($val) { self.new(:$val) } } role MalCallable is export { has &.fn; method apply (*@_) { &!fn(|@_) } } role MalMeta is export { has $.meta is rw; } class MalNil does MalValue is export { method seq { self } } class MalTrue does MalValue is export {} class MalFalse does MalValue is export {} our $NIL is export = MalNil('nil'); our $TRUE is export = MalTrue('true'); our $FALSE is export = MalFalse('false'); class MalSymbol does MalValue does MalMeta is export {} class MalList does MalSequence is export { method conj (@args) { return self.new(val => [|@args.reverse, |$.val]) } method seq { return self.elems ?? self !! $NIL } } class MalVector does MalSequence is export { method conj (@args) { return self.new(val => [|$.val, |@args]) } method seq { return self.elems ?? MalList(self.val) !! $NIL } } class MalHashMap does MalMeta is export { has $.val handles ; method CALL-ME ($val) { self.new(:$val) } } class MalNumber does MalValue is export {} class MalString does MalValue is export { method seq { return self.val.chars ?? MalList(self.val.comb.map({MalString($_)})) !! $NIL; } } class MalCode does MalCallable does MalMeta is export { method CALL-ME (&fn) { self.new(:&fn) } } class MalFunction does MalCallable does MalMeta is export { has $.ast; has @.params; has $.env; has $.is_macro is rw = False; method CALL-ME ($ast, $env, @params, &fn) { self.bless(:$ast, :$env, :@params, :&fn); } } class MalAtom does MalValue does MalMeta is export {} ================================================ FILE: impls/php/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install php-cli ================================================ FILE: impls/php/Makefile ================================================ SOURCES_BASE = readline.php types.php reader.php printer.php interop.php SOURCES_LISP = env.php core.php stepA_mal.php SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: dist: mal.php mal mal.php: $(SOURCES) cat $+ | grep -v "^require_once" > $@ mal: mal.php echo "#!/usr/bin/env php" > $@ cat $< >> $@ chmod +x $@ mal-web.php: mal.php cat $< | ( IFS="NON-MATCHING-IFS"; while read -r line; do if [ "$$line" = "// run mal file" ]; then echo "?>"; cat webrunner.php; echo " $@ clean: rm -f mal.php mal mal-web.php ================================================ FILE: impls/php/README.md ================================================ ### Running .mal scripts on PHP hosting ### Create a symlink to `mal-web.php` with the same name as your `.mal` script and your script will be executed as if it was PHP. Here's an example using local dev. First build `mal-web.php`: cd mal/php make mal-web.php Now you can create a web runnable mal script: echo '(println "Hello world!")' > myscript.mal ln -s mal-web.php myscript.php Start a development server with `php -S 0.0.0.0:8000` and then browse to http://localhost:8000/myscript.php and you should see "Hello world!" in your browser as `myscript.mal` is run. You can do the same thing on live PHP web hosting by copying `mal.php` up and creating a symlink for each `.mal` file you want to be web-executable. ### PHP interop ### In [stepA_mal.mal](./tests/stepA_mal.mal) you can find some examples of PHP interop. Eval PHP code: (php* "return 7;") 7 (php* "return array(7,8,9);") (7 8 9) Native function call: (php/date "Y-m-d" 0) "1970-01-01" Accessing PHP "superglobal" variables: (get php/_SERVER "PHP_SELF") "./mal" ================================================ FILE: impls/php/core.php ================================================ offsetExists($k)) { return $hm[$k]; } else { return NULL; } } function contains_Q($hm, $k) { return array_key_exists($k, $hm); } function keys($hm) { return call_user_func_array('_list', array_map('strval', array_keys($hm->getArrayCopy()))); } function vals($hm) { return call_user_func_array('_list', array_values($hm->getArrayCopy())); } // Sequence functions function cons($a, $b) { $tmp = $b->getArrayCopy(); array_unshift($tmp, $a); $l = new ListClass(); $l->exchangeArray($tmp); return $l; } function concat() { $args = func_get_args(); $tmp = array(); foreach ($args as $arg) { $tmp = array_merge($tmp, $arg->getArrayCopy()); } $l = new ListClass(); $l->exchangeArray($tmp); 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]; } else { throw new Exception("nth: index out of range"); } } function first($seq) { if ($seq === NULL || count($seq) === 0) { return NULL; } else { return $seq[0]; } } function rest($seq) { if ($seq === NULL) { return new ListClass(); } else { $l = new ListClass(); $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); return $l; } } function empty_Q($seq) { return $seq->count() === 0; } function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } function apply($f) { $args = array_slice(func_get_args(), 1); $last_arg = array_pop($args)->getArrayCopy(); return $f->apply(array_merge($args, $last_arg)); } function map($f, $seq) { $l = new ListClass(); # @ to surpress warning if $f throws an exception @$l->exchangeArray(array_map($f, $seq->getArrayCopy())); return $l; } function conj($src) { $args = array_slice(func_get_args(), 1); $tmp = $src->getArrayCopy(); if (_list_Q($src)) { foreach ($args as $arg) { array_unshift($tmp, $arg); } $s = new ListClass(); } else { foreach ($args as $arg) { $tmp[] = $arg; } $s = new VectorClass(); } $s->exchangeArray($tmp); return $s; } function seq($src) { if (_list_Q($src)) { if (count($src) == 0) { return NULL; } return $src; } elseif (_vector_Q($src)) { if (count($src) == 0) { return NULL; } $tmp = $src->getArrayCopy(); $s = new ListClass(); $s->exchangeArray($tmp); return $s; } elseif (_string_Q($src)) { if (strlen($src) == 0) { return NULL; } $tmp = str_split($src); $s = new ListClass(); $s->exchangeArray($tmp); return $s; } elseif (_nil_Q($src)) { return NULL; } else { throw new Exception("seq: called on non-sequence"); } return $s; } // Metadata functions function with_meta($obj, $m) { $new_obj = clone $obj; $new_obj->meta = $m; return $new_obj; } function meta($obj) { return $obj->meta; } // Atom functions function deref($atm) { return $atm->value; } function reset_BANG($atm, $val) { return $atm->value = $val; } function swap_BANG($atm, $f) { $args = array_slice(func_get_args(),2); array_unshift($args, $atm->value); $atm->value = call_user_func_array($f, $args); return $atm->value; } // core_ns is namespace of type functions $core_ns = array( '='=> function ($a, $b) { return _equal_Q($a, $b); }, 'throw'=> function ($a) { return mal_throw($a); }, 'nil?'=> function ($a) { return _nil_Q($a); }, 'true?'=> function ($a) { return _true_Q($a); }, 'false?'=> function ($a) { return _false_Q($a); }, 'number?'=> function ($a) { return _number_Q($a); }, 'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); }, 'symbol?'=> function ($a) { return _symbol_Q($a); }, 'keyword'=> function () { return call_user_func_array('_keyword', func_get_args()); }, 'keyword?'=> function ($a) { return _keyword_Q($a); }, 'string?'=> function ($a) { return _string_Q($a); }, 'fn?'=> function($a) { return _fn_Q($a) || (_function_Q($a) && !$a->ismacro ); }, 'macro?'=> function($a) { return _function_Q($a) && $a->ismacro; }, 'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); }, 'str'=> function () { return call_user_func_array('str', func_get_args()); }, 'prn'=> function () { return call_user_func_array('prn', func_get_args()); }, 'println'=>function () { return call_user_func_array('println', func_get_args()); }, 'readline'=>function ($a) { return mal_readline($a); }, 'read-string'=>function ($a) { return read_str($a); }, 'slurp'=> function ($a) { return file_get_contents($a); }, '<'=> function ($a, $b) { return $a < $b; }, '<='=> function ($a, $b) { return $a <= $b; }, '>'=> function ($a, $b) { return $a > $b; }, '>='=> function ($a, $b) { return $a >= $b; }, '+'=> function ($a, $b) { return intval($a + $b,10); }, '-'=> function ($a, $b) { return intval($a - $b,10); }, '*'=> function ($a, $b) { return intval($a * $b,10); }, '/'=> function ($a, $b) { return intval($a / $b,10); }, 'time-ms'=>function () { return time_ms(); }, 'list'=> function () { return call_user_func_array('_list', func_get_args()); }, 'list?'=> function ($a) { return _list_Q($a); }, 'vector'=> function () { return call_user_func_array('_vector', func_get_args()); }, 'vector?'=> function ($a) { return _vector_Q($a); }, 'hash-map' => function () { return call_user_func_array('_hash_map', func_get_args()); }, 'map?'=> function ($a) { return _hash_map_Q($a); }, 'assoc' => function () { return call_user_func_array('assoc', func_get_args()); }, 'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); }, 'get' => function ($a, $b) { return get($a, $b); }, 'contains?' => function ($a, $b) { return contains_Q($a, $b); }, 'keys' => function ($a) { return keys($a); }, 'vals' => function ($a) { return vals($a); }, '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); }, 'empty?'=> function ($a) { return empty_Q($a); }, 'count'=> function ($a) { return scount($a); }, 'apply'=> function () { return call_user_func_array('apply', func_get_args()); }, 'map'=> function ($a, $b) { return map($a, $b); }, 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, 'seq'=> function ($a) { return seq($a); }, 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, 'meta'=> function ($a) { return meta($a); }, 'atom'=> function ($a) { return _atom($a); }, 'atom?'=> function ($a) { return _atom_Q($a); }, 'deref'=> function ($a) { return deref($a); }, 'reset!'=> function ($a, $b) { return reset_BANG($a, $b); }, 'swap!'=> function () { return call_user_func_array('swap_BANG', func_get_args()); }, ); ?> ================================================ FILE: impls/php/env.php ================================================ outer = $outer; if ($binds) { if (_sequential_Q($exprs)) { $exprs = $exprs->getArrayCopy(); } for ($i=0; $ivalue === "&") { if ($exprs !== NULL && $i < count($exprs)) { $lst = call_user_func_array('_list', array_slice($exprs, $i)); } else { $lst = _list(); } $this->data[$binds[$i+1]->value] = $lst; break; } else { if ($exprs !== NULL && $i < count($exprs)) { $this->data[$binds[$i]->value] = $exprs[$i]; } else { $this->data[$binds[$i]->value] = NULL; } } } } } public function find($key) { if (array_key_exists($key, $this->data)) { return $this; } elseif ($this->outer) { return $this->outer->find($key); } else { return NULL; } } public function set($key, $value) { $this->data[$key->value] = $value; return $value; } public function get($key) { $env = $this->find($key); if (!$env) { throw new Exception("'" . $key . "' not found"); } else { return $env->data[$key]; } } } ?> ================================================ FILE: impls/php/interop.php ================================================ $v) { $ret[_to_php($k)] = _to_php($v); } return $ret; } elseif (is_string($obj)) { if (strpos($obj, chr(0x7f)) === 0) { return ":".substr($obj,1); } else { return $obj; } } elseif (_symbol_Q($obj)) { return ${$obj->value}; } elseif (_atom_Q($obj)) { return $obj->value; } else { return $obj; } } function _to_mal($obj) { switch (gettype($obj)) { case "object": return _to_mal(get_object_vars($obj)); case "array": $obj_conv = array(); foreach ($obj as $k => $v) { $obj_conv[_to_mal($k)] = _to_mal($v); } if ($obj_conv !== array_values($obj_conv)) { $new_obj = _hash_map(); $new_obj->exchangeArray($obj_conv); return $new_obj; } else { return call_user_func_array('_list', $obj_conv); } default: return $obj; } } function _to_native($name, $env) { if (is_callable($name)) { return _function(function() use ($name) { $args = array_map("_to_php", func_get_args()); $res = call_user_func_array($name, $args); return _to_mal($res); }); // special case for language constructs } else if ($name == "print") { return _function(function($value) { print(_to_php($value)); return null; }); } else if ($name == "exit") { return _function(function($value) { exit(_to_php($value)); return null; }); } else if ($name == "require") { return _function(function($value) { require(_to_php($value)); return null; }); } else if (in_array($name, ["_SERVER", "_GET", "_POST", "_FILES", "_REQUEST", "_SESSION", "_ENV", "_COOKIE"])) { $val = $GLOBALS[$name]; } else if (defined($name)) { $val = constant($name); } else { $val = ${$name}; } return _to_mal($val); } ?> ================================================ FILE: impls/php/printer.php ================================================ getArrayCopy()) as $k) { $ret[] = _pr_str("$k", $print_readably); $ret[] = _pr_str($obj[$k], $print_readably); } return "{" . implode(" ", $ret) . "}"; } elseif (is_string($obj)) { if (strpos($obj, chr(0x7f)) === 0) { return ":".substr($obj,1); } elseif ($print_readably) { $obj = preg_replace('/\n/', '\\n', preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj))); return '"' . $obj . '"'; } else { return $obj; } } elseif (is_double($obj)) { return $obj; } elseif (is_integer($obj)) { return $obj; } elseif ($obj === NULL) { return "nil"; } elseif ($obj === true) { return "true"; } elseif ($obj === false) { return "false"; } elseif (_symbol_Q($obj)) { return $obj->value; } elseif (_atom_Q($obj)) { return "(atom " . _pr_str($obj->value, $print_readably) . ")"; } elseif (_function_Q($obj)) { return "(fn* [...] ...)"; } elseif (is_callable($obj)) { // only step4 and below return "#"; } elseif (is_object($obj)) { return "#"; } elseif (is_array($obj)) { return "#"; } else { throw new Exception("_pr_str unknown type: " . gettype($obj)); } } ?> ================================================ FILE: impls/php/reader.php ================================================ tokens = $tokens; $this->position = 0; } public function next() { if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position++]; } public function peek() { if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position]; } } class BlankException extends Exception { } function _real_token($s) { return $s !== '' && $s[0] !== ';'; } function tokenize($str) { $pat = "/[\s,]*(php\/|~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\s\[\]{}('\"`,;)]*)/"; preg_match_all($pat, $str, $matches); return array_values(array_filter($matches[1], '_real_token')); } function read_atom($reader) { $token = $reader->next(); if (preg_match("/^-?[0-9]+$/", $token)) { return intval($token, 10); } elseif (preg_match("/^\"(?:\\\\.|[^\\\\\"])*\"$/", $token)) { $str = substr($token, 1, -1); $str = str_replace('\\\\', chr(0x7f), $str); $str = str_replace('\\"', '"', $str); $str = str_replace('\\n', "\n", $str); $str = str_replace(chr(0x7f), "\\", $str); return $str; } elseif ($token[0] === "\"") { throw new Exception("expected '\"', got EOF"); } elseif ($token[0] === ":") { return _keyword(substr($token,1)); } elseif ($token === "nil") { return NULL; } elseif ($token === "true") { return true; } elseif ($token === "false") { return false; } else { return _symbol($token); } } function read_list($reader, $constr='_list', $start='(', $end=')') { $ast = $constr(); $token = $reader->next(); if ($token !== $start) { throw new Exception("expected '" . $start . "'"); } while (($token = $reader->peek()) !== $end) { if ($token === "" || $token === null) { throw new Exception("expected '" . $end . "', got EOF"); } $ast[] = read_form($reader); } $reader->next(); return $ast; } function read_hash_map($reader) { $lst = read_list($reader, '_list', '{', '}'); return call_user_func_array('_hash_map', $lst->getArrayCopy()); } function read_form($reader) { $token = $reader->peek(); switch ($token) { case '\'': $reader->next(); return _list(_symbol('quote'), read_form($reader)); case '`': $reader->next(); return _list(_symbol('quasiquote'), read_form($reader)); case '~': $reader->next(); return _list(_symbol('unquote'), read_form($reader)); case '~@': $reader->next(); return _list(_symbol('splice-unquote'), read_form($reader)); case '^': $reader->next(); $meta = read_form($reader); return _list(_symbol('with-meta'), read_form($reader), $meta); case '@': $reader->next(); return _list(_symbol('deref'), read_form($reader)); case 'php/': $reader->next(); return _list(_symbol('to-native'), read_form($reader)); case ')': throw new Exception("unexpected ')'"); case '(': return read_list($reader); case ']': throw new Exception("unexpected ']'"); case '[': return read_list($reader, '_vector', '[', ']'); case '}': throw new Exception("unexpected '}'"); case '{': return read_hash_map($reader); default: return read_atom($reader); } } function read_str($str) { $tokens = tokenize($str); if (count($tokens) === 0) { throw new BlankException(); } return read_form(new Reader($tokens)); } ?> ================================================ FILE: impls/php/readline.php ================================================ ================================================ FILE: impls/php/run ================================================ #!/usr/bin/env bash exec php $(dirname $0)/${STEP:-stepA_mal}.php "${@}" ================================================ FILE: impls/php/step0_repl.php ================================================ "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } while (true); ?> ================================================ FILE: impls/php/step1_read_print.php ================================================ "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step2_eval.php ================================================ value]; } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); return call_user_func_array($f, $args); } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = array(); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } $repl_env['+'] = function ($a, $b) { return intval($a + $b,10); }; $repl_env['-'] = function ($a, $b) { return intval($a - $b,10); }; $repl_env['*'] = function ($a, $b) { return intval($a * $b,10); }; $repl_env['/'] = function ($a, $b) { return intval($a / $b,10); }; // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step3_env.php ================================================ find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } return MAL_EVAL($ast[2], $let_env); default: $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); return call_user_func_array($f, $args); } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } $repl_env->set(_symbol('+'), function ($a, $b) { return intval($a + $b,10); }); $repl_env->set(_symbol('-'), function ($a, $b) { return intval($a - $b,10); }); $repl_env->set(_symbol('*'), function ($a, $b) { return intval($a * $b,10); }); $repl_env->set(_symbol('/'), function ($a, $b) { return intval($a / $b,10); }); // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step4_if_fn_do.php ================================================ find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } return MAL_EVAL($ast[2], $let_env); case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } return MAL_EVAL($ast[count($ast)-1], $env); case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { return MAL_EVAL($ast[3], $env); } else { return NULL; } } else { return MAL_EVAL($ast[2], $env); } case "fn*": return function() use ($env, $ast) { $fn_env = new Env($env, $ast[1], func_get_args()); return MAL_EVAL($ast[2], $fn_env); }; default: $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); return call_user_func_array($f, $args); } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step5_tco.php ================================================ find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step6_file.php ================================================ find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } $repl_env->set(_symbol('eval'), _function(function($ast) { global $repl_env; return MAL_EVAL($ast, $repl_env); })); $_argv = _list(); for ($i=2; $i < count($argv); $i++) { $_argv->append($argv[$i]); } $repl_env->set(_symbol('*ARGV*'), $_argv); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); exit(0); } // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step7_quote.php ================================================ 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 (_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 (!_list_Q($ast)) { return $ast; } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; } else { return qq_foldr($ast); } } function MAL_EVAL($ast, $env) { while (true) { $dbgenv = $env->find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } if ($ast->count() === 0) { return $ast; } // apply list $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $el = []; foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } $repl_env->set(_symbol('eval'), _function(function($ast) { global $repl_env; return MAL_EVAL($ast, $repl_env); })); $_argv = _list(); for ($i=2; $i < count($argv); $i++) { $_argv->append($argv[$i]); } $repl_env->set(_symbol('*ARGV*'), $_argv); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); exit(0); } // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step8_macros.php ================================================ 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 (_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 (!_list_Q($ast)) { return $ast; } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; } else { return qq_foldr($ast); } } function MAL_EVAL($ast, $env) { while (true) { $dbgenv = $env->find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } // apply list if ($ast->count() === 0) { return $ast; } $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) case "defmacro!": $func = MAL_EVAL($ast[2], $env); $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $f = MAL_EVAL($a0, $env); $unevaluated_args = array_slice($ast->getArrayCopy(), 1); if ($f->ismacro) { $ast = $f->apply($unevaluated_args); break; // Continue loop (TCO) } $args = []; foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } $repl_env->set(_symbol('eval'), _function(function($ast) { global $repl_env; return MAL_EVAL($ast, $repl_env); })); $_argv = _list(); for ($i=2; $i < count($argv); $i++) { $_argv->append($argv[$i]); } $repl_env->set(_symbol('*ARGV*'), $_argv); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); exit(0); } // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/step9_try.php ================================================ 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 (_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 (!_list_Q($ast)) { return $ast; } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; } else { return qq_foldr($ast); } } function MAL_EVAL($ast, $env) { while (true) { $dbgenv = $env->find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } // apply list if ($ast->count() === 0) { return $ast; } $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) case "defmacro!": $func = MAL_EVAL($ast[2], $env); $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); case "try*": $a1 = $ast[1]; $a2 = $ast[2]; if ($a2[0]->value === "catch*") { try { return MAL_EVAL($a1, $env); } catch (_Error $e) { $catch_env = new Env($env, array($a2[1]), array($e->obj)); return MAL_EVAL($a2[2], $catch_env); } catch (Exception $e) { $catch_env = new Env($env, array($a2[1]), array($e->getMessage())); return MAL_EVAL($a2[2], $catch_env); } } else { return MAL_EVAL($a1, $env); } case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $f = MAL_EVAL($a0, $env); $unevaluated_args = array_slice($ast->getArrayCopy(), 1); if ($f->ismacro) { $ast = $f->apply($unevaluated_args); break; // Continue loop (TCO) } $args = []; foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } $repl_env->set(_symbol('eval'), _function(function($ast) { global $repl_env; return MAL_EVAL($ast, $repl_env); })); $_argv = _list(); for ($i=2; $i < count($argv); $i++) { $_argv->append($argv[$i]); } $repl_env->set(_symbol('*ARGV*'), $_argv); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); exit(0); } // repl loop do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (_Error $e) { echo "Error: " . _pr_str($e->obj, True) . "\n"; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/stepA_mal.php ================================================ 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 (_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 (!_list_Q($ast)) { return $ast; } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; } else { return qq_foldr($ast); } } function MAL_EVAL($ast, $env) { while (true) { $dbgenv = $env->find("DEBUG-EVAL"); if ($dbgenv) { $dbgeval = $env->get("DEBUG-EVAL"); if ($dbgeval !== NULL && $dbgeval !== false) { echo "EVAL: " . _pr_str($ast) . "\n"; } } if (_symbol_Q($ast)) { return $env->get($ast->value); } elseif (_vector_Q($ast)) { $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; } elseif (!_list_Q($ast)) { return $ast; } // apply list if ($ast->count() === 0) { return $ast; } $a0 = $ast[0]; $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i=0; $i < count($a1); $i+=2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) case "defmacro!": $func = MAL_EVAL($ast[2], $env); $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); case "php*": $res = eval($ast[1]); return _to_mal($res); case "try*": $a1 = $ast[1]; $a2 = $ast[2]; if ($a2[0]->value === "catch*") { try { return MAL_EVAL($a1, $env); } catch (_Error $e) { $catch_env = new Env($env, array($a2[1]), array($e->obj)); return MAL_EVAL($a2[2], $catch_env); } catch (Exception $e) { $catch_env = new Env($env, array($a2[1]), array($e->getMessage())); return MAL_EVAL($a2[2], $catch_env); } } else { return MAL_EVAL($a1, $env); } case "do": foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); case "to-native": return _to_native($ast[1]->value, $env); default: $f = MAL_EVAL($a0, $env); $unevaluated_args = array_slice($ast->getArrayCopy(), 1); if ($f->ismacro) { $ast = $f->apply($unevaluated_args); break; // Continue loop (TCO) } $args = []; foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } } // print function MAL_PRINT($exp) { return _pr_str($exp, True); } // repl $repl_env = new Env(NULL); function rep($str) { global $repl_env; return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } // core.php: defined using PHP foreach ($core_ns as $k=>$v) { $repl_env->set(_symbol($k), _function($v)); } $repl_env->set(_symbol('eval'), _function(function($ast) { global $repl_env; return MAL_EVAL($ast, $repl_env); })); $_argv = _list(); if (isset($argv)) { for ($i=2; $i < count($argv); $i++) { $_argv->append($argv[$i]); } } $repl_env->set(_symbol('*ARGV*'), $_argv); // core.mal: defined using the language itself rep("(def! *host-language* \"php\")"); rep("(def! not (fn* (a) (if a false true)))"); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); // run mal file if (count($argv) > 1) { rep('(load-file "' . $argv[1] . '")'); exit(0); } // repl loop rep("(println (str \"Mal [\" *host-language* \"]\"))"); do { try { $line = mal_readline("user> "); if ($line === NULL) { break; } if ($line !== "") { print(rep($line) . "\n"); } } catch (BlankException $e) { continue; } catch (_Error $e) { echo "Error: " . _pr_str($e->obj, True) . "\n"; } catch (Exception $e) { echo "Error: " . $e->getMessage() . "\n"; echo $e->getTraceAsString() . "\n"; } } while (true); ?> ================================================ FILE: impls/php/tests/step5_tco.mal ================================================ ;; PHP: skipping non-TCO recursion ;; Reason: completes at 10,000, unrecoverable segfault at 20,000 ================================================ FILE: impls/php/tests/stepA_mal.mal ================================================ ;; Testing basic php interop (php* "return 7;") ;=>7 (php* "return '7';") ;=>"7" (php* "return array(7,8,9);") ;=>(7 8 9) (php* "return array(\"abc\" => 789);") ;=>{"abc" 789} (php* "print \"hello\n\";") ;/hello ;=>nil (php* "global $foo; $foo=8;") (php* "global $foo; return $foo;") ;=>8 (php* "global $f; $f = function($v) { return 1+$v; };") (php* "global $f; return array_map($f, array(1,2,3));") ;=>(2 3 4) ;; testing native function calling (php/date "Y-m-d" 0) ;=>"1970-01-01" ;; testing native function with mal callback (php/array_map (fn* [t] (if (> t 3) t)) [1 2 3 4 5 6]) ;=>(nil nil nil 4 5 6) ;; testing superglobal variable access (get php/_SERVER "PHP_SELF") ;=>"../php/stepA_mal.php" ;; testing PHP constants access php/FILE_APPEND ;=>8 ================================================ FILE: impls/php/types.php ================================================ obj = $obj; } } // General functions function _equal_Q($a, $b) { $ota = gettype($a) === "object" ? get_class($a) : gettype($a); $otb = gettype($b) === "object" ? get_class($b) : gettype($b); if (!($ota === $otb or (_sequential_Q($a) and _sequential_Q($b)))) { return false; } elseif (_symbol_Q($a)) { #print "ota: $ota, otb: $otb\n"; return $a->value === $b->value; } elseif (_list_Q($a) or _vector_Q($a)) { if ($a->count() !== $b->count()) { return false; } for ($i=0; $i<$a->count(); $i++) { if (!_equal_Q($a[$i], $b[$i])) { return false; } } return true; } elseif (_hash_map_Q($a)) { if ($a->count() !== $b->count()) { return false; } $hm1 = $a->getArrayCopy(); $hm2 = $b->getArrayCopy(); foreach (array_keys($hm1) as $k) { if (!_equal_Q($hm1[$k], $hm2[$k])) { return false; } } return true; } else { return $a === $b; } } function _sequential_Q($seq) { return _list_Q($seq) or _vector_Q($seq); } // Scalars function _nil_Q($obj) { return $obj === NULL; } function _true_Q($obj) { return $obj === true; } function _false_Q($obj) { return $obj === false; } function _string_Q($obj) { return is_string($obj) && strpos($obj, chr(0x7f)) !== 0; } function _number_Q($obj) { return is_int($obj); } // Symbols class SymbolClass { public $value = NULL; public $meta = NULL; public function __construct($value) { $this->value = $value; } } function _symbol($name) { return new SymbolClass($name); } function _symbol_Q($obj) { return ($obj instanceof SymbolClass); } // Keywords function _keyword($name) { if (_keyword_Q($name)) { return $name; } else { return chr(0x7f).$name; } } function _keyword_Q($obj) { return is_string($obj) && strpos($obj, chr(0x7f)) === 0; } // Functions class FunctionClass { public $func = NULL; public $type = 'native'; // 'native' or 'platform' public $meta = NULL; public $ast = NULL; public $env = NULL; public $params = NULL; public $ismacro = False; public function __construct($func, $type, $ast, $env, $params, $ismacro=False) { $this->func = $func; $this->type = $type; $this->ast = $ast; #print_r($ast); $this->env = $env; $this->params = $params; $this->ismacro = $ismacro; } public function __invoke() { $args = func_get_args(); if ($this->type === 'native') { $fn_env = new Env($this->env, $this->params, $args); $evalf = $this->func; return $evalf($this->ast, $fn_env); } else { return call_user_func_array($this->func, $args); } } public function gen_env($args) { return new Env($this->env, $this->params, $args); } public function apply($args) { return call_user_func_array(array(&$this, '__invoke'),$args); } } function _function($func, $type='platform', $ast=NULL, $env=NULL, $params=NULL, $ismacro=False) { return new FunctionClass($func, $type, $ast, $env, $params, $ismacro); } function _function_Q($obj) { return $obj instanceof FunctionClass; } function _fn_Q($obj) { return $obj instanceof Closure; } // Parent class of list, vector // http://www.php.net/manual/en/class.arrayobject.php class SeqClass extends ArrayObject { public function slice($start, $length=NULL) { $sc = new $this(); if ($start >= count($this)) { $arr = array(); } else { $arr = array_slice($this->getArrayCopy(), $start, $length); } $sc->exchangeArray($arr); return $sc; } } // Lists class ListClass extends SeqClass { public $meta = NULL; } function _list() { $v = new ListClass(); $v->exchangeArray(func_get_args()); return $v; } function _list_Q($obj) { return $obj instanceof ListClass; } // Vectors class VectorClass extends SeqClass { public $meta = NULL; } function _vector() { $v = new VectorClass(); $v->exchangeArray(func_get_args()); return $v; } function _vector_Q($obj) { return $obj instanceof VectorClass; } // Hash Maps class HashMapClass extends ArrayObject { public $meta = NULL; } function _hash_map() { $args = func_get_args(); if (count($args) % 2 === 1) { throw new Exception("Odd number of hash map arguments"); } $hm = new HashMapClass(); array_unshift($args, $hm); return call_user_func_array('_assoc_BANG', $args); } function _hash_map_Q($obj) { return $obj instanceof HashMapClass; } function _assoc_BANG($hm) { $args = func_get_args(); if (count($args) % 2 !== 1) { throw new Exception("Odd number of assoc arguments"); } for ($i=1; $ioffsetExists($ktoken)) { unset($hm[$ktoken]); } } return $hm; } // Atoms class Atom { public $value = NULL; public $meta = NULL; public function __construct($value) { $this->value = $value; } } function _atom($val) { return new Atom($val); } function _atom_Q($atm) { return $atm instanceof Atom; } ?> ================================================ FILE: impls/php/webrunner.php ================================================ ================================================ FILE: impls/picolisp/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # picolisp RUN apt-get -y install picolisp libreadline-dev ================================================ FILE: impls/picolisp/Makefile ================================================ all: clean: ================================================ FILE: impls/picolisp/core.l ================================================ (de MAL-= (A B) (let (A* (MAL-type A) B* (MAL-type B)) (cond ((and (= A* 'map) (= B* 'map)) (MAL-map-= (MAL-value A) (MAL-value B)) ) ((and (memq A* '(list vector)) (memq B* '(list vector))) (MAL-seq-= (MAL-value A) (MAL-value B)) ) ((= A* B*) (= (MAL-value A) (MAL-value B)) ) (T NIL) ) ) ) (de MAL-map-= (As Bs) (when (= (length As) (length Bs)) (let (As* (chunk As) Bs* (chunk Bs)) (catch 'result (while As* (let (A (pop 'As*) Key (MAL-value (car A)) Val (cdr A) B (find '((X) (= Key (MAL-value (car X)))) Bs*) ) (when (or (not B) (not (MAL-= Val (cdr B)))) (throw 'result NIL) ) ) ) T ) ) ) ) (de MAL-seq-= (As Bs) (when (= (length As) (length Bs)) (catch 'result (while As (ifn (MAL-= (pop 'As) (pop 'Bs)) (throw 'result NIL) ) ) T ) ) ) (de MAL-seq? (X) (memq (MAL-type X) '(list vector)) ) (de MAL-f (X) (MAL-value (if (isa '+Func X) (get X 'fn) X)) ) (de MAL-swap! @ (let (X (next) Fn (next) Args (rest)) (put X 'value (apply (MAL-f Fn) Args (MAL-value X))) ) ) (de MAL-nth (Seq N) (let (Seq* (MAL-value Seq) N* (MAL-value N)) (if (< N* (length Seq*)) (nth Seq* (inc N*) 1) (throw 'err (MAL-error (MAL-string "out of bounds"))) ) ) ) (de chunk (List) (make (for (L List L (cddr L)) (link (cons (car L) (cadr L))) ) ) ) (de join (List) (mapcan '((X) (list (car X) (cdr X))) List) ) (de MAL-assoc @ (let (Map (next) Args (rest)) (MAL-map (append Args (join (filter '((X) (not (find '((Y) (MAL-= (car Y) (car X))) (chunk Args) ) ) ) (chunk (MAL-value Map)) ) ) ) ) ) ) (de MAL-dissoc @ (let (Map (next) Args (rest)) (MAL-map (make (for (L (MAL-value Map) L (cddr L)) (unless (find '((X) (MAL-= (car L) X)) Args) (link (car L) (cadr L)) ) ) ) ) ) ) (de MAL-seq (X) (if (or (= (MAL-type X) 'nil) (not (MAL-value X))) *MAL-nil (case (MAL-type X) (list X) (vector (MAL-list (MAL-value X))) (string (MAL-list (mapcar MAL-string (chop (MAL-value X))))) ) ) ) (de MAL-conj @ (let (Seq (next) Args (rest)) (if (= (MAL-type Seq) 'vector) (MAL-vector (append (MAL-value Seq) Args)) (MAL-list (append (reverse Args) (MAL-value Seq))) ) ) ) (de clone (X) (let X* (new (val X)) (maps '((C) (put X* (cdr C) (car C))) X) X* ) ) (de pil-to-mal (X) (cond ((not X) *MAL-nil) ((=T X) *MAL-true) ((num? X) (MAL-number X)) ((str? X) (MAL-string X)) ((sym? X) (MAL-symbol X)) ((lst? X) (MAL-list (mapcar pil-to-mal X))) (T (MAL-string (sym X))) ) ) (def '*Ns '((+ . `(MAL-fn '((A B) (MAL-number (+ (MAL-value A) (MAL-value B)))))) (- . `(MAL-fn '((A B) (MAL-number (- (MAL-value A) (MAL-value B)))))) (* . `(MAL-fn '((A B) (MAL-number (* (MAL-value A) (MAL-value B)))))) (/ . `(MAL-fn '((A B) (MAL-number (/ (MAL-value A) (MAL-value B)))))) (< . `(MAL-fn '((A B) (if (< (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) (<= . `(MAL-fn '((A B) (if (<= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) (> . `(MAL-fn '((A B) (if (> (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) (>= . `(MAL-fn '((A B) (if (>= (MAL-value A) (MAL-value B)) *MAL-true *MAL-false)))) (= . `(MAL-fn '((A B) (if (MAL-= A B) *MAL-true *MAL-false)))) (list . `(MAL-fn '(@ (MAL-list (rest))))) (list? . `(MAL-fn '((X) (if (= (MAL-type X) 'list) *MAL-true *MAL-false)))) (empty? . `(MAL-fn '((X) (if (and (MAL-seq? X) (not (MAL-value X))) *MAL-true *MAL-false)))) (count . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-number (length (MAL-value X))) (MAL-number 0))))) (pr-str . `(MAL-fn '(@ (MAL-string (glue " " (mapcar '((X) (pr-str X T)) (rest))))))) (str . `(MAL-fn '(@ (MAL-string (pack (mapcar pr-str (rest))))))) (prn . `(MAL-fn '(@ (prinl (glue " " (mapcar '((X) (pr-str X T)) (rest)))) *MAL-nil))) (println . `(MAL-fn '(@ (prinl (glue " " (mapcar pr-str (rest)))) *MAL-nil))) (read-string . `(MAL-fn '((X) (read-str (MAL-value X))))) (slurp . `(MAL-fn '((X) (MAL-string (in (MAL-value X) (till NIL T)))))) (atom . `(MAL-fn '((X) (MAL-atom X)))) (atom? . `(MAL-fn '((X) (if (= (MAL-type X) 'atom) *MAL-true *MAL-false)))) (deref . `(MAL-fn '((X) (MAL-value X)))) (reset! . `(MAL-fn '((X Value) (put X 'value Value)))) (swap! . `(MAL-fn MAL-swap!)) (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)))) (rest . `(MAL-fn '((X) (if (MAL-seq? X) (MAL-list (cdr (MAL-value X))) (MAL-list NIL))))) (throw . `(MAL-fn '((X) (throw 'err (MAL-error X))))) (apply . `(MAL-fn '(@ (let (Fn (next) X (rest)) (apply (MAL-f Fn) (append (head -1 X) (MAL-value (last X)))))))) (map . `(MAL-fn '((Fn Seq) (MAL-list (mapcar (MAL-f Fn) (MAL-value Seq)))))) (nil? . `(MAL-fn '((X) (if (= (MAL-type X) 'nil) *MAL-true *MAL-false)))) (true? . `(MAL-fn '((X) (if (= (MAL-type X) 'true) *MAL-true *MAL-false)))) (false? . `(MAL-fn '((X) (if (= (MAL-type X) 'false) *MAL-true *MAL-false)))) (number? . `(MAL-fn '((X) (if (= (MAL-type X) 'number) *MAL-true *MAL-false)))) (symbol? . `(MAL-fn '((X) (if (= (MAL-type X) 'symbol) *MAL-true *MAL-false)))) (keyword? . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) *MAL-true *MAL-false)))) (string? . `(MAL-fn '((X) (if (= (MAL-type X) 'string) *MAL-true *MAL-false)))) (vector? . `(MAL-fn '((X) (if (= (MAL-type X) 'vector) *MAL-true *MAL-false)))) (map? . `(MAL-fn '((X) (if (= (MAL-type X) 'map) *MAL-true *MAL-false)))) (sequential? . `(MAL-fn '((X) (if (MAL-seq? X) *MAL-true *MAL-false)))) (fn? . `(MAL-fn '((X) (if (or (= (MAL-type X) 'fn) (and (= (MAL-type X) 'func) (not (get X 'is-macro)))) *MAL-true *MAL-false)))) (macro? . `(MAL-fn '((X) (if (and (= (MAL-type X) 'func) (get X 'is-macro)) *MAL-true *MAL-false)))) (symbol . `(MAL-fn '((Name) (MAL-symbol (MAL-value Name))))) (keyword . `(MAL-fn '((X) (if (= (MAL-type X) 'keyword) X (MAL-keyword (MAL-value X)))))) (vector . `(MAL-fn '(@ (MAL-vector (rest))))) (hash-map . `(MAL-fn '(@ (MAL-map (rest))))) (assoc . `(MAL-fn MAL-assoc)) (dissoc . `(MAL-fn MAL-dissoc)) (get . `(MAL-fn '((Map Key) (or (and (<> (MAL-type Map) 'nil) (cdr (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))))) *MAL-nil)))) (contains? . `(MAL-fn '((Map Key) (if (find '((X) (MAL-= (car X) Key)) (chunk (MAL-value Map))) *MAL-true *MAL-false)))) (keys . `(MAL-fn '((Map) (MAL-list (mapcar car (chunk (MAL-value Map))))))) (vals . `(MAL-fn '((Map) (MAL-list (extract cdr (chunk (MAL-value Map))))))) (with-meta . `(MAL-fn '((X Meta) (let X* (clone X) (put X* 'meta Meta) X*)))) (meta . `(MAL-fn '((X) (or (MAL-meta X) *MAL-nil)))) (readline . `(MAL-fn '((Prompt) (let Output (readline (MAL-value Prompt)) (if (=0 Output) NIL (MAL-string Output)))))) (time-ms . `(MAL-fn '(() (MAL-number (/ (usec) 1000))))) (conj . `(MAL-fn MAL-conj)) (seq . `(MAL-fn MAL-seq)) (pil-eval . `(MAL-fn '((Input) (pil-to-mal (run (str (MAL-value Input))))))) ) ) ================================================ FILE: impls/picolisp/env.l ================================================ (class +Env) # data outer (dm T (Outer Binds Exprs) (=: data (new)) (=: outer Outer) (for (Binds Binds Binds) (if (<> (car Binds) '&) (set> This (pop 'Binds) (pop 'Exprs)) (pop 'Binds) (set> This (pop 'Binds) (MAL-list Exprs)) ) ) ) (de MAL-env (Outer Binds Exprs) (new '(+Env) Outer Binds Exprs) ) (dm set> (Key Value) (put (: data) Key Value) ) (dm get> (Key) (or (get (: data) Key) (and (: outer) (get> @ Key)) ) ) ================================================ FILE: impls/picolisp/func.l ================================================ (class +Func) # env ast params fn (dm T (Env Ast Params Fn) (=: type 'func) # HACK (=: env Env) (=: ast Ast) (=: params Params) (=: fn Fn) ) (de MAL-func (Env Ast Params Fn) (new '(+Func) Env Ast Params Fn) ) (de MAL-macro (MalFn) (let (env (get MalFn 'env) ast (get MalFn 'ast) params (get MalFn 'params) fn (get MalFn 'fn) clone (MAL-func env ast params fn)) (put clone 'is-macro T) clone)) ================================================ FILE: impls/picolisp/printer.l ================================================ (de pr-str (Ast PrintReadably) (let Value (MAL-value Ast) (case (MAL-type Ast) ((true false nil) (sym @) ) (string (if PrintReadably (repr Value) Value)) (keyword (pack ":" Value)) ((number symbol) Value) (fn "#") (func "#") (list (pr-list Value PrintReadably "(" ")")) (vector (pr-list Value PrintReadably "[" "]")) (map (pr-list Value PrintReadably "{" "}")) (atom (pack "(atom " (pr-str Value PrintReadably) ")")) (T (pretty Value) (throw 'err (MAL-error (MAL-string "[pr-str] unimplemented type")))) ) ) ) (de repr (X) (let Chars (chop X) (if (not X) "\"\"" (setq Chars (replace Chars "\\" "\\\\")) (setq Chars (replace Chars "\"" "\\\"")) (setq Chars (replace Chars "\n" "\\n")) (pack "\"" Chars "\"") ) ) ) (de pr-list (Forms PrintReadably Starter Ender) (let Values (mapcar '((Form) (pr-str Form PrintReadably)) Forms) (pack Starter (glue " " Values) Ender) ) ) ================================================ FILE: impls/picolisp/reader.l ================================================ (class +Reader) # tokens (dm T (Tokens) (=: tokens Tokens) ) (dm next> () (pop (:: tokens)) ) (dm peek> () (car (: tokens)) ) (de read-str (String) (let (Tokens (tokenizer String) Reader (new '(+Reader) Tokens) ) (read-form Reader) ) ) (de tokenizer (String) # [\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*) (let (Special " []{}()'\"`,;" ) (make (for (Chars (chop String) Chars) (let Char (pop 'Chars) (cond ((or (sp? Char) (= Char ",")) # do nothing, whitespace ) ((and (= Char "~") (= (car Chars) "@")) (link "~@") (pop 'Chars) ) # remove @ token ((index Char (chop "[]{}()'`~^\@")) (link Char) ) ((= Char "\"") (link (pack (make (link Char) # HACK (use Done (while (and Chars (not Done)) (let Char (pop 'Chars) (cond ((= Char "\\") (if Chars (let Char (pop 'Chars) (if (= Char "n") (link "\n") (link Char) ) ) (throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) ) ((<> Char "\"") (link Char) ) ((= Char "\"") (setq Done T) ) ) ) ) (unless Done (throw 'err (MAL-error (MAL-string "expected '\"', got EOF"))) ) ) ) ) ) ) ((= Char ";") (while (and Chars (<> Char "\n")) (setq Char (pop 'Chars)) ) ) ((and (not (index Char (chop Special))) (not (sp? Char))) (link (pack (make (link Char) (let Char (car Chars) (while (and Chars (not (index Char (chop Special))) (not (sp? Char))) (link (pop 'Chars)) (setq Char (car Chars)) ) ) ) ) ) ) ) ) ) ) ) ) (de read-form (Reader) (case (peek> Reader) ("'" (read-macro Reader 'quote)) ("`" (read-macro Reader 'quasiquote)) ("~" (read-macro Reader 'unquote)) ("~@" (read-macro Reader 'splice-unquote)) ("@" (read-macro Reader 'deref)) ("\^" (read-meta Reader)) ("(" (read-list Reader 'list ")")) ("[" (read-list Reader 'vector "]")) ("{" (read-list Reader 'map "}")) (T (read-atom Reader)) ) ) (de read-macro (Reader symbol) (next> Reader) # pop reader macro token (MAL-list (list (MAL-symbol symbol) (read-form Reader))) ) (de read-meta (Reader) (next> Reader) # pop reader macro token (let Form (read-form Reader) (MAL-list (list (MAL-symbol 'with-meta) (read-form Reader) Form) ) ) ) (de read-list (Reader Type Ender) (next> Reader) # pop list start (new (list (case Type (list '+MALList) (vector '+MALVector) (map '+MALMap) ) ) (make (use Done (while (not Done) (let Token (peek> Reader) (cond ((= Token Ender) (next> Reader) # pop list end (setq Done T) ) ((not Token) (let Msg (pack "expected '" Ender "', got EOF") (throw 'err (MAL-error (MAL-string Msg))) ) ) (T (link (read-form Reader))) ) ) ) ) ) ) ) (de read-atom (Reader) (let (Token (next> Reader) Chars (chop Token)) (cond ((= Token "true") *MAL-true) ((= Token "false") *MAL-false) ((= Token "nil") *MAL-nil) ((format Token) (MAL-number @) ) ((= (car Chars) "\"") (MAL-string (pack (cdr Chars))) ) ((= (car Chars) ":") (MAL-keyword (intern (pack (cdr Chars)))) ) ((not Token) (throw 'err (MAL-error (MAL-string "end of token stream"))) ) (T (MAL-symbol (intern Token))) ) ) ) ================================================ FILE: impls/picolisp/readline.l ================================================ (de load-history (File) (when (info File) (in File (until (eof) (native "libreadline.so" "add_history" NIL (line T)) ) ) ) ) (de save-to-history (Input) (when Input (native "libreadline.so" "add_history" NIL Input) (out "+.mal_history" (prinl Input) ) ) ) (de readline (Prompt) (let Input (native "libreadline.so" "readline" 'N Prompt) (if (=0 Input) 0 (prog1 (struct Input 'S) (save-to-history @) ) ) ) ) ================================================ FILE: impls/picolisp/run ================================================ #!/usr/bin/env bash exec pil $(dirname $0)/${STEP:-stepA_mal}.l - "${@}" ================================================ FILE: impls/picolisp/step0_repl.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (de READ (String) String) (de EVAL (Ast) Ast) (de PRINT (Ast) Ast) (de rep (String) (PRINT (EVAL (READ String))) ) (load-history ".mal_history") (use Eof (until Eof (let Input (readline "user> ") (if (=0 Input) (setq Eof T) (prinl (rep Input)) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step1_read_print.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (de READ (String) (read-str String) ) (de EVAL (Ast) Ast) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String))) ) (load-history ".mal_history") (use Eof (until Eof (let Input (readline "user> ") (if (=0 Input) (setq Eof T) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step2_eval.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (de READ (String) (read-str String) ) (def '*ReplEnv '((+ . ((A B) (MAL-number (+ (MAL-value A) (MAL-value B))))) (- . ((A B) (MAL-number (- (MAL-value A) (MAL-value B))))) (* . ((A B) (MAL-number (* (MAL-value A) (MAL-value B))))) (/ . ((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) ) ) (de EVAL (Ast Env) ;; (prinl "EVAL: " (pr-str Ast T)) (let Value (MAL-value Ast) (case (MAL-type Ast) (symbol (if (assoc Value Env) (cdr @) (throw 'err (MAL-error (MAL-string (pack "'" Value "' not found")))) ) ) (list (if Value (let El (mapcar '((Form) (EVAL Form Env)) Value) (apply (car El) (cdr El))) Ast)) (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) (T Ast) ) ) ) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (load-history ".mal_history") (use Eof (until Eof (let Input (readline "user> ") (if (=0 Input) (setq Eof T) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step3_env.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (set> *ReplEnv '+ '((A B) (MAL-number (+ (MAL-value A) (MAL-value B))))) (set> *ReplEnv '- '((A B) (MAL-number (- (MAL-value A) (MAL-value B))))) (set> *ReplEnv '* '((A B) (MAL-number (* (MAL-value A) (MAL-value B))))) (set> *ReplEnv '/ '((A B) (MAL-number (/ (MAL-value A) (MAL-value B))))) (de EVAL (Ast Env) (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1* (MAL-value (cadr Ast*)) A2 (caddr Ast*)) (cond ((not Ast*) Ast) ((= A0* 'def!) (set> Env A1* (EVAL A2 Env)) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*)) (set> Env* Key Value) ) ) (EVAL A2 Env*) ) ) (T (let Value (mapcar '((Form) (EVAL Form Env)) Ast*) (apply (car Value) (cdr Value)) ) ) ) ) ) (symbol (let (Key (MAL-value Ast)) (or (get> Env Key) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) (map (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) (T Ast))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (load-history ".mal_history") (use Eof (until Eof (let Input (readline "user> ") (if (=0 Input) (setq Eof T) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step4_if_fn_do.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (de EVAL (Ast Env) (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) Ast) ((= A0* 'def!) (set> Env A1* (EVAL A2 Env)) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*)) (set> Env* Key Value) ) ) (EVAL A2 Env*) ) ) ((= A0* 'do) (for Form (cdr Ast*) (EVAL Form Env) ) ) ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (EVAL A2 Env) (if A3 (EVAL A3 Env) *MAL-nil ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2) (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) ) (T (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) Fn (MAL-value (car Ast*)) Args (cdr Ast*)) (apply Fn Args) ) ) ) ) ) (symbol (let (Key (MAL-value Ast)) (or (get> Env Key) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) (map (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast)))) (T Ast))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (load-history ".mal_history") (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step5_tco.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (de EVAL (Ast Env) (catch 'done (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) Fn (car Ast*) Args (cdr Ast*) ) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (load-history ".mal_history") (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step6_file.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (de EVAL (Ast Env) (catch 'done (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) Fn (car Ast*) Args (cdr Ast*) ) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (load-history ".mal_history") (if (argv) (rep (pack "(load-file \"" (car (argv)) "\")")) (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step7_quote.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (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) (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 (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Ast* (mapcar '((Form) (EVAL Form Env)) Ast*) Fn (car Ast*) Args (cdr Ast*) ) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (load-history ".mal_history") (if (argv) (rep (pack "(load-file \"" (car (argv)) "\")")) (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step8_macros.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (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) (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 (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Fn (EVAL (car Ast*) Env)) (if (get Fn 'is-macro) (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (load-history ".mal_history") (if (argv) (rep (pack "(load-file \"" (car (argv)) "\")")) (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/step9_try.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (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) (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 (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) (let A (MAL-value A2) (if (and (= (MAL-type A2) 'list) (= (MAL-value (car A)) 'catch*) ) (let (Bind (MAL-value (cadr A)) Exc (MAL-value Result) Form (caddr A) Env* (MAL-env Env (list Bind) (list Exc)) ) (throw 'done (EVAL Form Env*)) ) (throw 'err Result) ) ) (throw 'done Result) ) ) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Fn (EVAL (car Ast*) Env)) (if (get Fn 'is-macro) (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (load-history ".mal_history") (if (argv) (rep (pack "(load-file \"" (car (argv)) "\")")) (use Input (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/stepA_mal.l ================================================ (de load-relative (Path) (load (pack (car (file)) Path)) ) (load-relative "readline.l") (load-relative "types.l") (load-relative "reader.l") (load-relative "printer.l") (load-relative "env.l") (load-relative "func.l") (load-relative "core.l") (de READ (String) (read-str String) ) (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) (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) (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 (while t (when (and (get> Env 'DEBUG-EVAL) (not (memq (MAL-type @) '(nil false)))) (prinl "EVAL: " (pr-str Ast T))) (case (MAL-type Ast) (list (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) A1* (MAL-value A1) A2 (caddr Ast*) A3 (cadddr Ast*) ) (cond ((not Ast*) (throw 'done Ast)) ((= A0* 'def!) (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) (let A (MAL-value A2) (if (and (= (MAL-type A2) 'list) (= (MAL-value (car A)) 'catch*) ) (let (Bind (MAL-value (cadr A)) Exc (MAL-value Result) Form (caddr A) Env* (MAL-env Env (list Bind) (list Exc)) ) (throw 'done (EVAL Form Env*)) ) (throw 'err Result) ) ) (throw 'done Result) ) ) ) ((= A0* 'let*) (let Env* (MAL-env Env) (for (Bindings A1* Bindings) (let (Key (MAL-value (pop 'Bindings)) Value (EVAL (pop 'Bindings) Env*) ) (set> Env* Key Value) ) ) (setq Env Env* Ast A2) ) ) # TCO ((= A0* 'do) (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) (setq Ast (last Ast*)) ) # TCO ((= A0* 'if) (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) (setq Ast A2) # TCO (if A3 (setq Ast A3) # TCO (throw 'done *MAL-nil) ) ) ) ((= A0* 'fn*) (let (Binds (mapcar MAL-value A1*) Body A2 Fn (MAL-fn (curry (Env Binds Body) @ (let Env* (MAL-env Env Binds (rest)) (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T (let (Fn (EVAL (car Ast*) Env)) (if (get Fn 'is-macro) (setq Ast (apply (MAL-value (get Fn 'fn)) (cdr Ast*))) # TCO (let Args (mapcar '((Form) (EVAL Form Env)) (cdr Ast*)) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) (symbol (let (Key (MAL-value Ast) Value (get> Env Key)) (if Value (throw 'done Value) (throw 'err (MAL-error (MAL-string (pack "'" Key "' not found"))))))) (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) (T (throw 'done Ast)))))) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) (set> *ReplEnv '*host-language* (MAL-string "pil")) (de PRINT (Ast) (pr-str Ast T) ) (de rep (String) (PRINT (EVAL (READ String) *ReplEnv)) ) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (load-history ".mal_history") (if (argv) (rep (pack "(load-file \"" (car (argv)) "\")")) (use Input (rep "(println (str \"Mal [\" *host-language* \"]\"))") (until (=0 (setq Input (readline "user> "))) (let Output (catch 'err (rep Input)) (if (isa '+MALError Output) (let Message (MAL-value Output) (unless (= (MAL-value Message) "end of token stream") (prinl "[error] " (pr-str Message)) ) ) (prinl Output) ) ) ) ) ) (prinl) (bye) ================================================ FILE: impls/picolisp/tests/step5_tco.mal ================================================ ;; PIL: skipping non-TCO recursion ;; Reason: segfault (unrecoverable) ================================================ FILE: impls/picolisp/tests/stepA_mal.mal ================================================ ;; Testing basic pil interop (pil-eval "T") ;=>true (pil-eval "NIL") ;=>nil (pil-eval "(+ 1 1)") ;=>2 (pil-eval "(cons 1 2 3 NIL)") ;=>(1 2 3) (pil-eval "(use (@A @O) (match '(@A and @O) '(Alpha and Omega)) (prinl @A) (prinl @O))") Alpha Omega ================================================ FILE: impls/picolisp/types.l ================================================ (class +MAL) # type value meta (dm T (Type Value Meta) (=: type Type) (=: value Value) (=: meta Meta) ) (de MAL-type (MAL) (get MAL 'type) ) (de MAL-value (MAL) (get MAL 'value) ) (de MAL-meta (MAL) (get MAL 'meta) ) (class +MALTrue +MAL) (dm T () (super 'true 'true NIL) ) (class +MALFalse +MAL) (dm T () (super 'false 'false NIL) ) (class +MALNil +MAL) (dm T () (super 'nil 'nil NIL) ) (def '*MAL-true (new '(+MALTrue))) (def '*MAL-false (new '(+MALFalse))) (def '*MAL-nil (new '(+MALNil))) (class +MALNumber +MAL) (dm T (Number) (super 'number Number NIL) ) (de MAL-number (N) (new '(+MALNumber) N) ) (class +MALString +MAL) (dm T (String) (super 'string String NIL) ) (de MAL-string (N) (new '(+MALString) N) ) (class +MALSymbol +MAL) (dm T (String) (super 'symbol String NIL) ) (de MAL-symbol (N) (new '(+MALSymbol) N) ) (class +MALKeyword +MAL) (dm T (String) (super 'keyword String NIL) ) (de MAL-keyword (N) (new '(+MALKeyword) N) ) (class +MALList +MAL) (dm T (Values) (super 'list Values NIL) ) (de MAL-list (N) (new '(+MALList) N) ) (class +MALVector +MAL) (dm T (Values) (super 'vector Values NIL) ) (de MAL-vector (N) (new '(+MALVector) N) ) (class +MALMap +MAL) (dm T (Values) (super 'map Values NIL) ) (de MAL-map (N) (new '(+MALMap) N) ) (class +MALAtom +MAL) (dm T (Value) (super 'atom Value NIL) ) (de MAL-atom (N) (new '(+MALAtom) N) ) (class +MALFn +MAL) (dm T (Fn) (super 'fn Fn NIL) ) (de MAL-fn (Fn) (new '(+MALFn) Fn) ) (class +MALError +MAL) (dm T (Value) (super 'error Value NIL) ) (de MAL-error (Value) (new '(+MALError) Value) ) ================================================ FILE: impls/pike/Core.pmod ================================================ import .Interop; import .Printer; import .Reader; import .Readline; import .Types; private Val apply(mixed f, Val ... args) { if(sizeof(args) == 1) return f(@args[0].data); array(Val) mid_args = args[0..(sizeof(args) - 2)]; return f(@(mid_args + args[-1].data)); } private Val swap_bang(Val atom, mixed f, Val ... args) { atom.data = f(@(({ atom.data }) + args)); return atom.data; } private mapping(string:function) builtins = ([ "=": lambda(Val a, Val b) { return to_bool(a == b); }, "throw": lambda(Val a) { throw(a); }, "nil?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_NIL); }, "true?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_TRUE); }, "false?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_FALSE); }, "string?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_STRING); }, "symbol": lambda(Val a) { return a.mal_type == MALTYPE_SYMBOL ? a : Symbol(a.value); }, "symbol?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_SYMBOL); }, "keyword": lambda(Val a) { return a.mal_type == MALTYPE_KEYWORD ? a : Keyword(a.value); }, "keyword?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_KEYWORD); }, "number?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_NUMBER); }, "fn?": lambda(Val a) { return to_bool(a.is_fn && !a.macro); }, "macro?": lambda(Val a) { return to_bool(a.macro); }, "pr-str": lambda(Val ... a) { return String(map(a, lambda(Val e) { return pr_str(e, true); }) * " "); }, "str": lambda(Val ... a) { return String(map(a, lambda(Val e) { return pr_str(e, false); }) * ""); }, "prn": lambda(Val ... a) { write(({ map(a, lambda(Val e) { return pr_str(e, true); }) * " ", "\n" })); return MAL_NIL; }, "println": lambda(Val ... a) { write(({ map(a, lambda(Val e) { return pr_str(e, false); }) * " ", "\n" })); return MAL_NIL; }, "read-string": lambda(Val a) { return read_str(a.value); }, "readline": lambda(Val a) { string line = readline(a.value); return line ? String(line) : MAL_NIL; }, "slurp": lambda(Val a) { return String(Stdio.read_file(a.value)); }, "<": lambda(Val a, Val b) { return to_bool(a.value < b.value); }, "<=": lambda(Val a, Val b) { return to_bool(a.value <= b.value); }, ">": lambda(Val a, Val b) { return to_bool(a.value > b.value); }, ">=": lambda(Val a, Val b) { return to_bool(a.value >= b.value); }, "+": lambda(Val a, Val b) { return Number(a.value + b.value); }, "-": lambda(Val a, Val b) { return Number(a.value - b.value); }, "*": lambda(Val a, Val b) { return Number(a.value * b.value); }, "/": lambda(Val a, Val b) { return Number(a.value / b.value); }, "time-ms": lambda() { array(int) t = System.gettimeofday(); return Number(t[0] * 1000 + t[1] / 1000); }, "list": lambda(Val ... a) { return List(a); }, "list?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_LIST); }, "vector": lambda(Val ... a) { return Vector(a); }, "vector?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_VECTOR); }, "hash-map": lambda(Val ... a) { return Map(a); }, "map?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_MAP); }, "assoc": lambda(Val a, Val ... b) { return a.assoc(b); }, "dissoc": lambda(Val a, Val ... b) { return a.dissoc(b); }, "get": lambda(Val a, Val b) { return a.mal_type != MALTYPE_NIL ? (a.data[b] || MAL_NIL) : MAL_NIL; }, "contains?": lambda(Val a, Val b) { return to_bool(a.data[b]); }, "keys": lambda(Val a) { return List(indices(a.data)); }, "vals": lambda(Val a) { return List(values(a.data)); }, "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(); }, "empty?": lambda(Val a) { return to_bool(a.emptyp()); }, "count": lambda(Val a) { return Number(a.count()); }, "apply": apply, "map": lambda(mixed f, Val a) { return List(map(a.data, f)); }, "conj": lambda(Val a, Val ... b) { return a.conj(b); }, "seq": lambda(Val a) { return a.seq(); }, "meta": lambda(Val a) { return a.meta || MAL_NIL; }, "with-meta": lambda(Val a, Val b) { Val new_a = a.clone(); new_a.meta = b; return new_a; }, "atom": lambda(Val a) { return Atom(a); }, "atom?": lambda(Val a) { return to_bool(a.mal_type == MALTYPE_ATOM); }, "deref": lambda(Val a) { return a.data; }, "reset!": lambda(Val a, Val b) { a.data = b; return a.data; }, "swap!": swap_bang, "pike-eval": lambda(Val a) { return pike_eval(a.value); }, ]); mapping(Val:Val) NS() { mapping(Val:Val) ns = ([ ]); foreach(builtins; string name; function f) { ns[Symbol(name)] = BuiltinFn(name, f); } return ns; } ================================================ FILE: impls/pike/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install pike8.0 ================================================ FILE: impls/pike/Env.pmod ================================================ import .Types; class Env { Env outer; mapping(string:Val) data; void create(Env the_outer, List|void binds, List|void exprs) { outer = the_outer; data = ([ ]); if(binds) { for(int i = 0; i < binds.count(); i++) { if(binds.data[i].value == "&") { set(binds.data[i + 1], List(exprs.data[i..])); break; } set(binds.data[i], exprs.data[i]); } } } Val set(Val key, Val val) { data[key.value] = val; return val; } Val get(string key) { Val res = data[key]; if(res) return res; if(outer) return outer.get(key); return 0; } } ================================================ FILE: impls/pike/Interop.pmod ================================================ import .Types; Val pike_eval(string expr_str) { program prog = compile_string("mixed tmp_func() { return (" + expr_str + "); }", "pike-eval"); mixed v = prog()->tmp_func(); return pike2mal(v); } private Val pike2mal(mixed v) { if(stringp(v)) return String(v); if(intp(v)) return Number(v); if(arrayp(v)) { array(Val) res = ({ }); foreach(v, mixed e) { res += ({ pike2mal(e) }); } return List(res); } if(mappingp(v)) { array(Val) res = ({ }); foreach(v; mixed k; mixed v) { res += ({ pike2mal(k), pike2mal(v) }); } return Map(res); } return MAL_NIL; } ================================================ FILE: impls/pike/Makefile ================================================ SOURCES_BASE = readline.pike types.pike reader.pike printer.pike SOURCES_LISP = env.pike core.pike stepA_mal.pike SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.pike mal mal.pike: $(SOURCES) cat $+ | grep -v "^#include" > $@ mal: mal.pike echo "#!/usr/bin/env pike" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.pike mal ================================================ FILE: impls/pike/Printer.pmod ================================================ import .Types; string pr_str(Val ast, bool print_readably) { if(functionp(ast)) return "#"; return ast->to_string(print_readably); } ================================================ FILE: impls/pike/Reader.pmod ================================================ import .Types; Regexp.PCRE tokenizer_regexp = Regexp.PCRE.Studied("[\\s ,]*(~@|[\\[\\]{}()'`~@]|\"([\\\\].|[^\\\\\"])*\"?|;.*|[^\\s \\[\\]{}()'\"`~@,;]*)"); Regexp.PCRE string_regexp = Regexp.PCRE.Studied("^\"(?:[\\\\].|[^\\\\\"])*\"$"); Regexp.PCRE number_regexp = Regexp.PCRE.Studied("^-?[0-9]+$"); private class Reader(private array(string) tokens, private void|int position) { string next() { if(position >= sizeof(tokens)) return 0; string token = tokens[position]; position++; return token; } string peek() { if(position >= sizeof(tokens)) return 0; return tokens[position]; } } private array(string) tokenize(string str) { array(string) tokens = ({ }); tokenizer_regexp.matchall(str, lambda(mixed m) { if(sizeof(m[1]) > 0 && m[1][0] != ';') tokens += ({ m[1] }); }); return tokens; } private string unescape_string(string token) { if(!string_regexp.match(token)) throw("expected '\"', got EOF"); string s = token[1..(sizeof(token) - 2)]; s = replace(s, "\\\\", "\u029e"); s = replace(s, "\\\"", "\""); s = replace(s, "\\n", "\n"); s = replace(s, "\u029e", "\\"); return s; } private Val read_atom(Reader reader) { string token = reader->next(); if(number_regexp.match(token)) return Number((int)token); if(token[0] == '"') return String(unescape_string(token)); if(token[0] == ':') return Keyword(token[1..]); switch(token) { case "nil": return MAL_NIL; case "true": return MAL_TRUE; case "false": return MAL_FALSE; } return Symbol(token); } private array(Val) read_seq(Reader reader, string start, string end) { string token = reader->next(); if(token != start) throw("expected '" + start + "'"); token = reader->peek(); array(Val) elements = ({ }); while(token != end) { if(!token) throw("expected '" + end + "', got EOF"); elements += ({ read_form(reader) }); token = reader->peek(); } reader->next(); return elements; } private Val reader_macro(Reader reader, string symbol) { reader->next(); return List(({ Symbol(symbol), read_form(reader) })); } private Val read_form(Reader reader) { string token = reader->peek(); switch(token) { case "'": return reader_macro(reader, "quote"); case "`": return reader_macro(reader, "quasiquote"); case "~": return reader_macro(reader, "unquote"); case "~@": return reader_macro(reader, "splice-unquote"); case "@": return reader_macro(reader, "deref"); case "^": reader->next(); Val meta = read_form(reader); return List(({ Symbol("with-meta"), read_form(reader), meta })); case "(": return List(read_seq(reader, "(", ")")); case ")": throw("unexpected ')'"); case "[": return Vector(read_seq(reader, "[", "]")); case "]": throw("unexpected ']'"); case "{": return Map(read_seq(reader, "{", "}")); case "}": throw("unexpected '}'"); default: return read_atom(reader); } } Val read_str(string str) { array(string) tokens = tokenize(str); if(sizeof(tokens) == 0) return MAL_NIL; return read_form(Reader(tokens)); } ================================================ FILE: impls/pike/Readline.pmod ================================================ string readline(string prompt) { write(prompt); return Stdio.stdin->gets(); } ================================================ FILE: impls/pike/Types.pmod ================================================ enum MalType { MALTYPE_UNDEFINED, MALTYPE_NIL, MALTYPE_TRUE, MALTYPE_FALSE, MALTYPE_NUMBER, MALTYPE_SYMBOL, MALTYPE_STRING, MALTYPE_KEYWORD, MALTYPE_LIST, MALTYPE_VECTOR, MALTYPE_MAP, MALTYPE_FN, MALTYPE_BUILTINFN, MALTYPE_ATOM, }; class Val { constant mal_type = MALTYPE_UNDEFINED; Val meta; string to_string(bool print_readably); Val clone(); bool `==(mixed other) { return objectp(other) && other.mal_type == mal_type; } } class Nil { inherit Val; constant mal_type = MALTYPE_NIL; string to_string(bool print_readably) { return "nil"; } int count() { return 0; } Val first() { return MAL_NIL; } Val rest() { return List(({ })); } Val clone() { return this_object(); } Val seq() { return MAL_NIL; } } Nil MAL_NIL = Nil(); class True { inherit Val; constant mal_type = MALTYPE_TRUE; string to_string(bool print_readably) { return "true"; } Val clone() { return this_object(); } } True MAL_TRUE = True(); class False { inherit Val; constant mal_type = MALTYPE_FALSE; string to_string(bool print_readably) { return "false"; } Val clone() { return this_object(); } } False MAL_FALSE = False(); Val to_bool(bool b) { if(b) return MAL_TRUE; return MAL_FALSE; } class Number(int value) { constant mal_type = MALTYPE_NUMBER; inherit Val; string to_string(bool print_readably) { return (string)value; } bool `==(mixed other) { return ::`==(other) && other.value == value; } Val clone() { return this_object(); } } class Symbol(string value) { constant mal_type = MALTYPE_SYMBOL; inherit Val; string to_string(bool print_readably) { return value; } bool `==(mixed other) { return ::`==(other) && other.value == value; } int __hash() { return hash((string)mal_type) ^ hash(value); } Val clone() { return Symbol(value); } } class String(string value) { constant mal_type = MALTYPE_STRING; inherit Val; string to_string(bool print_readably) { if(print_readably) { string s = replace(value, "\\", "\\\\"); s = replace(s, "\"", "\\\""); s = replace(s, "\n", "\\n"); return "\"" + s + "\""; } return value; } bool `==(mixed other) { return ::`==(other) && other.value == value; } int __hash() { return hash((string)mal_type) ^ hash(value); } Val clone() { return String(value); } Val seq() { if(sizeof(value) == 0) return MAL_NIL; array(Val) parts = ({ }); for(int i = 0; i < sizeof(value); i++) { parts += ({ String(value[i..i]) }); } return List(parts); } } class Keyword(string value) { constant mal_type = MALTYPE_KEYWORD; inherit Val; string to_string(bool print_readably) { return ":" + value; } bool `==(mixed other) { return ::`==(other) && other.value == value; } int __hash() { return hash((string)mal_type) ^ hash(value); } Val clone() { return Keyword(value); } } class Sequence(array(Val) data) { inherit Val; constant is_sequence = true; string to_string(bool print_readably) { return map(data, lambda(Val e) { return e.to_string(print_readably); }) * " "; } bool emptyp() { return sizeof(data) == 0; } int count() { return sizeof(data); } Val nth(int index) { if(index >= count()) throw("nth: index out of range"); return data[index]; } Val first() { if(emptyp()) return MAL_NIL; return data[0]; } Val rest() { return List(data[1..]); } bool `==(mixed other) { if(!objectp(other)) return 0; if(!other.is_sequence) return 0; if(other.count() != count()) return 0; for(int i = 0; i < count(); i++) { if(other.data[i] != data[i]) return 0; } return 1; } Val seq() { if(emptyp()) return MAL_NIL; return List(data); } } class List { inherit Sequence; constant mal_type = MALTYPE_LIST; string to_string(bool print_readably) { return "(" + ::to_string(print_readably) + ")"; } Val clone() { return List(data); } Val conj(array(Val) other) { return List(reverse(other) + data); } } class Vector { inherit Sequence; constant mal_type = MALTYPE_VECTOR; string to_string(bool print_readably) { return "[" + ::to_string(print_readably) + "]"; } Val clone() { return Vector(data); } Val conj(array(Val) other) { return Vector(data + other); } } class Map { inherit Val; constant mal_type = MALTYPE_MAP; mapping(Val:Val) data; void create(array(Val) list) { array(Val) keys = Array.everynth(list, 2, 0); array(Val) vals = Array.everynth(list, 2, 1); data = mkmapping(keys, vals); } string to_string(bool print_readably) { array(string) strs = ({ }); foreach(data; Val k; Val v) { strs += ({ k.to_string(print_readably), v.to_string(print_readably) }); } return "{" + (strs * " ") + "}"; } int count() { return sizeof(data); } bool `==(mixed other) { if(!::`==(other)) return 0; if(other.count() != count()) return 0; foreach(data; Val k; Val v) { if(other.data[k] != v) return 0; } return 1; } Val assoc(array(Val) list) { array(Val) keys = Array.everynth(list, 2, 0); array(Val) vals = Array.everynth(list, 2, 1); Map result = Map(({ })); result.data = copy_value(data); for(int i = 0; i < sizeof(keys); i++) { result.data[keys[i]] = vals[i]; } return result; } Val dissoc(array(Val) list) { Map result = Map(({ })); result.data = copy_value(data); foreach(list, Val key) m_delete(result.data, key); return result; } Val clone() { Map m = Map(({ })); m.data = data; return m; } } class Fn(Val ast, Val params, .Env.Env env, function func, void|bool macro) { inherit Val; constant mal_type = MALTYPE_FN; constant is_fn = true; void set_macro() { macro = true; } string to_string(bool print_readably) { string tag = macro ? "Macro" : "Fn"; return "#<" + tag + " params=" + params.to_string(true) + ">"; } mixed `()(mixed ... args) { return func(@args); } Val clone() { return Fn(ast, params, env, func); } Val clone_as_macro() { return Fn(ast, params, env, func, true); } } class BuiltinFn(string name, function func) { inherit Val; constant mal_type = MALTYPE_BUILTINFN; constant is_fn = true; string to_string(bool print_readably) { return "#"; } mixed `()(mixed ... args) { return func(@args); } Val clone() { return BuiltinFn(name, func); } } class Atom(Val data) { inherit Val; constant mal_type = MALTYPE_ATOM; string to_string(bool print_readably) { return "(atom " + data.to_string(print_readably) + ")"; } Val clone() { return Atom(data); } } ================================================ FILE: impls/pike/run ================================================ #!/usr/bin/env bash exec pike $(dirname $0)/${STEP:-stepA_mal}.pike "${@}" ================================================ FILE: impls/pike/step0_repl.pike ================================================ import .Readline; string READ(string str) { return str; } string EVAL(string ast, string env) { return ast; } string PRINT(string exp) { return exp; } string rep(string str) { return PRINT(EVAL(READ(str), "")); } int main() { while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; write(({ rep(line), "\n" })); } write("\n"); return 0; } ================================================ FILE: impls/pike/step1_read_print.pike ================================================ import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, string env) { return ast; } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str) { return PRINT(EVAL(READ(str), "")); } int main() { while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step2_eval.pike ================================================ import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, mapping(string:function) env) { // write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: function f = env[ast.value]; if(!f) throw("'" + ast.value + "' not found"); return f; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); return f(@args); } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, mapping(string:function) env) { return PRINT(EVAL(READ(str), env)); } int main() { mapping(string:function) repl_env = ([ "+": lambda(Val a, Val b) { return Number(a.value + b.value); }, "-": lambda(Val a, Val b) { return Number(a.value - b.value); }, "*": lambda(Val a, Val b) { return Number(a.value * b.value); }, "/": lambda(Val a, Val b) { return Number(a.value / b.value); } ]); while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step3_env.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, Env env) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } return EVAL(ast.data[2], let_env); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); return f(@args); } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main() { Env repl_env = Env(0); repl_env.set(Symbol("+"), lambda(Val a, Val b) { return Number(a.value + b.value); }); repl_env.set(Symbol("-"), lambda(Val a, Val b) { return Number(a.value - b.value); }); repl_env.set(Symbol("*"), lambda(Val a, Val b) { return Number(a.value * b.value); }); repl_env.set(Symbol("/"), lambda(Val a, Val b) { return Number(a.value / b.value); }); while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step4_if_fn_do.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, Env env) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } return EVAL(ast.data[2], let_env); case "do": Val result; foreach(ast.data[1..], Val element) { result = EVAL(element, env); } return result; case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) return EVAL(ast.data[3], env); else return MAL_NIL; } else return EVAL(ast.data[2], env); case "fn*": return lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }; } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); return f(@args); } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main() { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); rep("(def! not (fn* (a) (if a false true)))", repl_env); while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step5_tco.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@args); case MALTYPE_FN: ast = f.ast; env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main() { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); rep("(def! not (fn* (a) (if a false true)))", repl_env); while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step6_file.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@args); case MALTYPE_FN: ast = f.ast; env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main(int argc, array argv) { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); rep("(def! not (fn* (a) (if a false true)))", repl_env); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if(argc >= 2) { rep("(load-file \"" + argv[1] + "\")", repl_env); return 0; } while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step7_quote.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } bool starts_with(Val ast, string sym) { 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) { switch(ast.mal_type) { 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; } } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "quote": return ast.data[1]; case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; args = map(args, lambda(Val e) { return EVAL(e, env);}); switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@args); case MALTYPE_FN: ast = f.ast; env = Env(f.env, f.params, List(args)); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main(int argc, array argv) { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); rep("(def! not (fn* (a) (if a false true)))", repl_env); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); if(argc >= 2) { rep("(load-file \"" + argv[1] + "\")", repl_env); return 0; } while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step8_macros.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } bool starts_with(Val ast, string sym) { 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) { switch(ast.mal_type) { 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; } } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "quote": return ast.data[1]; case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "defmacro!": Val macro = EVAL(ast.data[2], env).clone_as_macro(); return env.set(ast.data[1], macro); case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@map(args, lambda(Val e) { return EVAL(e, env);})); case MALTYPE_FN: if(f.macro) { ast = f(@args); continue; // TCO } ast = f.ast; env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main(int argc, array argv) { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); rep("(def! not (fn* (a) (if a false true)))", repl_env); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if(argc >= 2) { rep("(load-file \"" + argv[1] + "\")", repl_env); return 0; } while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) err = err[0]; write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/step9_try.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } bool starts_with(Val ast, string sym) { 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) { switch(ast.mal_type) { 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; } } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "quote": return ast.data[1]; case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "defmacro!": Val macro = EVAL(ast.data[2], env).clone_as_macro(); return env.set(ast.data[1], macro); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) { Val err_val; if(objectp(err)) err_val = err; else if(stringp(err)) err_val = String(err); else if(arrayp(err)) err_val = String(err[0]); Val catch_clause = ast.data[2]; Env catch_env = Env(env); catch_env.set(catch_clause.data[1], err_val); return EVAL(catch_clause.data[2], catch_env); } case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@map(args, lambda(Val e) { return EVAL(e, env);})); case MALTYPE_FN: if(f.macro) { ast = f(@args); continue; // TCO } ast = f.ast; env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main(int argc, array argv) { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); rep("(def! not (fn* (a) (if a false true)))", repl_env); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if(argc >= 2) { rep("(load-file \"" + argv[1] + "\")", repl_env); return 0; } while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(objectp(err)) { err = err.to_string(true); } else if(arrayp(err)) { err = err[0]; } write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/stepA_mal.pike ================================================ import .Env; import .Printer; import .Reader; import .Readline; import .Types; Val READ(string str) { return read_str(str); } bool starts_with(Val ast, string sym) { 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) { switch(ast.mal_type) { 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; } } Val EVAL(Val ast, Env env) { while(true) { Val dbgeval = env.get("DEBUG-EVAL"); if(dbgeval && dbgeval.mal_type != MALTYPE_FALSE && dbgeval.mal_type != MALTYPE_NIL) write(({ "EVAL: ", PRINT(ast), "\n" })); switch(ast.mal_type) { case MALTYPE_SYMBOL: Val key = ast.value; Val val = env.get(ast.value); if(!val) throw("'" + key + "' not found"); return val; case MALTYPE_LIST: break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: array(Val) elements = ({ }); foreach(ast.data; Val k; Val v) { elements += ({ k, EVAL(v, env) }); } return Map(elements); default: return ast; } if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) { case "def!": return env.set(ast.data[1], EVAL(ast.data[2], env)); case "let*": Env let_env = Env(env); Val ast1 = ast.data[1]; for(int i = 0; i < sizeof(ast1.data); i += 2) { let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env)); } env = let_env; ast = ast.data[2]; continue; // TCO case "quote": return ast.data[1]; case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "defmacro!": Val macro = EVAL(ast.data[2], env).clone_as_macro(); return env.set(ast.data[1], macro); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) { Val err_val; if(objectp(err)) err_val = err; else if(stringp(err)) err_val = String(err); else if(arrayp(err)) err_val = String(err[0]); Val catch_clause = ast.data[2]; Env catch_env = Env(env); catch_env.set(catch_clause.data[1], err_val); return EVAL(catch_clause.data[2], catch_env); } case "do": Val result; foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element) { result = EVAL(element, env); } ast = ast.data[-1]; continue; // TCO case "if": Val cond = EVAL(ast.data[1], env); if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL) { if(sizeof(ast.data) > 3) ast = ast.data[3]; else return MAL_NIL; } else ast = ast.data[2]; continue; // TCO case "fn*": return Fn(ast.data[2], ast.data[1], env, lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } Val f = EVAL(ast.data[0], env); array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: return f(@map(args, lambda(Val e) { return EVAL(e, env);})); case MALTYPE_FN: if(f.macro) { ast = f(@args); continue; // TCO } ast = f.ast; env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); } } } string PRINT(Val exp) { return pr_str(exp, true); } string rep(string str, Env env) { return PRINT(EVAL(READ(str), env)); } int main(int argc, array argv) { Env repl_env = Env(0); foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v); repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); })); repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String))); rep("(def! *host-language* \"pike\")", repl_env); rep("(def! not (fn* (a) (if a false true)))", repl_env); rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); 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)))))))", repl_env); if(argc >= 2) { rep("(load-file \"" + argv[1] + "\")", repl_env); return 0; } rep("(println (str \"Mal [\" \*host-language\* \"]\"))", repl_env); while(1) { string line = readline("user> "); if(!line) break; if(strlen(line) == 0) continue; if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } ) { if(arrayp(err)) { err = err[0]; } else if(objectp(err)) { err = err.to_string(true); } write(({ "Error: ", err, "\n" })); } } write("\n"); return 0; } ================================================ FILE: impls/pike/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/pike/tests/stepA_mal.mal ================================================ ;; Testing basic Pike interop ;;; pike-eval compiles the given string inside a temporary function after a ;;; "return " keyword. To evaluate complex statements, you may use an anonymous ;;; lambda and call it immediately (see the last example). (pike-eval "7") ;=>7 (pike-eval "'A'") ;=>65 (pike-eval "\"7\"") ;=>"7" (pike-eval "({ 7,8,9 })") ;=>(7 8 9) (pike-eval "([ \"abc\": 789 ])") ;=>{"abc" 789} (pike-eval "write(\"hello\\n\")") ;/hello ;=>6 (pike-eval "map(({ \"a\", \"b\", \"c\" }), lambda(string x) { return \"X\" + x + \"Y\"; }) * \" \"") ;=>"XaY XbY XcY" (pike-eval "map(({ 1,2,3 }), lambda(int x) { return 1 + x; })") ;=>(2 3 4) (pike-eval "throw(upper_case(\"aaa\" + \"bbb\"))") ;/Error: AAABBB (pike-eval "(lambda() { int a = 5; int b = a * 3; return a + b; })()") ;=>20 ================================================ FILE: impls/plpgsql/Dockerfile ================================================ FROM ubuntu:14.04 RUN apt-get -y update RUN apt-get -y install make cpp python RUN apt-get -y install curl RUN useradd -u 1000 -m -s /bin/bash -G sudo postgres ENV PG_VERSION=9.4 RUN curl https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add - && \ echo 'deb http://apt.postgresql.org/pub/repos/apt/ trusty-pgdg main' > /etc/apt/sources.list.d/pgdg.list && \ apt-get update && \ DEBIAN_FRONTEND=noninteractive apt-get -y install acl \ postgresql-${PG_VERSION} postgresql-client-${PG_VERSION} postgresql-contrib-${PG_VERSION} && \ mkdir -p /var/run/postgresql/9.4-main.pg_stat_tmp/ && \ chown -R postgres.postgres /var/run/postgresql ENV HOME=/var/run/postgresql WORKDIR /mal # Travis runs as a couple of different users so add them RUN useradd -ou 1001 -m -s /bin/bash -G sudo,postgres travis RUN useradd -ou 2000 -m -s /bin/bash -G sudo,postgres travis2 # Enable postgres and travis users to sudo for postgres startup RUN echo "%sudo ALL=(ALL:ALL) NOPASSWD: ALL" >> /etc/sudoers # Allow both travis and postgres user to connect to DB as 'postgres' RUN sed -i 's/peer$/peer map=mal/' /etc/postgresql/9.4/main/pg_hba.conf RUN echo "mal postgres postgres" >> /etc/postgresql/9.4/main/pg_ident.conf RUN echo "mal travis postgres" >> /etc/postgresql/9.4/main/pg_ident.conf RUN echo "mal travis2 postgres" >> /etc/postgresql/9.4/main/pg_ident.conf # Add entrypoint.sh which starts postgres then run bash/command ADD entrypoint.sh /entrypoint.sh ENTRYPOINT ["/entrypoint.sh"] ================================================ FILE: impls/plpgsql/Makefile ================================================ all: clean: ================================================ FILE: impls/plpgsql/core.sql ================================================ CREATE SCHEMA core; -- general functions CREATE FUNCTION core.equal(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._equal_Q(args[1], args[2])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.throw(args integer[]) RETURNS integer AS $$ BEGIN -- TODO: Only throws strings. Without subtransactions, all changes -- to DB up to this point get rolled back so the object being -- thrown dissapears. RAISE EXCEPTION '%', printer.pr_str(args[1], false); END; $$ LANGUAGE plpgsql; -- scalar functions CREATE FUNCTION core.nil_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._nil_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.true_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._true_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.false_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._false_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.number_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._number_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.string_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._string_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.symbol(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._symbolv(types._valueToString(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.symbol_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._symbol_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.keyword(args integer[]) RETURNS integer AS $$ BEGIN IF types._keyword_Q(args[1]) THEN RETURN args[1]; ELSE RETURN types._keywordv(types._valueToString(args[1])); END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.keyword_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._keyword_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.fn_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._fn_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.macro_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._macro_Q(args[1])); END; $$ LANGUAGE plpgsql; -- string functions CREATE FUNCTION core.pr_str(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._stringv(printer.pr_str_array(args, ' ', true)); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.str(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._stringv(printer.pr_str_array(args, '', false)); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.prn(args integer[]) RETURNS integer AS $$ BEGIN PERFORM io.writeline(printer.pr_str_array(args, ' ', true)); RETURN 0; -- nil END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.println(args integer[]) RETURNS integer AS $$ BEGIN PERFORM io.writeline(printer.pr_str_array(args, ' ', false)); RETURN 0; -- nil END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.read_string(args integer[]) RETURNS integer AS $$ BEGIN RETURN reader.read_str(types._valueToString(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.readline(args integer[]) RETURNS integer AS $$ DECLARE input varchar; BEGIN input := io.readline(types._valueToString(args[1])); IF input IS NULL THEN RETURN 0; -- nil END IF; RETURN types._stringv(rtrim(input, E'\n')); END; $$ LANGUAGE plpgsql; -- See: -- http://shuber.io/reading-from-the-filesystem-with-postgres/ CREATE FUNCTION core.slurp(args integer[]) RETURNS integer AS $$ DECLARE fname varchar; tmp varchar; cmd varchar; lines varchar[]; content varchar; BEGIN fname := types._valueToString(args[1]); IF fname NOT LIKE '/%' THEN fname := types._valueToString(envs.get(0, '*PWD*')) || '/' || fname; END IF; tmp := CAST(round(random()*1000000) AS varchar); EXECUTE format('CREATE TEMP TABLE %I (content text)', tmp); cmd := format('sed ''s/\\/\\\\/g'' %L', fname); EXECUTE format('COPY %I FROM PROGRAM %L', tmp, cmd); EXECUTE format('SELECT ARRAY(SELECT content FROM %I)', tmp) INTO lines; EXECUTE format('DROP TABLE %I', tmp); content := array_to_string(lines, E'\n') || E'\n'; RETURN types._stringv(content); END; $$ LANGUAGE plpgsql; -- number functions -- integer comparison CREATE FUNCTION core.intcmp(op varchar, args integer[]) RETURNS integer AS $$ DECLARE a bigint; b bigint; result boolean; BEGIN SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; EXECUTE format('SELECT $1 %s $2;', op) INTO result USING a, b; RETURN types._wraptf(result); END; $$ LANGUAGE plpgsql; -- integer operation CREATE FUNCTION core.intop(op varchar, args integer[]) RETURNS integer AS $$ DECLARE a bigint; b bigint; result bigint; BEGIN SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; EXECUTE format('SELECT $1 %s $2;', op) INTO result USING a, b; RETURN types._numToValue(result); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.lt(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intcmp('<', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.lte(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intcmp('<=', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.gt(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intcmp('>', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.gte(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intcmp('>=', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.add(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intop('+', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.subtract(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intop('-', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.multiply(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intop('*', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.divide(args integer[]) RETURNS integer AS $$ BEGIN RETURN core.intop('/', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.time_ms(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._numToValue( CAST(date_part('epoch', clock_timestamp()) * 1000 AS bigint)); END; $$ LANGUAGE plpgsql; -- collection functions CREATE FUNCTION core.list(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._list(args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.list_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._list_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.vector(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._vector(args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.vector_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._vector_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.hash_map(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._hash_map(args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.map_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._hash_map_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.assoc(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._assoc_BANG(types._clone(args[1]), args[2:array_length(args, 1)]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.dissoc(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._dissoc_BANG(types._clone(args[1]), args[2:array_length(args, 1)]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.get(args integer[]) RETURNS integer AS $$ DECLARE result integer; BEGIN IF types._type(args[1]) = 0 THEN -- nil RETURN 0; ELSE result := types._get(args[1], types._valueToString(args[2])); IF result IS NULL THEN RETURN 0; END IF; RETURN result; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.contains_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._contains_Q(args[1], types._valueToString(args[2]))); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.keys(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._list(types._keys(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.vals(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._list(types._vals(args[1])); END; $$ LANGUAGE plpgsql; -- sequence functions CREATE FUNCTION core.sequential_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._sequential_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.cons(args integer[]) RETURNS integer AS $$ DECLARE lst integer[]; BEGIN lst := array_prepend(args[1], types._valueToArray(args[2])); RETURN types._list(lst); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.concat(args integer[]) RETURNS integer AS $$ DECLARE lst integer; result integer[] = ARRAY[]::integer[]; BEGIN FOREACH lst IN ARRAY args LOOP result := array_cat(result, types._valueToArray(lst)); END LOOP; 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; BEGIN SELECT val_int INTO idx FROM types.value WHERE value_id = args[2]; IF idx >= types._count(args[1]) THEN RAISE EXCEPTION 'nth: index out of range'; END IF; RETURN types._nth(args[1], idx); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.first(args integer[]) RETURNS integer AS $$ BEGIN IF types._nil_Q(args[1]) THEN RETURN 0; -- nil ELSIF types._count(args[1]) = 0 THEN RETURN 0; -- nil ELSE RETURN types._first(args[1]); END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.rest(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._rest(args[1]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.empty_Q(args integer[]) RETURNS integer AS $$ BEGIN IF types._sequential_Q(args[1]) AND types._count(args[1]) = 0 THEN RETURN 2; ELSE RETURN 1; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.count(args integer[]) RETURNS integer AS $$ BEGIN IF types._sequential_Q(args[1]) THEN RETURN types._numToValue(types._count(args[1])); ELSIF types._nil_Q(args[1]) THEN RETURN types._numToValue(0); ELSE RAISE EXCEPTION 'count called on non-sequence'; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.apply(args integer[]) RETURNS integer AS $$ DECLARE alen integer; fargs integer[]; BEGIN alen := array_length(args, 1); fargs := array_cat(args[2:alen-1], types._valueToArray(args[alen])); RETURN types._apply(args[1], fargs); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.map(args integer[]) RETURNS integer AS $$ DECLARE x integer; result integer[]; BEGIN FOREACH x IN ARRAY types._valueToArray(args[2]) LOOP result := array_append(result, types._apply(args[1], ARRAY[x])); END LOOP; return types._list(result); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.conj(args integer[]) RETURNS integer AS $$ DECLARE type integer; BEGIN type := types._type(args[1]); CASE WHEN type = 8 THEN -- list RETURN types._list(array_cat( types.array_reverse(args[2:array_length(args, 1)]), types._valueToArray(args[1]))); WHEN type = 9 THEN -- vector RETURN types._vector(array_cat( types._valueToArray(args[1]), args[2:array_length(args, 1)])); ELSE RAISE EXCEPTION 'conj: called on non-sequence'; END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.seq(args integer[]) RETURNS integer AS $$ DECLARE type integer; vid integer; str varchar; chr varchar; seq integer[]; BEGIN type := types._type(args[1]); CASE WHEN type = 8 THEN -- list IF types._count(args[1]) = 0 THEN RETURN 0; END IF; -- nil RETURN args[1]; WHEN type = 9 THEN -- vector IF types._count(args[1]) = 0 THEN RETURN 0; END IF; -- nil -- clone and modify to a list vid := types._clone(args[1]); UPDATE types.value SET type_id = 8 WHERE value_id = vid; RETURN vid; WHEN type = 5 THEN -- string str := types._valueToString(args[1]); IF char_length(str) = 0 THEN RETURN 0; END IF; -- nil FOREACH chr IN ARRAY regexp_split_to_array(str, '') LOOP seq := array_append(seq, types._stringv(chr)); END LOOP; RETURN types._list(seq); WHEN type = 0 THEN -- nil RETURN 0; -- nil ELSE RAISE EXCEPTION 'seq: called on non-sequence'; END CASE; END; $$ LANGUAGE plpgsql; -- meta functions CREATE FUNCTION core.meta(args integer[]) RETURNS integer AS $$ DECLARE m integer; BEGIN SELECT meta_id INTO m FROM types.value WHERE value_id = args[1]; IF m IS NULL THEN RETURN 0; ELSE RETURN m; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.with_meta(args integer[]) RETURNS integer AS $$ DECLARE vid integer; BEGIN vid := types._clone(args[1]); UPDATE types.value SET meta_id = args[2] WHERE value_id = vid; RETURN vid; END; $$ LANGUAGE plpgsql; -- atom functions CREATE FUNCTION core.atom(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._atom(args[1]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.atom_Q(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._wraptf(types._atom_Q(args[1])); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.deref(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._deref(args[1]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.reset_BANG(args integer[]) RETURNS integer AS $$ BEGIN RETURN types._reset_BANG(args[1], args[2]); END; $$ LANGUAGE plpgsql; CREATE FUNCTION core.swap_BANG(args integer[]) RETURNS integer AS $$ DECLARE atm integer; fargs integer[]; BEGIN atm := args[1]; fargs := array_cat(ARRAY[types._deref(atm)], args[3:array_length(args, 1)]); RETURN types._reset_BANG(atm, types._apply(args[2], fargs)); END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- repl_env is environment 0 INSERT INTO envs.env (env_id, outer_id, data) VALUES (0, NULL, hstore(ARRAY[ '=', types._function('core.equal'), 'throw', types._function('core.throw'), 'nil?', types._function('core.nil_Q'), 'true?', types._function('core.true_Q'), 'false?', types._function('core.false_Q'), 'number?', types._function('core.number_Q'), 'string?', types._function('core.string_Q'), 'symbol', types._function('core.symbol'), 'symbol?', types._function('core.symbol_Q'), 'keyword', types._function('core.keyword'), 'keyword?', types._function('core.keyword_Q'), 'fn?', types._function('core.fn_Q'), 'macro?', types._function('core.macro_Q'), 'pr-str', types._function('core.pr_str'), 'str', types._function('core.str'), 'prn', types._function('core.prn'), 'println', types._function('core.println'), 'read-string', types._function('core.read_string'), 'readline', types._function('core.readline'), 'slurp', types._function('core.slurp'), '<', types._function('core.lt'), '<=', types._function('core.lte'), '>', types._function('core.gt'), '>=', types._function('core.gte'), '+', types._function('core.add'), '-', types._function('core.subtract'), '*', types._function('core.multiply'), '/', types._function('core.divide'), 'time-ms', types._function('core.time_ms'), 'list', types._function('core.list'), 'list?', types._function('core.list_Q'), 'vector', types._function('core.vector'), 'vector?', types._function('core.vector_Q'), 'hash-map', types._function('core.hash_map'), 'map?', types._function('core.map_Q'), 'assoc', types._function('core.assoc'), 'dissoc', types._function('core.dissoc'), 'get', types._function('core.get'), 'contains?', types._function('core.contains_Q'), 'keys', types._function('core.keys'), 'vals', types._function('core.vals'), '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'), 'empty?', types._function('core.empty_Q'), 'count', types._function('core.count'), 'apply', types._function('core.apply'), 'map', types._function('core.map'), 'conj', types._function('core.conj'), 'seq', types._function('core.seq'), 'meta', types._function('core.meta'), 'with-meta', types._function('core.with_meta'), 'atom', types._function('core.atom'), 'atom?', types._function('core.atom_Q'), 'deref', types._function('core.deref'), 'reset!', types._function('core.reset_BANG'), 'swap!', types._function('core.swap_BANG') ])); ================================================ FILE: impls/plpgsql/entrypoint.sh ================================================ #!/usr/bin/env bash POSTGRES_SUDO_USER=${POSTGRES_SUDO_USER:-postgres} POPTS="" while [[ ${1:0:1} = '-' ]]; do POPTS="${POPTS}$1 $2" shift; shift done sudo --user=${POSTGRES_SUDO_USER} \ bash -c "/usr/lib/postgresql/9.4/bin/postgres \ -c config_file=/etc/postgresql/9.4/main/postgresql.conf \ ${POPTS} >/var/log/postgresql/output.log 2>&1" & disown -h while ! ( echo "" > /dev/tcp/localhost/5432) 2>/dev/null; do echo "Waiting for postgres to start" sleep 1 done if [ "${*}" ]; then exec "${@}" else exec bash fi ================================================ FILE: impls/plpgsql/envs.sql ================================================ -- --------------------------------------------------------- -- envs.sql CREATE SCHEMA envs -- env table CREATE SEQUENCE env_id_seq CREATE TABLE env ( env_id integer NOT NULL DEFAULT nextval('envs.env_id_seq'), outer_id integer, data hstore ); ALTER TABLE envs.env ADD CONSTRAINT pk_env_id PRIMARY KEY (env_id); -- drop sequence when table dropped ALTER SEQUENCE envs.env_id_seq OWNED BY envs.env.env_id; ALTER TABLE envs.env ADD CONSTRAINT fk_env_outer_id FOREIGN KEY (outer_id) REFERENCES envs.env(env_id); -- ----------------------- -- envs.new CREATE FUNCTION envs.new(outer_env integer) RETURNS integer AS $$ DECLARE e integer; BEGIN INSERT INTO envs.env (outer_id) VALUES (outer_env) RETURNING env_id INTO e; --RAISE NOTICE 'env_new: e: %, outer_env: %', e, outer_env; RETURN e; END; $$ LANGUAGE plpgsql; -- envs.new with bindings CREATE FUNCTION envs.new(outer_env integer, binds integer, exprs integer[]) RETURNS integer AS $$ DECLARE bseq integer[]; env integer; i integer; bind integer; bsym varchar; expr integer; BEGIN env := envs.new(outer_env); bseq := types._valueToArray(binds); FOR i IN 1 .. COALESCE(array_length(bseq, 1), 0) LOOP bind := bseq[i]; bsym := types._valueToString(bind); expr := exprs[i]; --RAISE NOTICE 'i: %, bind: %, expr: %', i, bind, expr; IF bsym = '&' THEN bind := bseq[i+1]; PERFORM envs.set(env, bind, types._list(exprs[i:array_length(exprs, 1)])); RETURN env; END IF; PERFORM envs.vset(env, bsym, expr); END LOOP; RETURN env; END; $$ LANGUAGE plpgsql; -- envs.vset -- like envs.set but takes a varchar key instead of value_id CREATE FUNCTION envs.vset(env integer, name varchar, val integer) RETURNS integer AS $$ DECLARE e integer = env; d hstore; BEGIN SELECT data INTO d FROM envs.env WHERE env_id=e; IF d IS NULL THEN d := hstore(name, CAST(val AS varchar)); ELSE d := d || hstore(name, CAST(val AS varchar)); END IF; UPDATE envs.env SET data = d WHERE env_id=e; RETURN val; END; $$ LANGUAGE plpgsql; -- envs.set CREATE FUNCTION envs.set(env integer, key integer, val integer) RETURNS integer AS $$ DECLARE symkey varchar; BEGIN symkey := types._valueToString(key); RETURN envs.vset(env, symkey, val); END; $$ LANGUAGE plpgsql; -- envs.get CREATE FUNCTION envs.get(env integer, symkey varchar) RETURNS integer AS $$ DECLARE outer_id integer; d hstore; BEGIN LOOP SELECT e.data, e.outer_id INTO d, outer_id FROM envs.env e WHERE e.env_id = env; IF d ? symkey THEN RETURN d -> symkey; END IF; env := outer_id; IF env IS NULL THEN RETURN NULL; END IF; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/init.sql ================================================ -- --------------------------------------------------------- -- init.sql -- Drop pre-existing schemas DROP SCHEMA IF EXISTS io, types, reader, printer, envs, core, mal CASCADE; -- Drop and recreate extensions DROP EXTENSION IF EXISTS hstore; CREATE EXTENSION hstore; DROP EXTENSION IF EXISTS dblink; CREATE EXTENSION dblink; ================================================ FILE: impls/plpgsql/io.sql ================================================ -- dblink is necessary to be able to sub-transactions (autonomous -- transactions) to the stream table. This is necessary to be able to -- modify the stream table from the perspective of outside callers -- because actual code can be long-lived and it's direct updates will -- not be seen until the process completes. CREATE SCHEMA io CREATE TABLE stream ( stream_id integer, open boolean, data varchar, rl_prompt varchar -- prompt for readline input ); -- stdin INSERT INTO io.stream (stream_id, open, data, rl_prompt) VALUES (0, false, '', ''); -- stdout INSERT INTO io.stream (stream_id, open, data, rl_prompt) VALUES (1, false, '', ''); -- --------------------------------------------------------- CREATE FUNCTION io.open(sid integer) RETURNS void AS $$ DECLARE query varchar; BEGIN --RAISE NOTICE 'io.open start'; query := format('UPDATE io.stream SET data = '''', rl_prompt = '''', open = true WHERE stream_id = %L', sid); PERFORM dblink('dbname=mal', query); --RAISE NOTICE 'io.open done'; END; $$ LANGUAGE 'plpgsql' STRICT; CREATE FUNCTION io.close(sid integer) RETURNS void AS $$ DECLARE query varchar; BEGIN --RAISE NOTICE 'io.close start'; query := format('UPDATE io.stream SET rl_prompt = '''', open = false WHERE stream_id = %L', sid); PERFORM dblink('dbname=mal', query); --RAISE NOTICE 'io.close done'; END; $$ LANGUAGE 'plpgsql' STRICT; -- called from read via dblink CREATE FUNCTION io.__read(sid integer) RETURNS varchar AS $$ DECLARE input varchar; isopen boolean; BEGIN LOCK io.stream; SELECT data, open INTO input, isopen FROM io.stream WHERE stream_id = sid; IF input <> '' THEN UPDATE io.stream SET data = '' WHERE stream_id = sid; RETURN input; END IF; IF isopen = false THEN RETURN NULL; END IF; RETURN input; END; $$ LANGUAGE 'plpgsql' STRICT; -- read: -- read from stream stream_id in stream table. Waits until there is -- either data to return or the stream closes (NULL data). Returns -- NULL when stream is closed. CREATE FUNCTION io.read(sid integer DEFAULT 0) RETURNS varchar AS $$ DECLARE query varchar; input varchar; sleep real = 0.05; BEGIN -- poll / wait for input query := format('SELECT io.__read(%L);', sid); WHILE true LOOP -- atomic get and set to empty SELECT cur_data INTO input FROM dblink('dbname=mal', query) AS t1(cur_data varchar); IF input <> '' OR input IS NULL THEN RETURN input; END IF; PERFORM pg_sleep(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; $$ LANGUAGE 'plpgsql' STRICT; -- read_or_error: -- similar to read, but throws exception when stream is closed CREATE FUNCTION io.read_or_error(sid integer DEFAULT 0) RETURNS varchar AS $$ DECLARE input varchar; BEGIN input := io.read(sid); IF input IS NULL THEN raise EXCEPTION 'Stream ''%'' is closed', sid; ELSE RETURN input; END IF; END; $$ LANGUAGE 'plpgsql' STRICT; -- readline: -- set prompt and wait for readline style input on the stream CREATE FUNCTION io.readline(prompt varchar, sid integer DEFAULT 0) RETURNS varchar AS $$ DECLARE query varchar; BEGIN -- set prompt / request readline style input IF sid = 0 THEN PERFORM io.wait_flushed(1); ELSIF sid = 1 THEN PERFORM io.wait_flushed(0); END IF; query := format('LOCK io.stream; UPDATE io.stream SET rl_prompt = %L', prompt); PERFORM dblink('dbname=mal', query); RETURN io.read(sid); END; $$ LANGUAGE 'plpgsql' STRICT; CREATE FUNCTION io.write(data varchar, sid integer DEFAULT 1) RETURNS void AS $$ DECLARE query varchar; BEGIN query := format('LOCK io.stream; UPDATE io.stream SET data = data || %L WHERE stream_id = %L', data, sid); --RAISE NOTICE 'write query: %', query; PERFORM dblink('dbname=mal', query); END; $$ LANGUAGE 'plpgsql' STRICT; CREATE FUNCTION io.writeline(data varchar, sid integer DEFAULT 1) RETURNS void AS $$ BEGIN PERFORM io.write(data || E'\n', sid); END; $$ LANGUAGE 'plpgsql' STRICT; -- --------------------------------------------------------- -- called from wait_rl_prompt via dblink CREATE FUNCTION io.__wait_rl_prompt(sid integer) RETURNS varchar AS $$ DECLARE isopen boolean; prompt varchar; datas integer; BEGIN LOCK io.stream; SELECT open, rl_prompt INTO isopen, prompt FROM io.stream WHERE stream_id = sid; SELECT count(stream_id) INTO datas FROM io.stream WHERE data <> ''; IF isopen = false THEN return NULL; --raise EXCEPTION 'Stream ''%'' is closed', sid; END IF; IF datas = 0 AND prompt <> '' THEN UPDATE io.stream SET rl_prompt = '' WHERE stream_id = sid; -- There is pending data on some stream RETURN prompt; END IF; RETURN ''; -- '' -> no input END; $$ LANGUAGE 'plpgsql' STRICT; -- wait_rl_prompt: -- wait for rl_prompt to be set on the given stream and return the -- rl_prompt value. Errors if stream is already closed. CREATE FUNCTION io.wait_rl_prompt(sid integer DEFAULT 0) RETURNS varchar AS $$ DECLARE query varchar; prompt varchar; sleep real = 0.05; BEGIN query := format('SELECT io.__wait_rl_prompt(%L);', sid); WHILE true LOOP SELECT rl_prompt INTO prompt FROM dblink('dbname=mal', query) AS t1(rl_prompt varchar); IF prompt IS NULL THEN raise EXCEPTION 'Stream ''%'' is closed', sid; END IF; IF prompt <> '' THEN sleep := 0.05; -- reset sleep timer RETURN prompt; END IF; PERFORM pg_sleep(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; $$ LANGUAGE 'plpgsql' STRICT; CREATE FUNCTION io.wait_flushed(sid integer DEFAULT 1) RETURNS void AS $$ DECLARE query varchar; pending integer; sleep real = 0.05; BEGIN query := format('SELECT count(stream_id) FROM io.stream WHERE stream_id = %L AND data <> ''''', sid); WHILE true LOOP SELECT p INTO pending FROM dblink('dbname=mal', query) AS t1(p integer); IF pending = 0 THEN RETURN; END IF; PERFORM pg_sleep(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; $$ LANGUAGE 'plpgsql' STRICT; ================================================ FILE: impls/plpgsql/printer.sql ================================================ -- --------------------------------------------------------- -- printer.sql CREATE SCHEMA printer; CREATE FUNCTION printer.pr_str_array(arr integer[], sep varchar, print_readably boolean) RETURNS varchar AS $$ DECLARE i integer; res varchar[]; BEGIN IF array_length(arr, 1) > 0 THEN FOR i IN array_lower(arr, 1) .. array_upper(arr, 1) LOOP res := array_append(res, printer.pr_str(arr[i], print_readably)); END LOOP; RETURN array_to_string(res, sep); ELSE RETURN ''; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION printer.pr_str(ast integer, print_readably boolean DEFAULT true) RETURNS varchar AS $$ DECLARE type integer; seq integer[]; hash hstore; cid integer; vid integer; pid integer; str varchar; BEGIN -- RAISE NOTICE 'pr_str ast: %', ast; SELECT type_id FROM types.value WHERE value_id = ast INTO type; -- RAISE NOTICE 'pr_str type: %', type; CASE WHEN type = 0 THEN RETURN 'nil'; WHEN type = 1 THEN RETURN 'false'; WHEN type = 2 THEN RETURN 'true'; WHEN type = 3 THEN -- integer RETURN CAST((SELECT val_int FROM types.value WHERE value_id = ast) as varchar); WHEN type = 5 THEN -- string str := types._valueToString(ast); IF chr(CAST(x'7f' AS integer)) = substring(str FROM 1 FOR 1) THEN RETURN ':' || substring(str FROM 2 FOR (char_length(str)-1)); ELSIF print_readably THEN str := replace(str, E'\\', '\\'); str := replace(str, '"', '\"'); str := replace(str, E'\n', '\n'); RETURN '"' || str || '"'; ELSE RETURN str; END IF; WHEN type = 7 THEN -- symbol RETURN types._valueToString(ast); WHEN type = 8 THEN -- list BEGIN SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; RETURN '(' || array_to_string(array( SELECT printer.pr_str(x, print_readably) FROM unnest(seq) AS x), ' ') || ')'; END; WHEN type = 9 THEN -- vector BEGIN SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; RETURN '[' || array_to_string(array( SELECT printer.pr_str(x, print_readably) FROM unnest(seq) AS x), ' ') || ']'; END; WHEN type = 10 THEN -- hash-map BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; RETURN '{' || array_to_string(array( SELECT printer.pr_str(CAST(key AS integer), print_readably) || ' ' || printer.pr_str(CAST(value AS integer), print_readably) FROM each(hash)), ' ') || '}'; END; WHEN type = 11 THEN -- native function RETURN '#'; WHEN type = 12 THEN -- mal function BEGIN SELECT ast_id, params_id INTO vid, pid FROM types.value WHERE value_id = ast; RETURN '(fn* ' || printer.pr_str(pid, print_readably) || ' ' || printer.pr_str(vid, print_readably) || ')'; END; WHEN type = 13 THEN -- atom BEGIN SELECT val_seq[1] INTO vid FROM types.value WHERE value_id = ast; RETURN '(atom ' || printer.pr_str(vid, print_readably) || ')'; END; ELSE RETURN 'unknown'; END CASE; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/reader.sql ================================================ -- --------------------------------------------------------- -- reader.sql CREATE SCHEMA reader; CREATE FUNCTION reader.tokenize(str varchar) RETURNS varchar[] AS $$ DECLARE re varchar = E'[[:space:] ,]*(~@|[\\[\\]{}()\'`~@^]|"(?:[\\\\].|[^\\\\"])*"?|;[^\n]*|[^\\s \\[\\]{}()\'"`~@,;^]*)'; BEGIN RETURN ARRAY(SELECT tok FROM (SELECT (regexp_matches(str, re, 'g'))[1] AS tok) AS x WHERE tok <> '' AND tok NOT LIKE ';%'); END; $$ LANGUAGE plpgsql IMMUTABLE; -- read_atom: -- takes a tokens array and position -- returns new position and value_id CREATE FUNCTION reader.read_atom(tokens varchar[], INOUT pos integer, OUT result integer) AS $$ DECLARE str_id integer; str varchar; token varchar; BEGIN token := tokens[pos]; pos := pos + 1; -- RAISE NOTICE 'read_atom: %', token; IF token = 'nil' THEN -- nil result := 0; ELSIF token = 'false' THEN -- false result := 1; ELSIF token = 'true' THEN -- true result := 2; ELSIF token ~ '^-?[0-9][0-9]*$' THEN -- integer -- integer INSERT INTO types.value (type_id, val_int) VALUES (3, CAST(token AS integer)) RETURNING value_id INTO result; ELSIF token ~ '^"(?:[\\\\].|[^\\\\"])*"' THEN -- string -- string str := substring(token FROM 2 FOR (char_length(token)-2)); str := replace(str, '\\', chr(CAST(x'7f' AS integer))); str := replace(str, '\"', '"'); str := replace(str, '\n', E'\n'); str := replace(str, chr(CAST(x'7f' AS integer)), E'\\'); result := types._stringv(str); ELSIF token ~ '^".*' THEN -- unclosed string RAISE EXCEPTION 'expected ''"'', got EOF'; ELSIF token ~ '^:.*' THEN -- keyword -- keyword result := types._keywordv(substring(token FROM 2 FOR (char_length(token)-1))); ELSE -- symbol result := types._symbolv(token); END IF; END; $$ LANGUAGE plpgsql; -- read_seq: -- takes a tokens array, type (8, 9, 10), first and last characters -- and position -- returns new position and value_id for a list (8), vector (9) or -- hash-map (10) CREATE FUNCTION reader.read_seq(tokens varchar[], first varchar, last varchar, INOUT p integer, OUT items integer[]) AS $$ DECLARE token varchar; key varchar = NULL; item_id integer; BEGIN token := tokens[p]; p := p + 1; IF token <> first THEN RAISE EXCEPTION 'expected ''%'', got EOF', first; END IF; items := ARRAY[]::integer[]; LOOP IF p > array_length(tokens, 1) THEN RAISE EXCEPTION 'expected ''%'', got EOF', last; END IF; token := tokens[p]; IF token = last THEN EXIT; END IF; SELECT * FROM reader.read_form(tokens, p) INTO p, item_id; items := array_append(items, item_id); END LOOP; p := p + 1; END; $$ LANGUAGE plpgsql; -- read_form: -- takes a tokens array and position -- returns new position and value_id CREATE FUNCTION reader.read_form(tokens varchar[], INOUT pos integer, OUT result integer) AS $$ DECLARE vid integer; meta integer; token varchar; BEGIN token := tokens[pos]; -- peek CASE WHEN token = '''' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('quote'), vid]); END; WHEN token = '`' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('quasiquote'), vid]); END; WHEN token = '~' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('unquote'), vid]); END; WHEN token = '~@' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('splice-unquote'), vid]); END; WHEN token = '^' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, meta; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('with-meta'), vid, meta]); END; WHEN token = '@' THEN BEGIN pos := pos + 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, vid; result := types._list(ARRAY[types._symbolv('deref'), vid]); END; -- list WHEN token = ')' THEN RAISE EXCEPTION 'unexpected '')'''; WHEN token = '(' THEN BEGIN SELECT p, types._list(items) FROM reader.read_seq(tokens, '(', ')', pos) INTO pos, result; END; -- vector WHEN token = ']' THEN RAISE EXCEPTION 'unexpected '']'''; WHEN token = '[' THEN BEGIN SELECT p, types._vector(items) FROM reader.read_seq(tokens, '[', ']', pos) INTO pos, result; END; -- hash-map WHEN token = '}' THEN RAISE EXCEPTION 'unexpected ''}'''; WHEN token = '{' THEN BEGIN SELECT p, types._hash_map(items) FROM reader.read_seq(tokens, '{', '}', pos) INTO pos, result; END; -- ELSE SELECT * FROM reader.read_atom(tokens, pos) INTO pos, result; END CASE; END; $$ LANGUAGE plpgsql; -- read_str: -- takes a string -- returns a new value_id CREATE FUNCTION reader.read_str(str varchar) RETURNS integer AS $$ DECLARE tokens varchar[]; pos integer; ast integer; BEGIN tokens := reader.tokenize(str); -- RAISE NOTICE 'read_str first: %', tokens[1]; pos := 1; SELECT * FROM reader.read_form(tokens, pos) INTO pos, ast; -- RAISE NOTICE 'pos after read_atom: %', pos; RETURN ast; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" ================================================ FILE: impls/plpgsql/step0_repl.sql ================================================ -- --------------------------------------------------------- -- step0_repl.sql \i init.sql \i io.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS varchar AS $$ BEGIN RETURN line; END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.EVAL(ast varchar, env varchar) RETURNS varchar AS $$ BEGIN RETURN ast; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp varchar) RETURNS varchar AS $$ BEGIN RETURN exp; END; $$ LANGUAGE plpgsql; -- repl CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), '')); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE line varchar; output varchar; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step1_read_print.sql ================================================ -- --------------------------------------------------------- -- step1_read_print.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.EVAL(ast integer, env varchar) RETURNS integer AS $$ BEGIN RETURN ast; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), '')); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE line varchar; output varchar; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step2_eval.sql ================================================ -- --------------------------------------------------------- -- step2_eval.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_symbol(ast integer, env hstore) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); BEGIN IF env ? symkey THEN RETURN env -> symkey; ELSE RAISE EXCEPTION '''%'' not found', symkey; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env hstore) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env hstore) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env hstore) RETURNS integer AS $$ DECLARE a0 integer; fname varchar; args integer[] := ARRAY[]::integer[]; evda0 integer; result integer; BEGIN CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); evda0 := mal.EVAL(a0, env); SELECT val_string INTO fname FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$ DECLARE a integer; b integer; result integer; BEGIN SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; EXECUTE format('INSERT INTO types.value (type_id, val_int) VALUES (3, $1 %s $2) RETURNING value_id;', op) INTO result USING a, b; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.REP(env hstore, line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), env)); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE repl_env hstore; line varchar; output varchar; BEGIN repl_env := hstore(ARRAY[ '+', types._function('mal.add'), '-', types._function('mal.subtract'), '*', types._function('mal.multiply'), '/', types._function('mal.divide')]); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(repl_env, line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step3_env.sql ================================================ -- --------------------------------------------------------- -- step3_env.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; RETURN mal.EVAL(types._nth(ast, 2), let_env); END; ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE fname varchar; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT val_string INTO fname FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; END; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$ DECLARE a integer; b integer; result integer; BEGIN SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; EXECUTE format('INSERT INTO types.value (type_id, val_int) VALUES (3, $1 %s $2) RETURNING value_id;', op) INTO result USING a, b; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql; -- repl_env is environment 0 INSERT INTO envs.env (env_id, outer_id, data) VALUES (0, NULL, hstore(ARRAY['+', types._function('mal.add'), '-', types._function('mal.subtract'), '*', types._function('mal.multiply'), '/', types._function('mal.divide')])); CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE line varchar; output varchar; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step4_if_fn_do.sql ================================================ -- --------------------------------------------------------- -- step4_if_fn_do.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; RETURN mal.EVAL(types._nth(ast, 2), let_env); END; WHEN 'do' THEN DECLARE result integer; BEGIN FOR i IN 1 .. types._count(ast) - 1 LOOP result := mal.EVAL(types._nth(ast, i), env); END LOOP; RETURN result; END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN RETURN mal.EVAL(types._nth(ast, 3), env); ELSE RETURN 0; -- nil END IF; ELSE RETURN mal.EVAL(types._nth(ast, 2), env); END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id INTO type, fname, fast, fparams, fenv FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN RETURN mal.EVAL(fast, envs.new(fenv, fparams, args)); ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE line varchar; output varchar; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step5_tco.sql ================================================ -- --------------------------------------------------------- -- step5_tco.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id INTO type, fname, fast, fparams, fenv FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ DECLARE line varchar; output varchar; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step6_file.sql ================================================ -- --------------------------------------------------------- -- step6_file.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id INTO type, fname, fast, fparams, fenv FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.EVAL(args[1], 0); END; $$ LANGUAGE plpgsql; INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); SELECT envs.vset(0, 'eval', (SELECT value_id FROM types.value WHERE val_string = 'mal.mal_eval')) \g '/dev/null' -- *ARGV* values are set by RUN SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) RETURNS integer AS $$ DECLARE line varchar; output varchar; allargs integer; BEGIN PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); IF argstring IS NOT NULL THEN allargs := mal.READ(argstring); PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); PERFORM mal.REP('(load-file ' || printer.pr_str(types._first(allargs)) || ')'); PERFORM io.close(1); PERFORM io.wait_flushed(1); RETURN 0; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step7_quote.sql ================================================ -- --------------------------------------------------------- -- step7_quote.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN 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 $$ BEGIN CASE type_id FROM types.value WHERE value_id = ast WHEN 8 THEN -- list DECLARE a0 integer; 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 mal.qq_foldr(ast); END; WHEN 9 THEN -- vector RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); WHEN 7, 10 THEN -- symbol or map RETURN types._list(ARRAY[types._symbolv('quote'), ast]); ELSE RETURN ast; END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'quote' THEN RETURN types._nth(ast, 1); WHEN 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); CONTINUE; -- TCO END; WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id INTO type, fname, fast, fparams, fenv FROM types.value WHERE value_id = evda0; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.EVAL(args[1], 0); END; $$ LANGUAGE plpgsql; INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); SELECT envs.vset(0, 'eval', (SELECT value_id FROM types.value WHERE val_string = 'mal.mal_eval')) \g '/dev/null' -- *ARGV* values are set by RUN SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) RETURNS integer AS $$ DECLARE line varchar; output varchar; allargs integer; BEGIN PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); IF argstring IS NOT NULL THEN allargs := mal.READ(argstring); PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); PERFORM mal.REP('(load-file ' || printer.pr_str(types._first(allargs)) || ')'); PERFORM io.close(1); PERFORM io.wait_flushed(1); RETURN 0; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step8_macros.sql ================================================ -- --------------------------------------------------------- -- step8_macros.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN 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 $$ BEGIN CASE type_id FROM types.value WHERE value_id = ast WHEN 8 THEN -- list DECLARE a0 integer; 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 mal.qq_foldr(ast); END; WHEN 9 THEN -- vector RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); WHEN 7, 10 THEN -- symbol or map RETURN types._list(ARRAY[types._symbolv('quote'), ast]); ELSE RETURN ast; END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'quote' THEN RETURN types._nth(ast, 1); WHEN 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); CONTINUE; -- TCO END; WHEN 'defmacro!' THEN RETURN envs.set(env, types._nth(ast, 1), types._macro(mal.EVAL(types._nth(ast, 2), env))); WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; fmacro boolean; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id, macro INTO type, fname, fast, fparams, fenv, fmacro FROM types.value WHERE value_id = evda0; IF fmacro THEN ast := types._apply(evda0, types._restArray(ast)); CONTINUE; -- TCO END IF; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.EVAL(args[1], 0); END; $$ LANGUAGE plpgsql; INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); SELECT envs.vset(0, 'eval', (SELECT value_id FROM types.value WHERE val_string = 'mal.mal_eval')) \g '/dev/null' -- *ARGV* values are set by RUN SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' SELECT mal.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)))))))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) RETURNS integer AS $$ DECLARE line varchar; output varchar; allargs integer; BEGIN PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); IF argstring IS NOT NULL THEN allargs := mal.READ(argstring); PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); PERFORM mal.REP('(load-file ' || printer.pr_str(types._first(allargs)) || ')'); PERFORM io.close(1); PERFORM io.wait_flushed(1); RETURN 0; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/step9_try.sql ================================================ -- --------------------------------------------------------- -- step9_try.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN 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 $$ BEGIN CASE type_id FROM types.value WHERE value_id = ast WHEN 8 THEN -- list DECLARE a0 integer; 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 mal.qq_foldr(ast); END; WHEN 9 THEN -- vector RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); WHEN 7, 10 THEN -- symbol or map RETURN types._list(ARRAY[types._symbolv('quote'), ast]); ELSE RETURN ast; END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'quote' THEN RETURN types._nth(ast, 1); WHEN 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); CONTINUE; -- TCO END; WHEN 'defmacro!' THEN RETURN envs.set(env, types._nth(ast, 1), types._macro(mal.EVAL(types._nth(ast, 2), env))); WHEN 'try*' THEN DECLARE a1 constant integer := types._nth(ast, 1); a2 integer; BEGIN IF types._count(ast) >= 3 THEN a2 = types._nth(ast, 2); IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN BEGIN RETURN mal.EVAL(a1, env); EXCEPTION WHEN OTHERS THEN env := envs.new(env); PERFORM envs.set(env, types._nth(a2, 1), types._stringv(SQLERRM)); ast := types._nth(a2, 2); CONTINUE; -- TCO END; END IF; END IF; ast := a1; CONTINUE; -- TCO END; WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; fmacro boolean; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id, macro INTO type, fname, fast, fparams, fenv, fmacro FROM types.value WHERE value_id = evda0; IF fmacro THEN ast := types._apply(evda0, types._restArray(ast)); CONTINUE; -- TCO END IF; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.EVAL(args[1], 0); END; $$ LANGUAGE plpgsql; INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); SELECT envs.vset(0, 'eval', (SELECT value_id FROM types.value WHERE val_string = 'mal.mal_eval')) \g '/dev/null' -- *ARGV* values are set by RUN SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' -- core.mal: defined using the language itself SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' SELECT mal.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)))))))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) RETURNS integer AS $$ DECLARE line varchar; output varchar; allargs integer; BEGIN PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); IF argstring IS NOT NULL THEN allargs := mal.READ(argstring); PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); PERFORM mal.REP('(load-file ' || printer.pr_str(types._first(allargs)) || ')'); PERFORM io.close(1); PERFORM io.wait_flushed(1); RETURN 0; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/stepA_mal.sql ================================================ -- --------------------------------------------------------- -- stepA_mal.sql \i init.sql \i io.sql \i types.sql \i reader.sql \i printer.sql \i envs.sql \i core.sql -- --------------------------------------------------------- CREATE SCHEMA mal; -- read CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ BEGIN RETURN reader.read_str(line); END; $$ LANGUAGE plpgsql; -- eval CREATE FUNCTION mal.eval_debug(ast integer, env integer) RETURNS void AS $$ DECLARE val constant integer := envs.get(env, 'DEBUG-EVAL'); BEGIN IF val IS NOT NULL THEN IF (SELECT type_id FROM types.value WHERE value_id = val) NOT IN (0, 1) THEN PERFORM io.writeline(format('EVAL: %s [%s]', mal.PRINT(ast), ast)); END IF; END IF; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN 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 $$ BEGIN CASE type_id FROM types.value WHERE value_id = ast WHEN 8 THEN -- list DECLARE a0 integer; 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 mal.qq_foldr(ast); END; WHEN 9 THEN -- vector RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); WHEN 7, 10 THEN -- symbol or map RETURN types._list(ARRAY[types._symbolv('quote'), ast]); ELSE RETURN ast; END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_symbol(ast integer, env integer) RETURNS integer AS $$ DECLARE symkey constant varchar := types._valueToString(ast); result constant integer := envs.get(env, symkey); BEGIN IF result IS NULL THEN RAISE EXCEPTION '''%'' not found', symkey; END IF; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_vector(ast integer, env integer) RETURNS integer AS $$ DECLARE seq constant integer[] := types._valueToArray(ast); eseq integer[]; result integer; BEGIN -- Evaluate each entry creating a new sequence FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP eseq[i] := mal.EVAL(seq[i], env); END LOOP; INSERT INTO types.value (type_id, val_seq) VALUES (9, eseq) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_map(ast integer, env integer) RETURNS integer AS $$ DECLARE hash hstore; ehash hstore; kv RECORD; e integer; result integer; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; -- Evaluate each value for every key/value FOR kv IN SELECT * FROM each(hash) LOOP e := mal.EVAL(CAST(kv.value AS integer), env); IF ehash IS NULL THEN ehash := hstore(kv.key, CAST(e AS varchar)); ELSE ehash := ehash || hstore(kv.key, CAST(e AS varchar)); END IF; END LOOP; INSERT INTO types.value (type_id, val_hash) VALUES (10, ehash) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ DECLARE a0 integer; BEGIN LOOP PERFORM mal.eval_debug(ast, env); CASE type_id FROM types.value WHERE value_id = ast WHEN 7 THEN RETURN mal.eval_symbol(ast, env); WHEN 8 THEN NULL; -- List, proceed after this case statement. WHEN 9 THEN RETURN mal.eval_vector(ast, env); WHEN 10 THEN RETURN mal.eval_map(ast, env); ELSE RETURN ast; END CASE; IF types._count(ast) = 0 THEN RETURN ast; END IF; a0 := types._first(ast); IF types._symbol_Q(a0) THEN CASE val_string FROM types.value WHERE value_id = a0 WHEN 'def!' THEN RETURN envs.set(env, types._nth(ast, 1), mal.EVAL(types._nth(ast, 2), env)); WHEN 'let*' THEN DECLARE let_env constant integer := envs.new(env); binds constant integer[] := types._valueToArray(types._nth(ast, 1)); BEGIN FOR idx IN 1 .. array_length(binds, 1) BY 2 LOOP PERFORM envs.set(let_env, binds[idx], mal.EVAL(binds[idx+1], let_env)); END LOOP; env := let_env; ast := types._nth(ast, 2); CONTINUE; -- TCO END; WHEN 'quote' THEN RETURN types._nth(ast, 1); WHEN 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); CONTINUE; -- TCO END; WHEN 'defmacro!' THEN RETURN envs.set(env, types._nth(ast, 1), types._macro(mal.EVAL(types._nth(ast, 2), env))); WHEN 'try*' THEN DECLARE a1 constant integer := types._nth(ast, 1); a2 integer; BEGIN IF types._count(ast) >= 3 THEN a2 = types._nth(ast, 2); IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN BEGIN RETURN mal.EVAL(a1, env); EXCEPTION WHEN OTHERS THEN env := envs.new(env); PERFORM envs.set(env, types._nth(a2, 1), types._stringv(SQLERRM)); ast := types._nth(a2, 2); CONTINUE; -- TCO END; END IF; END IF; ast := a1; CONTINUE; -- TCO END; WHEN 'do' THEN DECLARE ignored integer; BEGIN FOR i IN 1 .. types._count(ast) - 2 LOOP ignored := mal.EVAL(types._nth(ast, i), env); END LOOP; ast := types._nth(ast, types._count(ast)-1); CONTINUE; -- TCO END; WHEN 'if' THEN IF (SELECT type_id FROM types.value WHERE value_id = mal.EVAL(types._nth(ast, 1), env)) IN (0, 1) THEN -- nil or false IF types._count(ast) > 3 THEN ast := types._nth(ast, 3); CONTINUE; -- TCO ELSE RETURN 0; -- nil END IF; ELSE ast := types._nth(ast, 2); CONTINUE; -- TCO END IF; WHEN 'fn*' THEN RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); ELSE NULL; END CASE; END IF; -- Apply phase. DECLARE type integer; fname varchar; fast integer; fparams integer; fenv integer; fmacro boolean; args integer[] := ARRAY[]::integer[]; result integer; evda0 constant integer := mal.EVAL(a0, env); BEGIN SELECT type_id, val_string, ast_id, params_id, env_id, macro INTO type, fname, fast, fparams, fenv, fmacro FROM types.value WHERE value_id = evda0; IF fmacro THEN ast := types._apply(evda0, types._restArray(ast)); CONTINUE; -- TCO END IF; FOR i in 1 .. types._count(ast) - 1 LOOP args[i] := mal.EVAL(types._nth(ast, i), env); END LOOP; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN env := envs.new(fenv, fparams, args); ast := fast; CONTINUE; -- TCO ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; END LOOP; END; $$ LANGUAGE plpgsql; -- print CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ BEGIN RETURN printer.pr_str(exp); END; $$ LANGUAGE plpgsql; -- repl -- repl_env is environment 0 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ BEGIN RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); END; $$ LANGUAGE plpgsql; -- core.sql: defined using SQL (in core.sql) -- repl_env is created and populated with core functions in by core.sql CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ BEGIN RETURN mal.EVAL(args[1], 0); END; $$ LANGUAGE plpgsql; INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); SELECT envs.vset(0, 'eval', (SELECT value_id FROM types.value WHERE val_string = 'mal.mal_eval')) \g '/dev/null' -- *ARGV* values are set by RUN SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' -- core.mal: defined using the language itself SELECT mal.REP('(def! *host-language* "plpqsql")') \g '/dev/null' SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' SELECT mal.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)))))))') \g '/dev/null' CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) RETURNS integer AS $$ DECLARE line varchar; output varchar; allargs integer; BEGIN PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); IF argstring IS NOT NULL THEN allargs := mal.READ(argstring); PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); PERFORM mal.REP('(load-file ' || printer.pr_str(types._first(allargs)) || ')'); PERFORM io.close(1); PERFORM io.wait_flushed(1); RETURN 0; END IF; PERFORM mal.REP('(println (str "Mal [" *host-language* "]"))'); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line IS NULL THEN PERFORM io.close(1); RETURN 0; END IF; IF line NOT IN ('', E'\n') THEN output := mal.REP(line); PERFORM io.writeline(output); END IF; EXCEPTION WHEN OTHERS THEN PERFORM io.writeline('Error: ' || SQLERRM); END; END LOOP; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/types.sql ================================================ -- --------------------------------------------------------- -- persistent values -- list of types for type_id -- 0: nil -- 1: false -- 2: true -- 3: integer -- 4: float -- 5: string -- 6: keyword (not used, uses prefixed string) -- 7: symbol -- 8: list -- 9: vector -- 10: hashmap -- 11: function -- 12: malfunc -- 13: atom CREATE SCHEMA types CREATE SEQUENCE value_id_seq START WITH 3 -- skip nil, false, true CREATE TABLE value ( value_id integer NOT NULL DEFAULT nextval('value_id_seq'), type_id integer NOT NULL, val_int bigint, -- set for integers val_string varchar, -- set for strings, keywords, symbols, -- and native functions (function name) val_seq integer[], -- set for lists and vectors val_hash hstore, -- set for hash-maps ast_id integer, -- set for malfunc params_id integer, -- set for malfunc env_id integer, -- set for malfunc macro boolean, -- set for malfunc meta_id integer -- can be set for any collection ); ALTER TABLE types.value ADD CONSTRAINT pk_value_id PRIMARY KEY (value_id); -- drop sequence when table dropped ALTER SEQUENCE types.value_id_seq OWNED BY types.value.value_id; ALTER TABLE types.value ADD CONSTRAINT fk_meta_id FOREIGN KEY (meta_id) REFERENCES types.value(value_id); ALTER TABLE types.value ADD CONSTRAINT fk_params_id FOREIGN KEY (params_id) REFERENCES types.value(value_id); CREATE INDEX ON types.value (value_id, type_id); INSERT INTO types.value (value_id, type_id) VALUES (0, 0); -- nil INSERT INTO types.value (value_id, type_id) VALUES (1, 1); -- false INSERT INTO types.value (value_id, type_id) VALUES (2, 2); -- true -- --------------------------------------------------------- -- general functions CREATE FUNCTION types._wraptf(val boolean) RETURNS integer AS $$ BEGIN IF val THEN RETURN 2; ELSE RETURN 1; END IF; END; $$ LANGUAGE plpgsql IMMUTABLE; -- pun both NULL and false to false CREATE FUNCTION types._tf(val boolean) RETURNS boolean AS $$ BEGIN IF val IS NULL OR val = false THEN RETURN false; END IF; RETURN true; END; $$ LANGUAGE plpgsql IMMUTABLE; -- pun both NULL and 0 to false CREATE FUNCTION types._tf(val integer) RETURNS boolean AS $$ BEGIN IF val IS NULL OR val = 0 THEN RETURN false; END IF; RETURN true; END; $$ LANGUAGE plpgsql IMMUTABLE; -- return the type of the given value_id CREATE FUNCTION types._type(obj integer) RETURNS integer AS $$ BEGIN RETURN (SELECT type_id FROM types.value WHERE value_id = obj); END; $$ LANGUAGE plpgsql; CREATE FUNCTION types._equal_Q(a integer, b integer) RETURNS boolean AS $$ DECLARE atype integer; btype integer; anum bigint; bnum bigint; avid integer; bvid integer; aseq integer[]; bseq integer[]; ahash hstore; bhash hstore; kv RECORD; i integer; BEGIN atype := types._type(a); btype := types._type(b); IF NOT ((atype = btype) OR (types._sequential_Q(a) AND types._sequential_Q(b))) THEN RETURN false; END IF; CASE WHEN atype = 3 THEN -- integer SELECT val_int FROM types.value INTO anum WHERE value_id = a; SELECT val_int FROM types.value INTO bnum WHERE value_id = b; RETURN anum = bnum; WHEN atype = 5 OR atype = 7 THEN -- string/symbol RETURN types._valueToString(a) = types._valueToString(b); WHEN atype IN (8, 9) THEN -- list/vector IF types._count(a) <> types._count(b) THEN RETURN false; END IF; SELECT val_seq INTO aseq FROM types.value WHERE value_id = a; SELECT val_seq INTO bseq FROM types.value WHERE value_id = b; FOR i IN 1 .. types._count(a) LOOP IF NOT types._equal_Q(aseq[i], bseq[i]) THEN return false; END IF; END LOOP; RETURN true; WHEN atype = 10 THEN -- hash-map SELECT val_hash INTO ahash FROM types.value WHERE value_id = a; SELECT val_hash INTO bhash FROM types.value WHERE value_id = b; IF array_length(akeys(ahash), 1) <> array_length(akeys(bhash), 1) THEN RETURN false; END IF; FOR kv IN SELECT * FROM each(ahash) LOOP avid := CAST((ahash -> kv.key) AS integer); bvid := CAST((bhash -> kv.key) AS integer); IF bvid IS NULL OR NOT types._equal_Q(avid, bvid) THEN return false; END IF; END LOOP; RETURN true; ELSE RETURN a = b; END CASE; END; $$ LANGUAGE plpgsql; -- _clone: -- take a value_id of a collection -- returns a new value_id of a cloned collection CREATE FUNCTION types._clone(id integer) RETURNS integer AS $$ DECLARE result integer; BEGIN INSERT INTO types.value (type_id,val_int,val_string,val_seq,val_hash, ast_id,params_id,env_id,meta_id) (SELECT type_id,val_int,val_string,val_seq,val_hash, ast_id,params_id,env_id,meta_id FROM types.value WHERE value_id = id) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- scalar functions -- _nil_Q: -- takes a value_id -- returns the whether value_id is nil CREATE FUNCTION types._nil_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN id = 0; END; $$ LANGUAGE plpgsql IMMUTABLE; -- _true_Q: -- takes a value_id -- returns the whether value_id is true CREATE FUNCTION types._true_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN id = 2; END; $$ LANGUAGE plpgsql IMMUTABLE; -- _false_Q: -- takes a value_id -- returns the whether value_id is false CREATE FUNCTION types._false_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN id = 1; END; $$ LANGUAGE plpgsql IMMUTABLE; -- _string_Q: -- takes a value_id -- returns the whether value_id is string type CREATE FUNCTION types._string_Q(id integer) RETURNS boolean AS $$ BEGIN IF (SELECT 1 FROM types.value WHERE type_id = 5 AND value_id = id) THEN RETURN NOT types._keyword_Q(id); END IF; RETURN false; END; $$ LANGUAGE plpgsql; -- _number_Q: -- takes a value_id -- returns the whether value_id is integer or float type CREATE FUNCTION types._number_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE (type_id = 3 OR type_id = 4) AND value_id = id)); END; $$ LANGUAGE plpgsql; -- _valueToString: -- takes a value_id for a string -- returns the varchar value of the string CREATE FUNCTION types._valueToString(sid integer) RETURNS varchar AS $$ BEGIN RETURN (SELECT val_string FROM types.value WHERE value_id = sid); END; $$ LANGUAGE plpgsql; -- _stringish: -- takes a varchar string -- returns the value_id of a stringish type (string, symbol, keyword) CREATE FUNCTION types._stringish(str varchar, type integer) RETURNS integer AS $$ DECLARE result integer; BEGIN -- TODO: share string data between string types -- lookup if it exists SELECT value_id FROM types.value INTO result WHERE val_string = str AND type_id = type; IF result IS NULL THEN -- Create string entry INSERT INTO types.value (type_id, val_string) VALUES (type, str) RETURNING value_id INTO result; END IF; RETURN result; END; $$ LANGUAGE plpgsql; -- _stringv: -- takes a varchar string -- returns the value_id of a string (new or existing) CREATE FUNCTION types._stringv(str varchar) RETURNS integer AS $$ BEGIN RETURN types._stringish(str, 5); END; $$ LANGUAGE plpgsql; -- _keywordv: -- takes a varchar string -- returns the value_id of a keyword (new or existing) CREATE FUNCTION types._keywordv(name varchar) RETURNS integer AS $$ BEGIN RETURN types._stringish(chr(CAST(x'7f' AS integer)) || name, 5); END; $$ LANGUAGE plpgsql; -- _keyword_Q: -- takes a value_id -- returns the whether value_id is keyword type CREATE FUNCTION types._keyword_Q(id integer) RETURNS boolean AS $$ DECLARE str varchar; BEGIN IF (SELECT 1 FROM types.value WHERE type_id = 5 AND value_id = id) THEN str := types._valueToString(id); IF char_length(str) > 0 AND chr(CAST(x'7f' AS integer)) = substring(str FROM 1 FOR 1) THEN RETURN true; END IF; END IF; RETURN false; END; $$ LANGUAGE plpgsql; -- _symbolv: -- takes a varchar string -- returns the value_id of a symbol (new or existing) CREATE FUNCTION types._symbolv(name varchar) RETURNS integer AS $$ BEGIN RETURN types._stringish(name, 7); END; $$ LANGUAGE plpgsql; -- _symbol_Q: -- takes a value_id -- returns the whether value_id is symbol type CREATE FUNCTION types._symbol_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE type_id = 7 AND value_id = id)); END; $$ LANGUAGE plpgsql; -- _numToValue: -- takes an bigint number -- returns the value_id for the number CREATE FUNCTION types._numToValue(num bigint) RETURNS integer AS $$ DECLARE result integer; BEGIN SELECT value_id FROM types.value INTO result WHERE val_int = num AND type_id = 3; IF result IS NULL THEN -- Create an integer entry INSERT INTO types.value (type_id, val_int) VALUES (3, num) RETURNING value_id INTO result; END IF; RETURN result; END; $$ LANGUAGE plpgsql; -- _fn_Q: -- takes a value_id -- returns the whether value_id is a function CREATE FUNCTION types._fn_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE (type_id = 11 OR type_id = 12) AND macro IS NULL AND value_id = id)); END; $$ LANGUAGE plpgsql; -- _macro_Q: -- takes a value_id -- returns the whether value_id is a macro CREATE FUNCTION types._macro_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE type_id = 12 AND macro IS TRUE AND value_id = id)); END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- sequence functions -- _sequential_Q: -- return true if obj value_id is a list or vector CREATE FUNCTION types._sequential_Q(obj integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE value_id = obj AND (type_id = 8 OR type_id = 9))); END; $$ LANGUAGE plpgsql; -- _collection: -- takes a array of value_id integers -- returns the value_id of a new list (8), vector (9) or hash-map (10) CREATE FUNCTION types._collection(items integer[], type integer) RETURNS integer AS $$ DECLARE vid integer; BEGIN IF type IN (8, 9) THEN INSERT INTO types.value (type_id, val_seq) VALUES (type, items) RETURNING value_id INTO vid; ELSIF type = 10 THEN IF (array_length(items, 1) % 2) = 1 THEN RAISE EXCEPTION 'hash-map: odd number of arguments'; END IF; INSERT INTO types.value (type_id, val_hash) VALUES (type, hstore(CAST(items AS varchar[]))) RETURNING value_id INTO vid; END IF; RETURN vid; END; $$ LANGUAGE plpgsql; -- _list: -- takes a array of value_id integers -- returns the value_id of a new list CREATE FUNCTION types._list(items integer[]) RETURNS integer AS $$ BEGIN RETURN types._collection(items, 8); END; $$ LANGUAGE plpgsql; -- _vector: -- takes a array of value_id integers -- returns the value_id of a new list CREATE FUNCTION types._vector(items integer[]) RETURNS integer AS $$ BEGIN RETURN types._collection(items, 9); END; $$ LANGUAGE plpgsql; -- _list_Q: -- return true if obj value_id is a list CREATE FUNCTION types._list_Q(obj integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE value_id = obj and type_id = 8)); END; $$ LANGUAGE plpgsql; -- _vector_Q: -- return true if obj value_id is a list CREATE FUNCTION types._vector_Q(obj integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE value_id = obj and type_id = 9)); END; $$ LANGUAGE plpgsql; -- _valueToArray: -- takes an value_id referring to a list or vector -- returns an array of the value_ids from the list/vector CREATE FUNCTION types._valueToArray(seq integer) RETURNS integer[] AS $$ DECLARE result integer[]; BEGIN result := (SELECT val_seq FROM types.value WHERE value_id = seq); IF result IS NULL THEN result := ARRAY[]::integer[]; END IF; RETURN result; END; $$ LANGUAGE plpgsql; -- From: https://wiki.postgresql.org/wiki/Array_reverse CREATE FUNCTION types.array_reverse(a integer[]) RETURNS integer[] AS $$ SELECT ARRAY( SELECT a[i] FROM generate_subscripts(a,1) AS s(i) ORDER BY i DESC ); $$ LANGUAGE 'sql' STRICT IMMUTABLE; -- _nth: -- takes value_id and an index -- returns the value_id of nth element in list/vector CREATE FUNCTION types._nth(seq_id integer, indx integer) RETURNS integer AS $$ DECLARE result integer; BEGIN RETURN (SELECT val_seq[indx+1] FROM types.value WHERE value_id = seq_id); END; $$ LANGUAGE plpgsql; -- _first: -- takes value_id -- returns the value_id of first element in list/vector CREATE FUNCTION types._first(seq_id integer) RETURNS integer AS $$ BEGIN RETURN types._nth(seq_id, 0); END; $$ LANGUAGE plpgsql; -- _restArray: -- takes value_id -- returns the array of value_ids CREATE FUNCTION types._restArray(seq_id integer) RETURNS integer[] AS $$ DECLARE result integer[]; BEGIN result := (SELECT val_seq FROM types.value WHERE value_id = seq_id); RETURN result[2:array_length(result, 1)]; END; $$ LANGUAGE plpgsql; -- _slice: -- takes value_id, a first index and an last index -- returns the value_id of new list from first (inclusive) to last (exclusive) CREATE FUNCTION types._slice(seq_id integer, first integer, last integer) RETURNS integer AS $$ DECLARE seq integer[]; vid integer; i integer; result integer; BEGIN SELECT val_seq INTO seq FROM types.value WHERE value_id = seq_id; INSERT INTO types.value (type_id, val_seq) VALUES (8, seq[first+1:last]) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; -- _rest: -- takes value_id -- returns the value_id of new list CREATE FUNCTION types._rest(seq_id integer) RETURNS integer AS $$ BEGIN RETURN types._slice(seq_id, 1, types._count(seq_id)); END; $$ LANGUAGE plpgsql; -- _count: -- takes value_id -- returns a count (not value_id) CREATE FUNCTION types._count(seq_id integer) RETURNS integer AS $$ DECLARE result integer[]; BEGIN result := (SELECT val_seq FROM types.value WHERE value_id = seq_id); RETURN COALESCE(array_length(result, 1), 0); END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- hash-map functions -- _hash_map: -- return value_id of a new hash-map CREATE FUNCTION types._hash_map(items integer[]) RETURNS integer AS $$ BEGIN RETURN types._collection(items, 10); END; $$ LANGUAGE plpgsql; -- _hash_map_Q: -- return true if obj value_id is a list CREATE FUNCTION types._hash_map_Q(obj integer) RETURNS boolean AS $$ BEGIN RETURN types._tf((SELECT 1 FROM types.value WHERE value_id = obj and type_id = 10)); END; $$ LANGUAGE plpgsql; -- _assoc_BANG: -- return value_id of the hash-map with new elements appended CREATE FUNCTION types._assoc_BANG(hm integer, items integer[]) RETURNS integer AS $$ DECLARE hash hstore; BEGIN IF (array_length(items, 1) % 2) = 1 THEN RAISE EXCEPTION 'hash-map: odd number of arguments'; END IF; SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; IF hash IS NULL THEN UPDATE types.value SET val_hash = hstore(CAST(items AS varchar[])) WHERE value_id = hm; ELSE UPDATE types.value SET val_hash = hash || hstore(CAST(items AS varchar[])) WHERE value_id = hm; END IF; RETURN hm; END; $$ LANGUAGE plpgsql; -- _dissoc_BANG: -- return value_id of the hash-map with elements removed CREATE FUNCTION types._dissoc_BANG(hm integer, items integer[]) RETURNS integer AS $$ DECLARE hash hstore; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; UPDATE types.value SET val_hash = hash - CAST(items AS varchar[]) WHERE value_id = hm; RETURN hm; END; $$ LANGUAGE plpgsql; -- _get: -- return value_id of the hash-map entry matching key CREATE FUNCTION types._get(hm integer, key varchar) RETURNS integer AS $$ DECLARE hash hstore; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; RETURN hash -> CAST(types._stringv(key) AS varchar); END; $$ LANGUAGE plpgsql; -- _contains_Q: -- return true if hash-map contains entry matching key CREATE FUNCTION types._contains_Q(hm integer, key varchar) RETURNS boolean AS $$ DECLARE hash hstore; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; RETURN types._tf(hash ? CAST(types._stringv(key) AS varchar)); END; $$ LANGUAGE plpgsql; -- _keys: -- return array of key value_ids from hash-map CREATE FUNCTION types._keys(hm integer) RETURNS integer[] AS $$ DECLARE hash hstore; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; RETURN CAST(akeys(hash) AS integer[]); END; $$ LANGUAGE plpgsql; -- _vals: -- return array of value value_ids from hash-map CREATE FUNCTION types._vals(hm integer) RETURNS integer[] AS $$ DECLARE hash hstore; BEGIN SELECT val_hash INTO hash FROM types.value WHERE value_id = hm; RETURN CAST(avals(hash) AS integer[]); END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- function functions -- _function: -- takes a function name -- returns the value_id of a new CREATE FUNCTION types._function(fname varchar) RETURNS varchar AS $$ DECLARE result integer; BEGIN INSERT INTO types.value (type_id, val_string) VALUES (11, fname) RETURNING value_id INTO result; RETURN CAST(result AS varchar); END; $$ LANGUAGE plpgsql; -- _malfunc: -- takes a ast value_id, params value_id and env_id -- returns the value_id of a new function CREATE FUNCTION types._malfunc(ast integer, params integer, env integer) RETURNS integer AS $$ DECLARE cid integer = NULL; result integer; BEGIN -- Create function entry INSERT INTO types.value (type_id, ast_id, params_id, env_id) VALUES (12, ast, params, env) RETURNING value_id into result; RETURN result; END; $$ LANGUAGE plpgsql; -- _macro: CREATE FUNCTION types._macro(func integer) RETURNS integer AS $$ DECLARE newfunc integer; cid integer; BEGIN newfunc := types._clone(func); UPDATE types.value SET macro = true WHERE value_id = newfunc; RETURN newfunc; END; $$ LANGUAGE plpgsql; CREATE FUNCTION types._apply(func integer, args integer[]) RETURNS integer AS $$ DECLARE type integer; fcid integer; fname varchar; fast integer; fparams integer; fenv integer; result integer; BEGIN SELECT type_id, val_string, ast_id, params_id, env_id INTO type, fname, fast, fparams, fenv FROM types.value WHERE value_id = func; IF type = 11 THEN EXECUTE format('SELECT %s($1);', fname) INTO result USING args; RETURN result; ELSIF type = 12 THEN -- NOTE: forward reference to current step EVAL function RETURN mal.EVAL(fast, envs.new(fenv, fparams, args)); ELSE RAISE EXCEPTION 'Invalid function call'; END IF; END; $$ LANGUAGE plpgsql; -- --------------------------------------------------------- -- atom functions -- _atom: -- takes an ast value_id -- returns a new atom value_id CREATE FUNCTION types._atom(val integer) RETURNS integer AS $$ DECLARE cid integer = NULL; result integer; BEGIN -- Create atom INSERT INTO types.value (type_id, val_seq) VALUES (13, ARRAY[val]) RETURNING value_id INTO result; RETURN result; END; $$ LANGUAGE plpgsql; -- _atom_Q: -- takes a value_id -- returns the whether value_id is an atom CREATE FUNCTION types._atom_Q(id integer) RETURNS boolean AS $$ BEGIN RETURN EXISTS(SELECT 1 FROM types.value WHERE type_id = 13 AND value_id = id); END; $$ LANGUAGE plpgsql; -- _deref: -- takes an atom value_id -- returns a atom value value_id CREATE FUNCTION types._deref(atm integer) RETURNS integer AS $$ DECLARE result integer; BEGIN RETURN (SELECT val_seq[1] FROM types.value WHERE value_id = atm); END; $$ LANGUAGE plpgsql; -- _reset_BANG: -- takes an atom value_id and new value value_id -- returns a new value value_id CREATE FUNCTION types._reset_BANG(atm integer, newval integer) RETURNS integer AS $$ BEGIN UPDATE types.value SET val_seq = ARRAY[newval] WHERE value_id = atm; RETURN newval; END; $$ LANGUAGE plpgsql; ================================================ FILE: impls/plpgsql/wrap.sh ================================================ #!/usr/bin/env bash RL_HISTORY_FILE=${HOME}/.mal-history SKIP_INIT="${SKIP_INIT:-}" PSQL_USER="${PSQL_USER:-postgres}" PSQL="psql -q -t -A -v ON_ERROR_STOP=1 ${PSQL_USER:+-U ${PSQL_USER}}" [ "${DEBUG}" ] || PSQL="${PSQL} -v VERBOSITY=terse" # If mal DB is not there, force create of it dbcheck=$(${PSQL} -c "select 1 from pg_database where datname='mal'") [ -z "${dbcheck}" ] && SKIP_INIT= STDOUT_PID= STDIN_PID= cleanup () { trap - TERM QUIT INT EXIT # Make sure input stream is closed. Input subprocess will do this # for normal terminal input but in the runtest.py case it does not # get a chance. ${PSQL} -dmal -c "SELECT io.close(0);" > /dev/null [ "${STDIN_PID}" ] && kill ${STDIN_PID} 2>/dev/null } # Load the SQL code trap "cleanup" TERM QUIT INT EXIT ${PSQL} -tc "SELECT 1 FROM pg_database WHERE datname = 'mal'" \ | grep -q 1 || ${PSQL} -c "CREATE DATABASE mal" #[ "${SKIP_INIT}" ] || ${PSQL} -dmal -f $1 > /dev/null [ "${SKIP_INIT}" ] || ${PSQL} -dmal -f $1 ${PSQL} -dmal -c "SELECT io.open(0); SELECT io.open(1);" > /dev/null # Stream from table to stdout ( while true; do out="$(${PSQL} -dmal -c "SELECT io.read_or_error(1)" 2>/dev/null)" || break echo "${out}" done ) & STDOUT_PID=$! # Perform readline input into stream table when requested ( [ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE} while true; do prompt=$(${PSQL} -dmal \ -c "SELECT io.wait_rl_prompt(0);" 2>/dev/null) || break IFS= read -u 0 -r -e -p "${prompt}" line || break if [ "${line}" ]; then history -s -- "${line}" # add to history history -a ${RL_HISTORY_FILE} # save history to file fi ${PSQL} -dmal -v arg="${line}" \ -f <(echo "SELECT io.writeline(:'arg', 0);") >/dev/null || break done ${PSQL} -dmal -c "SELECT io.close(0);" > /dev/null ) <&0 >&1 & STDIN_PID=$! res=0 shift if [ $# -gt 0 ]; then # If there are command line arguments then run a command and exit args=$(for a in "$@"; do echo -n "\"$a\" "; done) ${PSQL} -dmal -v args="(${args})" \ -f <(echo "SELECT mal.MAIN('$(pwd)', :'args');") > /dev/null res=$? else # Start main loop in the background ${PSQL} -dmal -c "SELECT mal.MAIN('$(pwd)');" > /dev/null res=$? fi wait ${STDOUT_PID} exit ${res} ================================================ FILE: impls/plsql/Dockerfile ================================================ FROM wnameless/oracle-xe-11g RUN apt-get -y update RUN apt-get -y install make cpp python RUN apt-get -y install rlwrap ENV ORACLE_HOME /u01/app/oracle/product/11.2.0/xe ENV PATH ${ORACLE_HOME}/bin:${PATH} ENV ORACLE_SID=XE # Enable use of DMBS_LOCK.sleep and make sure there are no password # expiry messages that may interfere with communication. RUN /usr/sbin/startup.sh && \ echo "GRANT EXECUTE ON DBMS_LOCK TO system;" | sqlplus -S sys/oracle AS sysdba && \ echo "ALTER PROFILE default LIMIT PASSWORD_LIFE_TIME UNLIMITED;" | sqlplus -S system/oracle && \ echo "ALTER USER system IDENTIFIED BY oracle ACCOUNT UNLOCK;" | sqlplus -S system/oracle WORKDIR /mal # Add oracle user RUN usermod -a -G sudo oracle # Travis runs as user ID 1001 so add that user RUN useradd -ou 1001 -m -s /bin/bash -G sudo travis # Enable oracle and travis users to sudo for oracle startup RUN echo "%sudo ALL=(ALL:ALL) NOPASSWD: ALL" >> /etc/sudoers ADD entrypoint.sh /entrypoint.sh ENTRYPOINT ["/entrypoint.sh"] CMD [] ================================================ FILE: impls/plsql/Dockerfile-oracle ================================================ FROM wnameless/oracle-xe-11g RUN apt-get -y update RUN apt-get -y install make cpp python RUN apt-get -y install rlwrap ================================================ FILE: impls/plsql/Dockerfile-postgres ================================================ FROM ubuntu:14.04 RUN apt-get -y update RUN apt-get -y install make cpp python RUN apt-get -y install curl RUN useradd -u 1000 -m -s /bin/bash -G sudo postgres ENV PG_VERSION=9.4 RUN curl https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add - && \ echo 'deb http://apt.postgresql.org/pub/repos/apt/ trusty-pgdg main' > /etc/apt/sources.list.d/pgdg.list && \ apt-get update && \ DEBIAN_FRONTEND=noninteractive apt-get -y install acl \ postgresql-${PG_VERSION} postgresql-client-${PG_VERSION} postgresql-contrib-${PG_VERSION} && \ mkdir -p /var/run/postgresql/9.4-main.pg_stat_tmp/ && \ chown -R postgres /var/run/postgresql ENV HOME=/var/run/postgresql # Add entrypoint.sh which starts postgres then run bash/command ADD entrypoint.sh /entrypoint.sh ENTRYPOINT ["/entrypoint.sh"] ================================================ FILE: impls/plsql/Makefile ================================================ all: clean: ================================================ FILE: impls/plsql/core.sql ================================================ CREATE OR REPLACE TYPE core_ns_T IS TABLE OF varchar2(100); / CREATE OR REPLACE PACKAGE core IS FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, fn integer, a mal_vals) RETURN integer; FUNCTION get_core_ns RETURN core_ns_T; END core; / show errors; CREATE OR REPLACE PACKAGE BODY core AS -- general functions FUNCTION equal_Q(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN RETURN types.tf(types.equal_Q(M, H, args(1), args(2))); END; -- scalar functiosn FUNCTION symbol(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS BEGIN RETURN types.symbol(M, TREAT(M(val) AS mal_str_T).val_str); END; FUNCTION keyword(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS BEGIN IF types.string_Q(M, val) THEN RETURN types.keyword(M, TREAT(M(val) AS mal_str_T).val_str); ELSIF types.keyword_Q(M, val) THEN RETURN val; ELSE raise_application_error(-20009, 'invalid keyword call', TRUE); END IF; END; -- string functions FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN RETURN types.string(M, printer.pr_str_seq(M, H, args, ' ', TRUE)); END; FUNCTION str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN RETURN types.string(M, printer.pr_str_seq(M, H, args, '', FALSE)); END; FUNCTION prn(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN io.writeline(printer.pr_str_seq(M, H, args, ' ', TRUE)); RETURN 1; -- nil END; FUNCTION println(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN io.writeline(printer.pr_str_seq(M, H, args, ' ', FALSE)); RETURN 1; -- nil END; FUNCTION read_string(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, args mal_vals) RETURN integer IS BEGIN IF M(args(1)).type_id = 5 THEN RETURN reader.read_str(M, H, TREAT(M(args(1)) AS mal_str_T).val_str); ELSE RETURN reader.read_str(M, H, TREAT(M(args(1)) AS mal_long_str_T).val_long_str); END IF; END; FUNCTION readline(M IN OUT NOCOPY types.mal_table, prompt integer) RETURN integer IS input CLOB; BEGIN input := io.readline(TREAT(M(prompt) AS mal_str_T).val_str, 0); RETURN types.string(M, input); EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io streams closed RETURN 1; -- nil ELSE RAISE; END IF; END; FUNCTION slurp(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS content CLOB; BEGIN content := io.file_open_and_read(TREAT(M(args(1)) AS mal_str_T).val_str); content := REPLACE(content, '\n', chr(10)); RETURN types.string(M, content); END; -- numeric functions FUNCTION lt(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int < TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION lte(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int <= TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION gt(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int > TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION gte(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int >= TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION add(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION subtract(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION multiply(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION divide(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION time_ms(M IN OUT NOCOPY types.mal_table) RETURN integer IS now integer; BEGIN SELECT extract(day from(sys_extract_utc(systimestamp) - to_timestamp('1970-01-01', 'YYYY-MM-DD'))) * 86400000 + to_number(to_char(sys_extract_utc(systimestamp), 'SSSSSFF3')) INTO now FROM dual; RETURN types.int(M, now); END; -- hash-map functions FUNCTION assoc(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer, kvs mal_vals) RETURN integer IS new_hm integer; midx integer; BEGIN new_hm := types.clone(M, H, hm); midx := TREAT(M(new_hm) AS mal_map_T).map_idx; -- Add the new key/values midx := types.assoc_BANG(M, H, midx, kvs); RETURN new_hm; END; FUNCTION dissoc(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer, ks mal_vals) RETURN integer IS new_hm integer; midx integer; BEGIN new_hm := types.clone(M, H, hm); midx := TREAT(M(new_hm) AS mal_map_T).map_idx; -- Remove the keys midx := types.dissoc_BANG(M, H, midx, ks); RETURN new_hm; END; FUNCTION get(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer, key integer) RETURN integer IS midx integer; k varchar2(256); val integer; BEGIN IF M(hm).type_id = 0 THEN RETURN 1; -- nil END IF; midx := TREAT(M(hm) AS mal_map_T).map_idx; k := TREAT(M(key) AS mal_str_T).val_str; IF H(midx).EXISTS(k) THEN RETURN H(midx)(k); ELSE RETURN 1; -- nil END IF; END; FUNCTION contains_Q(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer, key integer) RETURN integer IS midx integer; k varchar2(256); val integer; BEGIN midx := TREAT(M(hm) AS mal_map_T).map_idx; k := TREAT(M(key) AS mal_str_T).val_str; RETURN types.tf(H(midx).EXISTS(k)); END; FUNCTION keys(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer) RETURN integer IS midx integer; k varchar2(256); ks mal_vals; val integer; BEGIN midx := TREAT(M(hm) AS mal_map_T).map_idx; ks := mal_vals(); k := H(midx).FIRST(); WHILE k IS NOT NULL LOOP ks.EXTEND(); ks(ks.COUNT()) := types.string(M, k); k := H(midx).NEXT(k); END LOOP; RETURN types.seq(M, 8, ks); END; FUNCTION vals(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, hm integer) RETURN integer IS midx integer; k varchar2(256); ks mal_vals; val integer; BEGIN midx := TREAT(M(hm) AS mal_map_T).map_idx; ks := mal_vals(); k := H(midx).FIRST(); WHILE k IS NOT NULL LOOP ks.EXTEND(); ks(ks.COUNT()) := H(midx)(k); k := H(midx).NEXT(k); END LOOP; RETURN types.seq(M, 8, ks); END; -- sequence functions FUNCTION cons(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS new_items mal_vals; len integer; i integer; BEGIN new_items := mal_vals(); len := types.count(M, args(2)); new_items.EXTEND(len+1); new_items(1) := args(1); FOR i IN 1..len LOOP new_items(i+1) := TREAT(M(args(2)) AS mal_seq_T).val_seq(i); END LOOP; RETURN types.seq(M, 8, new_items); END; FUNCTION concat(M IN OUT NOCOPY types.mal_table, args mal_vals) RETURN integer IS new_items mal_vals; cur_len integer; seq_len integer; i integer; j integer; BEGIN new_items := mal_vals(); cur_len := 0; FOR i IN 1..args.COUNT() LOOP seq_len := types.count(M, args(i)); new_items.EXTEND(seq_len); FOR j IN 1..seq_len LOOP new_items(cur_len + j) := types.nth(M, args(i), j-1); END LOOP; cur_len := cur_len + seq_len; END LOOP; 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, ival integer) RETURN integer IS idx integer; BEGIN idx := TREAT(M(ival) AS mal_int_T).val_int; RETURN types.nth(M, val, idx); END; FUNCTION first(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS BEGIN IF val = 1 OR types.count(M, val) = 0 THEN RETURN 1; -- nil ELSE RETURN types.first(M, val); END IF; END; FUNCTION rest(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS BEGIN IF val = 1 OR types.count(M, val) = 0 THEN RETURN types.list(M); ELSE RETURN types.slice(M, val, 1); END IF; END; FUNCTION do_count(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS BEGIN IF M(val).type_id = 0 THEN RETURN types.int(M, 0); ELSE RETURN types.int(M, types.count(M, val)); END IF; END; FUNCTION conj(M IN OUT NOCOPY types.mal_table, seq integer, vals mal_vals) RETURN integer IS type_id integer; slen integer; items mal_vals; BEGIN type_id := M(seq).type_id; slen := types.count(M, seq); items := mal_vals(); items.EXTEND(slen + vals.COUNT()); CASE WHEN type_id = 8 THEN FOR i IN 1..vals.COUNT() LOOP items(i) := vals(vals.COUNT + 1 - i); END LOOP; FOR i IN 1..slen LOOP items(vals.COUNT() + i) := types.nth(M, seq, i-1); END LOOP; WHEN type_id = 9 THEN FOR i IN 1..slen LOOP items(i) := types.nth(M, seq, i-1); END LOOP; FOR i IN 1..vals.COUNT() LOOP items(slen + i) := vals(i); END LOOP; ELSE raise_application_error(-20009, 'conj: not supported on type ' || type_id, TRUE); END CASE; RETURN types.seq(M, type_id, items); END; FUNCTION seq(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS type_id integer; new_val integer; str CLOB; str_items mal_vals; BEGIN type_id := M(val).type_id; CASE WHEN type_id = 8 THEN IF types.count(M, val) = 0 THEN RETURN 1; -- nil END IF; RETURN val; WHEN type_id = 9 THEN IF types.count(M, val) = 0 THEN RETURN 1; -- nil END IF; RETURN types.seq(M, 8, TREAT(M(val) AS mal_seq_T).val_seq); WHEN types.string_Q(M, val) THEN str := TREAT(M(val) AS mal_str_T).val_str; IF str IS NULL THEN RETURN 1; -- nil END IF; str_items := mal_vals(); str_items.EXTEND(LENGTH(str)); FOR i IN 1..LENGTH(str) LOOP str_items(i) := types.string(M, SUBSTR(str, i, 1)); END LOOP; RETURN types.seq(M, 8, str_items); WHEN type_id = 0 THEN RETURN 1; -- nil ELSE raise_application_error(-20009, 'seq: not supported on type ' || type_id, TRUE); END CASE; END; -- metadata functions FUNCTION meta(M IN OUT NOCOPY types.mal_table, val integer) RETURN integer IS type_id integer; BEGIN type_id := M(val).type_id; IF type_id IN (8,9) THEN -- list/vector RETURN TREAT(M(val) AS mal_seq_T).meta; ELSIF type_id = 10 THEN -- hash-map RETURN TREAT(M(val) AS mal_map_T).meta; ELSIF type_id = 11 THEN -- native function RETURN 1; -- nil ELSIF type_id = 12 THEN -- mal function RETURN TREAT(M(val) AS mal_func_T).meta; ELSE raise_application_error(-20006, 'meta: metadata not supported on type', TRUE); END IF; END; -- general native function case/switch FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, fn integer, a mal_vals) RETURN integer IS fname varchar(256); idx integer; BEGIN IF M(fn).type_id <> 11 THEN raise_application_error(-20004, 'Invalid function call', TRUE); END IF; fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = '=' THEN RETURN equal_Q(M, H, a); WHEN fname = 'nil?' THEN RETURN types.tf(a(1) = 1); WHEN fname = 'false?' THEN RETURN types.tf(a(1) = 2); WHEN fname = 'true?' THEN RETURN types.tf(a(1) = 3); WHEN fname = 'string?' THEN RETURN types.tf(types.string_Q(M, a(1))); WHEN fname = 'symbol' THEN RETURN symbol(M, a(1)); WHEN fname = 'symbol?' THEN RETURN types.tf(M(a(1)).type_id = 7); WHEN fname = 'keyword' THEN RETURN keyword(M, a(1)); WHEN fname = 'keyword?' THEN RETURN types.tf(types.keyword_Q(M, a(1))); WHEN fname = 'number?' THEN RETURN types.tf(types.number_Q(M, a(1))); WHEN fname = 'fn?' THEN RETURN types.tf(types.function_Q(M, a(1))); WHEN fname = 'macro?' THEN RETURN types.tf(types.macro_Q(M, a(1))); WHEN fname = 'pr-str' THEN RETURN pr_str(M, H, a); WHEN fname = 'str' THEN RETURN str(M, H, a); WHEN fname = 'prn' THEN RETURN prn(M, H, a); WHEN fname = 'println' THEN RETURN println(M, H, a); WHEN fname = 'read-string' THEN RETURN read_string(M, H, a); WHEN fname = 'readline' THEN RETURN readline(M, a(1)); WHEN fname = 'slurp' THEN RETURN slurp(M, a); WHEN fname = '<' THEN RETURN lt(M, a); WHEN fname = '<=' THEN RETURN lte(M, a); WHEN fname = '>' THEN RETURN gt(M, a); WHEN fname = '>=' THEN RETURN gte(M, a); WHEN fname = '+' THEN RETURN add(M, a); WHEN fname = '-' THEN RETURN subtract(M, a); WHEN fname = '*' THEN RETURN multiply(M, a); WHEN fname = '/' THEN RETURN divide(M, a); WHEN fname = 'time-ms' THEN RETURN time_ms(M); WHEN fname = 'list' THEN RETURN types.seq(M, 8, a); WHEN fname = 'list?' THEN RETURN types.tf(M(a(1)).type_id = 8); WHEN fname = 'vector' THEN RETURN types.seq(M, 9, a); WHEN fname = 'vector?' THEN RETURN types.tf(M(a(1)).type_id = 9); WHEN fname = 'hash-map' THEN RETURN types.hash_map(M, H, a); WHEN fname = 'assoc' THEN RETURN assoc(M, H, a(1), types.islice(a, 1)); WHEN fname = 'dissoc' THEN RETURN dissoc(M, H, a(1), types.islice(a, 1)); WHEN fname = 'map?' THEN RETURN types.tf(M(a(1)).type_id = 10); WHEN fname = 'get' THEN RETURN get(M, H, a(1), a(2)); WHEN fname = 'contains?' THEN RETURN contains_Q(M, H, a(1), a(2)); WHEN fname = 'keys' THEN RETURN keys(M, H, a(1)); WHEN fname = 'vals' THEN RETURN vals(M, H, a(1)); 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)); WHEN fname = 'empty?' THEN RETURN types.tf(0 = types.count(M, a(1))); WHEN fname = 'count' THEN RETURN do_count(M, a(1)); WHEN fname = 'conj' THEN RETURN conj(M, a(1), types.islice(a, 1)); WHEN fname = 'seq' THEN RETURN seq(M, a(1)); WHEN fname = 'meta' THEN RETURN meta(M, a(1)); WHEN fname = 'with-meta' THEN RETURN types.clone(M, H, a(1), a(2)); WHEN fname = 'atom' THEN RETURN types.atom_new(M, a(1)); WHEN fname = 'atom?' THEN RETURN types.tf(M(a(1)).type_id = 13); WHEN fname = 'deref' THEN RETURN TREAT(M(a(1)) AS mal_atom_T).val; WHEN fname = 'reset!' THEN RETURN types.atom_reset(M, a(1), a(2)); ELSE raise_application_error(-20004, 'Invalid function call', TRUE); END CASE; END; FUNCTION get_core_ns RETURN core_ns_T IS BEGIN RETURN core_ns_T( '=', 'throw', 'nil?', 'true?', 'false?', 'string?', 'symbol', 'symbol?', 'keyword', 'keyword?', 'number?', 'fn?', 'macro?', 'pr-str', 'str', 'prn', 'println', 'read-string', 'readline', 'slurp', '<', '<=', '>', '>=', '+', '-', '*', '/', 'time-ms', 'list', 'list?', 'vector', 'vector?', 'hash-map', 'assoc', 'dissoc', 'map?', 'get', 'contains?', 'keys', 'vals', 'sequential?', 'cons', 'concat', 'vec', 'nth', 'first', 'rest', 'empty?', 'count', 'apply', -- defined in step do_builtin function 'map', -- defined in step do_builtin function 'conj', 'seq', 'meta', 'with-meta', 'atom', 'atom?', 'deref', 'reset!', 'swap!' -- defined in step do_builtin function ); END; END core; / show errors; ================================================ FILE: impls/plsql/entrypoint.sh ================================================ #!/usr/bin/env bash case ${1} in make*) echo "Skipping Oracle XE startup" ;; *) echo "Starting Oracle XE" sudo /usr/sbin/startup.sh ;; esac if [ "${*}" ]; then exec "${@}" else exec bash fi ================================================ FILE: impls/plsql/env.sql ================================================ -- --------------------------------------------------------- -- env.sql CREATE OR REPLACE TYPE env_item FORCE AS OBJECT ( key varchar2(256), val integer ) FINAL; / CREATE OR REPLACE TYPE env_data FORCE IS TABLE OF env_item; / CREATE OR REPLACE TYPE env_T FORCE AS OBJECT ( idx integer, outer_idx integer, data env_data ); / CREATE OR REPLACE TYPE env_mem_T FORCE IS TABLE OF env_T; / CREATE OR REPLACE PACKAGE env_pkg IS TYPE env_entry IS TABLE OF integer INDEX BY varchar2(256); TYPE env_entry_table IS TABLE OF env_entry; FUNCTION env_new(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, outer_idx integer DEFAULT NULL) RETURN integer; FUNCTION env_new(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, outer_idx integer, binds integer, exprs mal_vals) RETURN integer; FUNCTION env_set(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, eidx integer, key integer, val integer) RETURN integer; FUNCTION env_find(M IN OUT NOCOPY types.mal_table, eeT env_entry_table, eidx integer, key integer) RETURN integer; FUNCTION env_get(M IN OUT NOCOPY types.mal_table, eeT env_entry_table, eidx integer, key integer) RETURN integer; END env_pkg; / show errors; CREATE OR REPLACE PACKAGE BODY env_pkg IS FUNCTION env_new(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, outer_idx integer DEFAULT NULL) RETURN integer IS eidx integer; BEGIN eeT.EXTEND(); eidx := eeT.COUNT(); eeT(eidx)('**OUTER**') := outer_idx; RETURN eidx; END; FUNCTION env_new(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, outer_idx integer, binds integer, exprs mal_vals) RETURN integer IS eidx integer; i integer; bs mal_vals; BEGIN eeT.EXTEND(); eidx := eeT.COUNT(); eeT(eidx)('**OUTER**') := outer_idx; IF binds IS NOT NULL THEN bs := TREAT(M(binds) AS mal_seq_T).val_seq; FOR i IN 1..bs.COUNT LOOP IF TREAT(M(bs(i)) AS mal_str_T).val_str = '&' THEN eeT(eidx)(TREAT(M(bs(i+1)) AS mal_str_T).val_str) := types.slice(M, exprs, i-1); EXIT; ELSE eeT(eidx)(TREAT(M(bs(i)) AS mal_str_T).val_str) := exprs(i); END IF; END LOOP; END IF; RETURN eidx; END; FUNCTION env_set(M IN OUT NOCOPY types.mal_table, eeT IN OUT NOCOPY env_entry_table, eidx integer, key integer, val integer) RETURN integer IS k varchar2(256); i integer; cnt integer; BEGIN k := TREAT(M(key) AS mal_str_T).val_str; eeT(eidx)(k) := val; RETURN val; END; FUNCTION env_find(M IN OUT NOCOPY types.mal_table, eeT env_entry_table, eidx integer, key integer) RETURN integer IS k varchar2(256); cnt integer; BEGIN k := TREAT(M(key) AS mal_str_T).val_str; IF eeT(eidx).EXISTS(k) THEN RETURN eidx; ELSIF eeT(eidx)('**OUTER**') IS NOT NULL THEN RETURN env_find(M, eeT, eeT(eidx)('**OUTER**'), key); ELSE RETURN NULL; END IF; END; FUNCTION env_get(M IN OUT NOCOPY types.mal_table, eeT env_entry_table, eidx integer, key integer) RETURN integer IS found integer; k varchar2(256); BEGIN found := env_find(M, eeT, eidx, key); k := TREAT(M(key) AS mal_str_T).val_str; IF found IS NOT NULL THEN RETURN eeT(found)(k); ELSE raise_application_error(-20005, '''' || k || ''' not found', TRUE); END IF; END; END env_pkg; / show errors; ================================================ FILE: impls/plsql/io.sql ================================================ BEGIN EXECUTE IMMEDIATE 'DROP TABLE stream'; EXCEPTION WHEN OTHERS THEN IF SQLCODE != -942 THEN RAISE; END IF; END; / CREATE TABLE stream ( stream_id integer, open number(1,0), -- stream open (1) or closed (0) data CLOB, -- queued stream data rl_prompt varchar2(256) -- prompt for readline input ); -- stdin INSERT INTO stream (stream_id, open, data, rl_prompt) VALUES (0, 0, '', ''); -- stdout INSERT INTO stream (stream_id, open, data, rl_prompt) VALUES (1, 0, '', ''); -- --------------------------------------------------------- BEGIN EXECUTE IMMEDIATE 'DROP TABLE file_io'; EXCEPTION WHEN OTHERS THEN IF SQLCODE != -942 THEN RAISE; END IF; END; / CREATE TABLE file_io ( path varchar2(1024), -- file to read/write data CLOB, -- file data error varchar2(1024), -- any errors during read in_or_out varchar2(4) -- input ('in') or output ('out') ); -- --------------------------------------------------------- CREATE OR REPLACE PACKAGE io IS PROCEDURE open(sid integer); PROCEDURE close(sid integer); FUNCTION read(sid integer DEFAULT 0) RETURN CLOB; FUNCTION readline(prompt varchar, sid integer DEFAULT 0) RETURN CLOB; PROCEDURE write(input CLOB, sid integer DEFAULT 1); PROCEDURE writeline(data CLOB, sid integer DEFAULT 1); FUNCTION wait_rl_prompt(sid integer DEFAULT 0) RETURN varchar; PROCEDURE wait_flushed(sid integer DEFAULT 1); FUNCTION file_open_and_read(path varchar) RETURN varchar; END io; / show errors; CREATE OR REPLACE PACKAGE BODY io AS PROCEDURE open(sid integer) AS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN -- DBMS_OUTPUT.PUT_LINE('io.open(' || sid || ') start'); UPDATE stream SET data = '', rl_prompt = '', open = 1 WHERE stream_id = sid; COMMIT; -- DBMS_OUTPUT.PUT_LINE('io.open(' || sid || ') done'); END; PROCEDURE close(sid integer) AS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN -- DBMS_OUTPUT.PUT_LINE('io.close(' || sid || ') start'); UPDATE stream SET rl_prompt = '', open = 0 WHERE stream_id = sid; COMMIT; -- DBMS_OUTPUT.PUT_LINE('io.close(' || sid || ') done'); END; -- read: -- read from stream stream_id in stream table. Waits until there is -- either data to return or the stream closes (NULL data). Returns -- NULL when stream is closed. FUNCTION read(sid integer DEFAULT 0) RETURN CLOB IS PRAGMA AUTONOMOUS_TRANSACTION; input CLOB; isopen integer; sleep real; BEGIN sleep := 0.05; -- poll / wait for input WHILE true LOOP -- atomic get and set to empty -- LOCK TABLE stream IN EXCLUSIVE MODE; SELECT data, open INTO input, isopen FROM stream WHERE stream_id = sid; IF input IS NOT NULL THEN UPDATE stream SET data = '' WHERE stream_id = sid; COMMIT; RETURN trim(TRAILING chr(10) FROM input); END IF; -- '' -> no input, NULL -> stream closed --RAISE NOTICE 'read input: [%] %', input, stream_id; IF isopen = 0 THEN raise_application_error(-20001, 'io.read: stream ''' || sid || ''' is closed', TRUE); END IF; SYS.DBMS_LOCK.SLEEP(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; -- readline: -- set prompt and wait for readline style input on the stream FUNCTION readline(prompt varchar, sid integer DEFAULT 0) RETURN CLOB IS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN -- set prompt / request readline style input -- LOCK TABLE stream IN EXCLUSIVE MODE; IF sid = 0 THEN wait_flushed(1); ELSIF sid = 1 THEN wait_flushed(0); END IF; UPDATE stream SET rl_prompt = prompt WHERE stream_id = sid; COMMIT; RETURN read(sid); END; PROCEDURE write(input CLOB, sid integer DEFAULT 1) AS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN -- LOCK TABLE stream IN EXCLUSIVE MODE; UPDATE stream SET data = data || input WHERE stream_id = sid; COMMIT; END; PROCEDURE writeline(data CLOB, sid integer DEFAULT 1) AS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN write(data || TO_CLOB(chr(10)), sid); END; -- --------------------------------------------------------- -- wait_rl_prompt: -- wait for rl_prompt to be set on the given stream and return the -- rl_prompt value. Errors if stream is already closed. FUNCTION wait_rl_prompt(sid integer DEFAULT 0) RETURN varchar IS PRAGMA AUTONOMOUS_TRANSACTION; isopen integer; prompt CLOB; sleep real; datas integer; BEGIN sleep := 0.05; WHILE true LOOP LOCK TABLE stream IN EXCLUSIVE MODE; SELECT open, rl_prompt INTO isopen, prompt FROM stream WHERE stream_id = sid; SELECT count(stream_id) INTO datas FROM stream WHERE data IS NOT NULL; IF isopen = 0 THEN raise_application_error(-20001, 'io.wait_rl_prompt: stream ''' || sid || ''' is closed', TRUE); END IF; -- wait until all channels have flushed IF datas = 0 AND prompt IS NOT NULL THEN UPDATE stream SET rl_prompt = '' WHERE stream_id = sid; COMMIT; -- Prompt is returned single-quoted because sqlplus trims -- trailing whitespace in select output. RETURN '''' || prompt || ''''; END IF; COMMIT; DBMS_LOCK.SLEEP(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; PROCEDURE wait_flushed(sid integer DEFAULT 1) AS PRAGMA AUTONOMOUS_TRANSACTION; pending integer; sleep real; BEGIN sleep := 0.05; WHILE true LOOP SELECT count(stream_id) INTO pending FROM stream WHERE stream_id = sid AND data IS NOT NULL; IF pending = 0 THEN RETURN; END IF; DBMS_LOCK.SLEEP(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; -- --------------------------------------------------------- FUNCTION file_open_and_read(path varchar) RETURN varchar IS PRAGMA AUTONOMOUS_TRANSACTION; sleep real; content CLOB; error_msg varchar2(1024); BEGIN sleep := 0.05; -- TODO: use unique ID instead of path INSERT INTO file_io (path, data, error, in_or_out) VALUES (path, NULL, NULL, 'in'); WHILE true LOOP LOCK TABLE file_io IN EXCLUSIVE MODE; SELECT data, error INTO content, error_msg FROM file_io WHERE path = path AND ROWNUM = 1; IF error_msg IS NOT NULL THEN raise_application_error(-20010, 'open_and_read error: ''' || error_msg || '''', TRUE); END IF; IF content IS NOT NULL THEN DELETE FROM file_io WHERE path = path; COMMIT; RETURN content; END IF; COMMIT; -- keep waiting DBMS_LOCK.SLEEP(sleep); IF sleep < 0.5 THEN sleep := sleep * 1.1; -- backoff END IF; END LOOP; END; PROCEDURE file_read_response(path varchar, data varchar) AS PRAGMA AUTONOMOUS_TRANSACTION; BEGIN UPDATE file_io SET data = data WHERE path = path; END; END io; / show errors; ================================================ FILE: impls/plsql/login.sql ================================================ -- PROMPT 'Start login.sql'; whenever sqlerror exit SQL.SQLCODE; whenever oserror exit 1; SET ECHO OFF; SET LINESIZE 32767; -- SET TRIMOUT ON; -- SET WRAP OFF; SET PAGESIZE 0; -- Do not format whitespace in terminaml output SET TAB OFF; -- Allow literal & in strings SET DEFINE OFF; -- Print DBMS_OUTPUT.PUT_LINE debugcommands SET SERVEROUTPUT ON SIZE 30000; -- Do not truncate or wrap CLOB output SET LONG 32767; SET LONGCHUNKSIZE 32767; -- PROMPT 'Finish login.sql'; ================================================ FILE: impls/plsql/printer.sql ================================================ -- --------------------------------------------------------- -- printer.sql CREATE OR REPLACE PACKAGE printer IS FUNCTION pr_str_seq(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, seq mal_vals, sep varchar2, print_readably boolean DEFAULT TRUE) RETURN varchar; FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, ast integer, print_readably boolean DEFAULT TRUE) RETURN varchar; END printer; / show errors; CREATE OR REPLACE PACKAGE BODY printer AS FUNCTION pr_str_seq(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, seq mal_vals, sep varchar2, print_readably boolean DEFAULT TRUE) RETURN varchar IS first integer := 1; str CLOB; BEGIN FOR i IN 1..seq.COUNT LOOP IF first = 1 THEN first := 0; ELSE str := str || sep; END IF; str := str || pr_str(M, H, seq(i), print_readably); END LOOP; RETURN str; END; FUNCTION pr_str_map(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, midx integer, sep varchar2, print_readably boolean DEFAULT TRUE) RETURN varchar IS key varchar2(256); first integer := 1; str CLOB; BEGIN key := H(midx).FIRST(); WHILE key IS NOT NULL LOOP IF first = 1 THEN first := 0; ELSE str := str || sep; END IF; str := str || pr_str(M, H, types.string(M, key), print_readably); str := str || ' ' || pr_str(M, H, H(midx)(key), print_readably); key := H(midx).NEXT(key); END LOOP; RETURN str; END; FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, ast integer, print_readably boolean DEFAULT TRUE) RETURN varchar IS type_id integer; first integer := 1; i integer; str CLOB; malfn mal_func_T; BEGIN type_id := M(ast).type_id; -- io.writeline('pr_str type: ' || type_id); CASE WHEN type_id = 0 THEN RETURN 'nil'; WHEN type_id = 1 THEN RETURN 'false'; WHEN type_id = 2 THEN RETURN 'true'; WHEN type_id = 3 THEN -- integer RETURN CAST(TREAT(M(ast) AS mal_int_T).val_int as varchar); WHEN type_id IN (5,6) THEN -- string IF type_id = 5 THEN str := TREAT(M(ast) as mal_str_T).val_str; ELSE str := TREAT(M(ast) as mal_long_str_T).val_long_str; END IF; IF chr(127) = SUBSTR(str, 1, 1) THEN RETURN ':' || SUBSTR(str, 2, LENGTH(str)-1); ELSIF print_readably THEN str := REPLACE(str, chr(92), '\\'); str := REPLACE(str, '"', '\"'); str := REPLACE(str, chr(10), '\n'); RETURN '"' || str || '"'; ELSE RETURN str; END IF; RETURN TREAT(M(ast) AS mal_str_T).val_str; WHEN type_id = 7 THEN -- symbol RETURN TREAT(M(ast) AS mal_str_T).val_str; WHEN type_id = 8 THEN -- list RETURN '(' || pr_str_seq(M, H, TREAT(M(ast) AS mal_seq_T).val_seq, ' ', print_readably) || ')'; WHEN type_id = 9 THEN -- vector RETURN '[' || pr_str_seq(M, H, TREAT(M(ast) AS mal_seq_T).val_seq, ' ', print_readably) || ']'; WHEN type_id = 10 THEN -- hash-map RETURN '{' || pr_str_map(M, H, TREAT(M(ast) AS mal_map_T).map_idx, ' ', print_readably) || '}'; WHEN type_id = 11 THEN -- native function RETURN '#'; WHEN type_id = 12 THEN -- mal function malfn := TREAT(M(ast) AS mal_func_T); RETURN '(fn* ' || pr_str(M, H, malfn.params, print_readably) || ' ' || pr_str(M, H, malfn.ast, print_readably) || ')'; WHEN type_id = 13 THEN -- atom RETURN '(atom ' || pr_str(M, H, TREAT(M(ast) AS mal_atom_T).val, print_readably) || ')'; ELSE RETURN 'unknown'; END CASE; END; END printer; / show errors; ================================================ FILE: impls/plsql/reader.sql ================================================ -- --------------------------------------------------------- -- reader.sql CREATE OR REPLACE TYPE tokens FORCE AS TABLE OF CLOB; / CREATE OR REPLACE TYPE reader_T FORCE AS OBJECT ( position integer, toks tokens, MEMBER FUNCTION peek (SELF IN OUT NOCOPY reader_T) RETURN varchar, MEMBER FUNCTION next (SELF IN OUT NOCOPY reader_T) RETURN varchar ); / CREATE OR REPLACE TYPE BODY reader_T AS MEMBER FUNCTION peek (SELF IN OUT NOCOPY reader_T) RETURN varchar IS BEGIN IF position > toks.COUNT THEN RETURN NULL; END IF; RETURN toks(position); END; MEMBER FUNCTION next (SELF IN OUT NOCOPY reader_T) RETURN varchar IS BEGIN position := position + 1; RETURN toks(position-1); END; END; / CREATE OR REPLACE PACKAGE reader IS FUNCTION read_str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, str varchar) RETURN integer; END reader; / show errors; CREATE OR REPLACE PACKAGE BODY reader AS -- tokenize: -- takes a string and returns a nested table of token strings FUNCTION tokenize(str varchar) RETURN tokens IS re varchar2(100) := '[[:space:] ,]*(~@|[][{}()''`~@]|"(([\].|[^\"])*)"?|;[^' || chr(10) || ']*|[^][[:space:] {}()''"`~@,;]*)'; tok CLOB; toks tokens := tokens(); cnt integer; BEGIN cnt := REGEXP_COUNT(str, re); FOR I IN 1..cnt LOOP tok := REGEXP_SUBSTR(str, re, 1, I, 'm', 1); IF tok IS NOT NULL AND SUBSTR(tok, 1, 1) <> ';' THEN toks.extend(); toks(toks.COUNT) := tok; -- io.writeline('tok: [' || tok || ']'); END IF; END LOOP; RETURN toks; END; -- read_atom: -- takes a reader_T -- updates reader_T and returns a single scalar mal value FUNCTION read_atom(M IN OUT NOCOPY types.mal_table, rdr IN OUT NOCOPY reader_T) RETURN integer IS str_id integer; str CLOB; token CLOB; istr varchar2(256); result integer; BEGIN token := rdr.next(); -- io.writeline('read_atom: ' || token); IF token = 'nil' THEN -- nil result := 1; ELSIF token = 'false' THEN -- false result := 2; ELSIF token = 'true' THEN -- true result := 3; ELSIF REGEXP_LIKE(token, '^-?[0-9][0-9]*$') THEN -- integer istr := token; result := types.int(M, CAST(istr AS integer)); ELSIF REGEXP_LIKE(token, '^".*"') THEN -- string -- string str := SUBSTR(token, 2, LENGTH(token)-2); str := REPLACE(str, '\"', '"'); str := REPLACE(str, '\n', chr(10)); str := REPLACE(str, '\\', chr(92)); result := types.string(M, str); ELSIF REGEXP_LIKE(token, '^".*') THEN -- unclosed string raise_application_error(-20003, 'expected ''"'', got EOF', TRUE); ELSIF REGEXP_LIKE(token, '^:.*') THEN -- keyword -- keyword result := types.keyword(M, SUBSTR(token, 2, LENGTH(token)-1)); ELSE -- symbol result := types.symbol(M, token); END IF; return result; END; -- forward declaration of read_form FUNCTION read_form(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, rdr IN OUT NOCOPY reader_T) RETURN integer; -- read_seq: -- takes a reader_T -- updates reader_T and returns new mal_list/vector/hash-map FUNCTION read_seq(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, rdr IN OUT NOCOPY reader_T, type_id integer, first varchar, last varchar) RETURN integer IS token CLOB; items mal_vals; BEGIN token := rdr.next(); IF token <> first THEN raise_application_error(-20003, 'expected ''' || first || '''', TRUE); END IF; items := mal_vals(); LOOP token := rdr.peek(); IF token IS NULL THEN raise_application_error(-20003, 'expected ''' || last || ''', got EOF', TRUE); END IF; IF token = last THEN EXIT; END IF; items.EXTEND(); items(items.COUNT) := read_form(M, H, rdr); END LOOP; token := rdr.next(); IF type_id IN (8,9) THEN RETURN types.seq(M, type_id, items); ELSE RETURN types.hash_map(M, H, items); END IF; END; -- read_form: -- takes a reader_T -- updates the reader_T and returns new mal value FUNCTION read_form(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, rdr IN OUT NOCOPY reader_T) RETURN integer IS token CLOB; meta integer; midx integer; BEGIN token := rdr.peek(); -- peek CASE WHEN token = '''' THEN token := rdr.next(); RETURN types.list(M, types.symbol(M, 'quote'), read_form(M, H, rdr)); WHEN token = '`' THEN token := rdr.next(); RETURN types.list(M, types.symbol(M, 'quasiquote'), read_form(M, H, rdr)); WHEN token = '~' THEN token := rdr.next(); RETURN types.list(M, types.symbol(M, 'unquote'), read_form(M, H, rdr)); WHEN token = '~@' THEN token := rdr.next(); RETURN types.list(M, types.symbol(M, 'splice-unquote'), read_form(M, H, rdr)); WHEN token = '^' THEN token := rdr.next(); meta := read_form(M, H, rdr); RETURN types.list(M, types.symbol(M, 'with-meta'), read_form(M, H, rdr), meta); WHEN token = '@' THEN token := rdr.next(); RETURN types.list(M, types.symbol(M, 'deref'), read_form(M, H, rdr)); -- list WHEN token = ')' THEN raise_application_error(-20002, 'unexpected '')''', TRUE); WHEN token = '(' THEN RETURN read_seq(M, H, rdr, 8, '(', ')'); -- vector WHEN token = ']' THEN raise_application_error(-20002, 'unexpected '']''', TRUE); WHEN token = '[' THEN RETURN read_seq(M, H, rdr, 9, '[', ']'); -- hash-map WHEN token = '}' THEN raise_application_error(-20002, 'unexpected ''}''', TRUE); WHEN token = '{' THEN RETURN read_seq(M, H, rdr, 10, '{', '}'); -- atom/scalar ELSE RETURN read_atom(M, rdr); END CASE; END; -- read_str: -- takes a string -- returns a new mal value FUNCTION read_str(M IN OUT NOCOPY types.mal_table, H IN OUT NOCOPY types.map_entry_table, str varchar) RETURN integer IS toks tokens; rdr reader_T; BEGIN toks := tokenize(str); rdr := reader_T(1, toks); -- io.writeline('token 1: ' || rdr.peek()); RETURN read_form(M, H, rdr); END; END reader; / show errors; ================================================ FILE: impls/plsql/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/wrap.sh $(dirname $0)/${STEP:-stepA_mal}.sql "${@}" ================================================ FILE: impls/plsql/step0_repl.sql ================================================ --\i init.sql @io.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS line CLOB; -- read FUNCTION READ(line varchar) RETURN varchar IS BEGIN RETURN line; END; -- eval FUNCTION EVAL(ast varchar, env varchar) RETURN varchar IS BEGIN RETURN ast; END; -- print FUNCTION PRINT(exp varchar) RETURN varchar IS BEGIN RETURN exp; END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), '')); END; BEGIN WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step1_read_print.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool line CLOB; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval FUNCTION EVAL(ast integer, env varchar) RETURN integer IS BEGIN RETURN ast; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), '')); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.writeline('closing stream 1'); io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step2_eval.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool TYPE env_T IS TABLE OF integer INDEX BY varchar2(100); repl_env env_T; line CLOB; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(ast integer, env env_T) RETURN integer; FUNCTION do_core_func(fn integer, args mal_vals) RETURN integer; FUNCTION eval_ast(ast integer, env env_T) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env(TREAT(M(ast) AS mal_str_T).val_str); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(ast integer, env env_T) RETURN integer IS el integer; f integer; args mal_vals; BEGIN IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; RETURN do_core_func(f, args); END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION mal_add(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_subtract(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_multiply(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_divide(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION do_core_func(fn integer, args mal_vals) RETURN integer IS fname varchar(256); BEGIN IF M(fn).type_id <> 11 THEN raise_application_error(-20004, 'Invalid function call', TRUE); END IF; fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = '+' THEN RETURN mal_add(args); WHEN fname = '-' THEN RETURN mal_subtract(args); WHEN fname = '*' THEN RETURN mal_multiply(args); WHEN fname = '/' THEN RETURN mal_divide(args); ELSE raise_application_error(-20004, 'Invalid function call', TRUE); END CASE; END; FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); repl_env('+') := types.func(M, '+'); repl_env('-') := types.func(M, '-'); repl_env('*') := types.func(M, '*'); repl_env('/') := types.func(M, '/'); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step3_env.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(ast integer, env integer) RETURN integer; FUNCTION do_core_func(fn integer, args mal_vals) RETURN integer; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(ast integer, env integer) RETURN integer IS el integer; a0 integer; a0sym varchar2(256); seq mal_vals; let_env integer; i integer; f integer; args mal_vals; BEGIN IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; RETURN EVAL(types.nth(M, ast, 2), let_env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; RETURN do_core_func(f, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION mal_add(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_subtract(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_multiply(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION mal_divide(args mal_vals) RETURN integer IS BEGIN RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / TREAT(M(args(2)) AS mal_int_T).val_int); END; FUNCTION do_core_func(fn integer, args mal_vals) RETURN integer IS fname varchar(256); BEGIN IF M(fn).type_id <> 11 THEN raise_application_error(-20004, 'Invalid function call', TRUE); END IF; fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = '+' THEN RETURN mal_add(args); WHEN fname = '-' THEN RETURN mal_subtract(args); WHEN fname = '*' THEN RETURN mal_multiply(args); WHEN fname = '/' THEN RETURN mal_divide(args); ELSE raise_application_error(-20004, 'Invalid function call', TRUE); END CASE; END; FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '+'), types.func(M, '+')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '-'), types.func(M, '-')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*'), types.func(M, '*')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '/'), types.func(M, '/')); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step4_if_fn_do.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(ast integer, env integer) RETURN integer; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(ast integer, env integer) RETURN integer IS el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; i integer; f integer; fn_env integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; RETURN EVAL(types.nth(M, ast, 2), let_env); WHEN a0sym = 'do' THEN el := eval_ast(types.slice(M, ast, 1), env); RETURN types.nth(M, el, types.count(M, el)-1); WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN RETURN EVAL(types.nth(M, ast, 3), env); ELSE RETURN 1; -- nil END IF; ELSE RETURN EVAL(types.nth(M, ast, 2), env); END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); RETURN EVAL(malfn.ast, fn_env); ELSE RETURN core.do_core_func(M, H, f, args); END IF; END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step5_tco.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'do' THEN x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN core.do_core_func(M, H, f, args); END IF; END CASE; END LOOP; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step6_file.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; argv mal_vals; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'do' THEN x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN do_builtin(f, args); END IF; END CASE; END LOOP; END; -- hack to get around lack of function references -- functions that require special access to repl_env or EVAL -- are implemented directly here, otherwise, core.do_core_fn -- is called. FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS fname varchar2(100); val integer; f integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = 'do_eval' THEN RETURN EVAL(args(1), repl_env); WHEN fname = 'swap!' THEN val := TREAT(M(args(1)) AS mal_atom_T).val; f := args(2); -- slice one extra at the beginning that will be changed -- to the value of the atom fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; fargs(1) := val; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN types.atom_reset(M, args(1), val); ELSE RETURN core.do_core_func(M, H, fn, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; x := env_pkg.env_set(M, E, repl_env, types.symbol(M, 'eval'), types.func(M, 'do_eval')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*ARGV*'), types.slice(M, argv, 1)); -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); IF argv.COUNT() > 0 THEN BEGIN line := REP('(load-file "' || TREAT(M(argv(1)) AS mal_str_T).val_str || '")'); io.close(1); -- close output stream RETURN 0; EXCEPTION WHEN OTHERS THEN io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); io.close(1); -- close output stream RAISE; END; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step7_quote.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; argv mal_vals; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS a0 integer; BEGIN 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 eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; 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 x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN do_builtin(f, args); END IF; END CASE; END LOOP; END; -- hack to get around lack of function references -- functions that require special access to repl_env or EVAL -- are implemented directly here, otherwise, core.do_core_fn -- is called. FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS fname varchar2(100); val integer; f integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = 'do_eval' THEN RETURN EVAL(args(1), repl_env); WHEN fname = 'swap!' THEN val := TREAT(M(args(1)) AS mal_atom_T).val; f := args(2); -- slice one extra at the beginning that will be changed -- to the value of the atom fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; fargs(1) := val; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN types.atom_reset(M, args(1), val); ELSE RETURN core.do_core_func(M, H, fn, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; x := env_pkg.env_set(M, E, repl_env, types.symbol(M, 'eval'), types.func(M, 'do_eval')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*ARGV*'), types.slice(M, argv, 1)); -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); IF argv.COUNT() > 0 THEN BEGIN line := REP('(load-file "' || TREAT(M(argv(1)) AS mal_str_T).val_str || '")'); io.close(1); -- close output stream RETURN 0; EXCEPTION WHEN OTHERS THEN io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); io.close(1); -- close output stream RAISE; END; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step8_macros.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; argv mal_vals; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS a0 integer; BEGIN 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; mac integer; BEGIN IF M(ast).type_id = 8 THEN a0 := types.nth(M, ast, 0); IF M(a0).type_id = 7 AND env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN mac := env_pkg.env_get(M, E, env, a0); IF M(mac).type_id = 12 THEN RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; END IF; END IF; END IF; RETURN FALSE; END; FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS ast integer; mac integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN ast := orig_ast; WHILE is_macro_call(ast, env) LOOP mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; if M(mac).type_id = 12 THEN malfn := TREAT(M(mac) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); ast := EVAL(malfn.ast, fn_env); ELSE ast := do_builtin(mac, fargs); END IF; END LOOP; RETURN ast; END; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; -- apply ast := macroexpand(ast, env); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; 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 x := EVAL(types.nth(M, ast, 2), env); malfn := TREAT(M(x) as mal_func_T); malfn.is_macro := 1; M(x) := malfn; RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), x); WHEN a0sym = 'macroexpand' THEN RETURN macroexpand(types.nth(M, ast, 1), env); WHEN a0sym = 'do' THEN x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN do_builtin(f, args); END IF; END CASE; END LOOP; END; -- hack to get around lack of function references -- functions that require special access to repl_env or EVAL -- are implemented directly here, otherwise, core.do_core_fn -- is called. FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS fname varchar2(100); val integer; f integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = 'do_eval' THEN RETURN EVAL(args(1), repl_env); WHEN fname = 'swap!' THEN val := TREAT(M(args(1)) AS mal_atom_T).val; f := args(2); -- slice one extra at the beginning that will be changed -- to the value of the atom fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; fargs(1) := val; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN types.atom_reset(M, args(1), val); ELSE RETURN core.do_core_func(M, H, fn, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; x := env_pkg.env_set(M, E, repl_env, types.symbol(M, 'eval'), types.func(M, 'do_eval')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*ARGV*'), types.slice(M, argv, 1)); -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); IF argv.COUNT() > 0 THEN BEGIN line := REP('(load-file "' || TREAT(M(argv(1)) AS mal_str_T).val_str || '")'); io.close(1); -- close output stream RETURN 0; EXCEPTION WHEN OTHERS THEN io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); io.close(1); -- close output stream RAISE; END; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/step9_try.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; argv mal_vals; err_val integer; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS a0 integer; BEGIN 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; mac integer; BEGIN IF M(ast).type_id = 8 THEN a0 := types.nth(M, ast, 0); IF M(a0).type_id = 7 AND env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN mac := env_pkg.env_get(M, E, env, a0); IF M(mac).type_id = 12 THEN RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; END IF; END IF; END IF; RETURN FALSE; END; FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS ast integer; mac integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN ast := orig_ast; WHILE is_macro_call(ast, env) LOOP mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; if M(mac).type_id = 12 THEN malfn := TREAT(M(mac) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); ast := EVAL(malfn.ast, fn_env); ELSE ast := do_builtin(mac, fargs); END IF; END LOOP; RETURN ast; END; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; try_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; -- apply ast := macroexpand(ast, env); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; 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 x := EVAL(types.nth(M, ast, 2), env); malfn := TREAT(M(x) as mal_func_T); malfn.is_macro := 1; M(x) := malfn; RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), x); WHEN a0sym = 'macroexpand' THEN RETURN macroexpand(types.nth(M, ast, 1), env); WHEN a0sym = 'try*' THEN DECLARE exc integer; a2 integer := -1; a20 integer := -1; a20sym varchar2(100); BEGIN RETURN EVAL(types.nth(M, ast, 1), env); EXCEPTION WHEN OTHERS THEN IF types.count(M, ast) > 2 THEN a2 := types.nth(M, ast, 2); IF M(a2).type_id = 8 THEN a20 := types.nth(M, a2, 0); IF M(a20).type_id = 7 THEN a20sym := TREAT(M(a20) AS mal_str_T).val_str; END IF; END IF; END IF; IF a20sym = 'catch*' THEN IF SQLCODE <> -20000 THEN IF SQLCODE < -20000 AND SQLCODE > -20100 THEN exc := types.string(M, REGEXP_REPLACE(SQLERRM, '^ORA-200[0-9][0-9]: ')); ELSE exc := types.string(M, SQLERRM); END IF; ELSE -- mal throw exc := err_val; err_val := NULL; END IF; try_env := env_pkg.env_new(M, E, env, types.list(M, types.nth(M, a2, 1)), mal_vals(exc)); RETURN EVAL(types.nth(M, a2, 2), try_env); END IF; RAISE; -- not handled, re-raise the exception END; WHEN a0sym = 'do' THEN x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN do_builtin(f, args); END IF; END CASE; END LOOP; END; -- hack to get around lack of function references -- functions that require special access to repl_env or EVAL -- are implemented directly here, otherwise, core.do_core_fn -- is called. FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS fname varchar2(100); val integer; f integer; malfn mal_func_T; fargs mal_vals; fn_env integer; i integer; tseq mal_vals; BEGIN fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = 'do_eval' THEN RETURN EVAL(args(1), repl_env); WHEN fname = 'swap!' THEN val := TREAT(M(args(1)) AS mal_atom_T).val; f := args(2); -- slice one extra at the beginning that will be changed -- to the value of the atom fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; fargs(1) := val; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN types.atom_reset(M, args(1), val); WHEN fname = 'apply' THEN f := args(1); fargs := mal_vals(); tseq := TREAT(M(args(args.COUNT())) AS mal_seq_T).val_seq; fargs.EXTEND(args.COUNT()-2 + tseq.COUNT()); FOR i IN 1..args.COUNT()-2 LOOP fargs(i) := args(i+1); END LOOP; FOR i IN 1..tseq.COUNT() LOOP fargs(args.COUNT()-2 + i) := tseq(i); END LOOP; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN val; WHEN fname = 'map' THEN f := args(1); fargs := TREAT(M(args(2)) AS mal_seq_T).val_seq; tseq := mal_vals(); tseq.EXTEND(fargs.COUNT()); IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); FOR i IN 1..fargs.COUNT() LOOP fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, mal_vals(fargs(i))); tseq(i) := EVAL(malfn.ast, fn_env); END LOOP; ELSE FOR i IN 1..fargs.COUNT() LOOP tseq(i) := do_builtin(f, mal_vals(fargs(i))); END LOOP; END IF; RETURN types.seq(M, 8, tseq); WHEN fname = 'throw' THEN err_val := args(1); raise_application_error(-20000, 'MalException', TRUE); ELSE RETURN core.do_core_func(M, H, fn, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; x := env_pkg.env_set(M, E, repl_env, types.symbol(M, 'eval'), types.func(M, 'do_eval')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*ARGV*'), types.slice(M, argv, 1)); -- core.mal: defined using the language itself line := REP('(def! not (fn* (a) (if a false true)))'); line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); IF argv.COUNT() > 0 THEN BEGIN line := REP('(load-file "' || TREAT(M(argv(1)) AS mal_str_T).val_str || '")'); io.close(1); -- close output stream RETURN 0; EXCEPTION WHEN OTHERS THEN io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); io.close(1); -- close output stream RAISE; END; END IF; WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; IF SQLCODE <> -20000 THEN io.writeline('Error: ' || SQLERRM); ELSE io.writeline('Error: ' || printer.pr_str(M, H, err_val)); END IF; io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/stepA_mal.sql ================================================ @io.sql @types.sql @reader.sql @printer.sql @env.sql @core.sql CREATE OR REPLACE PACKAGE mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; END mal; / CREATE OR REPLACE PACKAGE BODY mal IS FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS M types.mal_table; -- general mal value memory pool H types.map_entry_table; -- hashmap memory pool E env_pkg.env_entry_table; -- mal env memory pool repl_env integer; x integer; line CLOB; core_ns core_ns_T; cidx integer; argv mal_vals; err_val integer; -- read FUNCTION READ(line varchar) RETURN integer IS BEGIN RETURN reader.read_str(M, H, line); END; -- eval -- forward declarations FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS a0 integer; BEGIN 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; mac integer; BEGIN IF M(ast).type_id = 8 THEN a0 := types.nth(M, ast, 0); IF M(a0).type_id = 7 AND env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN mac := env_pkg.env_get(M, E, env, a0); IF M(mac).type_id = 12 THEN RETURN TREAT(M(mac) AS mal_func_T).is_macro > 0; END IF; END IF; END IF; RETURN FALSE; END; FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS ast integer; mac integer; malfn mal_func_T; fargs mal_vals; fn_env integer; BEGIN ast := orig_ast; WHILE is_macro_call(ast, env) LOOP mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0)); fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_T).val_seq; if M(mac).type_id = 12 THEN malfn := TREAT(M(mac) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); ast := EVAL(malfn.ast, fn_env); ELSE ast := do_builtin(mac, fargs); END IF; END LOOP; RETURN ast; END; FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; new_seq mal_vals; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); BEGIN IF M(ast).type_id = 7 THEN RETURN env_pkg.env_get(M, E, env, ast); ELSIF M(ast).type_id IN (8,9) THEN old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; new_seq := mal_vals(); new_seq.EXTEND(old_seq.COUNT); FOR i IN 1..old_seq.COUNT LOOP new_seq(i) := EVAL(old_seq(i), env); END LOOP; RETURN types.seq(M, M(ast).type_id, new_seq); ELSIF M(ast).type_id IN (10) THEN new_hm := types.hash_map(M, H, mal_vals()); old_midx := TREAT(M(ast) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := EVAL(H(old_midx)(k), env); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; ELSE RETURN ast; END IF; END; FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS ast integer := orig_ast; env integer := orig_env; el integer; a0 integer; a0sym varchar2(100); seq mal_vals; let_env integer; try_env integer; i integer; f integer; cond integer; malfn mal_func_T; args mal_vals; BEGIN WHILE TRUE LOOP -- io.writeline('EVAL: ' || printer.pr_str(M, H, ast)); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; -- apply ast := macroexpand(ast, env); IF M(ast).type_id <> 8 THEN RETURN eval_ast(ast, env); END IF; IF types.count(M, ast) = 0 THEN RETURN ast; -- empty list just returned END IF; -- apply a0 := types.first(M, ast); if M(a0).type_id = 7 THEN -- symbol a0sym := TREAT(M(a0) AS mal_str_T).val_str; ELSE a0sym := '__<*fn*>__'; END IF; CASE WHEN a0sym = 'def!' THEN RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); WHEN a0sym = 'let*' THEN let_env := env_pkg.env_new(M, E, env); seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; i := 1; WHILE i <= seq.COUNT LOOP x := env_pkg.env_set(M, E, let_env, seq(i), EVAL(seq(i+1), let_env)); i := i + 2; END LOOP; env := let_env; 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 x := EVAL(types.nth(M, ast, 2), env); malfn := TREAT(M(x) as mal_func_T); malfn.is_macro := 1; M(x) := malfn; RETURN env_pkg.env_set(M, E, env, types.nth(M, ast, 1), x); WHEN a0sym = 'macroexpand' THEN RETURN macroexpand(types.nth(M, ast, 1), env); WHEN a0sym = 'try*' THEN DECLARE exc integer; a2 integer := -1; a20 integer := -1; a20sym varchar2(100); BEGIN RETURN EVAL(types.nth(M, ast, 1), env); EXCEPTION WHEN OTHERS THEN IF types.count(M, ast) > 2 THEN a2 := types.nth(M, ast, 2); IF M(a2).type_id = 8 THEN a20 := types.nth(M, a2, 0); IF M(a20).type_id = 7 THEN a20sym := TREAT(M(a20) AS mal_str_T).val_str; END IF; END IF; END IF; IF a20sym = 'catch*' THEN IF SQLCODE <> -20000 THEN IF SQLCODE < -20000 AND SQLCODE > -20100 THEN exc := types.string(M, REGEXP_REPLACE(SQLERRM, '^ORA-200[0-9][0-9]: ')); ELSE exc := types.string(M, SQLERRM); END IF; ELSE -- mal throw exc := err_val; err_val := NULL; END IF; try_env := env_pkg.env_new(M, E, env, types.list(M, types.nth(M, a2, 1)), mal_vals(exc)); RETURN EVAL(types.nth(M, a2, 2), try_env); END IF; RAISE; -- not handled, re-raise the exception END; WHEN a0sym = 'do' THEN x := types.slice(M, ast, 1, types.count(M, ast)-2); x := eval_ast(x, env); ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO WHEN a0sym = 'if' THEN cond := EVAL(types.nth(M, ast, 1), env); IF cond = 1 OR cond = 2 THEN -- nil or false IF types.count(M, ast) > 3 THEN ast := types.nth(M, ast, 3); -- TCO ELSE RETURN 1; -- nil END IF; ELSE ast := types.nth(M, ast, 2); -- TCO END IF; WHEN a0sym = 'fn*' THEN RETURN types.malfunc(M, types.nth(M, ast, 2), types.nth(M, ast, 1), env); ELSE el := eval_ast(ast, env); f := types.first(M, el); args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); env := env_pkg.env_new(M, E, malfn.env, malfn.params, args); ast := malfn.ast; -- TCO ELSE RETURN do_builtin(f, args); END IF; END CASE; END LOOP; END; -- hack to get around lack of function references -- functions that require special access to repl_env or EVAL -- are implemented directly here, otherwise, core.do_core_fn -- is called. FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS fname varchar2(100); val integer; f integer; malfn mal_func_T; fargs mal_vals; fn_env integer; i integer; tseq mal_vals; BEGIN fname := TREAT(M(fn) AS mal_str_T).val_str; CASE WHEN fname = 'do_eval' THEN RETURN EVAL(args(1), repl_env); WHEN fname = 'swap!' THEN val := TREAT(M(args(1)) AS mal_atom_T).val; f := args(2); -- slice one extra at the beginning that will be changed -- to the value of the atom fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; fargs(1) := val; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN types.atom_reset(M, args(1), val); WHEN fname = 'apply' THEN f := args(1); fargs := mal_vals(); tseq := TREAT(M(args(args.COUNT())) AS mal_seq_T).val_seq; fargs.EXTEND(args.COUNT()-2 + tseq.COUNT()); FOR i IN 1..args.COUNT()-2 LOOP fargs(i) := args(i+1); END LOOP; FOR i IN 1..tseq.COUNT() LOOP fargs(args.COUNT()-2 + i) := tseq(i); END LOOP; IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, fargs); val := EVAL(malfn.ast, fn_env); ELSE val := do_builtin(f, fargs); END IF; RETURN val; WHEN fname = 'map' THEN f := args(1); fargs := TREAT(M(args(2)) AS mal_seq_T).val_seq; tseq := mal_vals(); tseq.EXTEND(fargs.COUNT()); IF M(f).type_id = 12 THEN malfn := TREAT(M(f) AS mal_func_T); FOR i IN 1..fargs.COUNT() LOOP fn_env := env_pkg.env_new(M, E, malfn.env, malfn.params, mal_vals(fargs(i))); tseq(i) := EVAL(malfn.ast, fn_env); END LOOP; ELSE FOR i IN 1..fargs.COUNT() LOOP tseq(i) := do_builtin(f, mal_vals(fargs(i))); END LOOP; END IF; RETURN types.seq(M, 8, tseq); WHEN fname = 'throw' THEN err_val := args(1); raise_application_error(-20000, 'MalException', TRUE); ELSE RETURN core.do_core_func(M, H, fn, args); END CASE; END; -- print FUNCTION PRINT(exp integer) RETURN varchar IS BEGIN RETURN printer.pr_str(M, H, exp); END; -- repl FUNCTION REP(line varchar) RETURN varchar IS BEGIN RETURN PRINT(EVAL(READ(line), repl_env)); END; BEGIN -- initialize memory pools M := types.mem_new(); H := types.map_entry_table(); E := env_pkg.env_entry_table(); repl_env := env_pkg.env_new(M, E, NULL); argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; -- core.EXT: defined using PL/SQL core_ns := core.get_core_ns(); FOR cidx IN 1..core_ns.COUNT LOOP x := env_pkg.env_set(M, E, repl_env, types.symbol(M, core_ns(cidx)), types.func(M, core_ns(cidx))); END LOOP; x := env_pkg.env_set(M, E, repl_env, types.symbol(M, 'eval'), types.func(M, 'do_eval')); x := env_pkg.env_set(M, E, repl_env, types.symbol(M, '*ARGV*'), types.slice(M, argv, 1)); -- core.mal: defined using the language itself line := REP('(def! *host-language* "PL/SQL")'); line := REP('(def! not (fn* (a) (if a false true)))'); line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))'); line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))'); IF argv.COUNT() > 0 THEN BEGIN line := REP('(load-file "' || TREAT(M(argv(1)) AS mal_str_T).val_str || '")'); io.close(1); -- close output stream RETURN 0; EXCEPTION WHEN OTHERS THEN io.writeline('Error: ' || SQLERRM); io.writeline(dbms_utility.format_error_backtrace); io.close(1); -- close output stream RAISE; END; END IF; line := REP('(println (str "Mal [" *host-language* "]"))'); WHILE true LOOP BEGIN line := io.readline('user> ', 0); IF line = EMPTY_CLOB() THEN CONTINUE; END IF; IF line IS NOT NULL THEN io.writeline(REP(line)); END IF; EXCEPTION WHEN OTHERS THEN IF SQLCODE = -20001 THEN -- io read stream closed io.close(1); -- close output stream RETURN 0; END IF; IF SQLCODE <> -20000 THEN io.writeline('Error: ' || SQLERRM); ELSE io.writeline('Error: ' || printer.pr_str(M, H, err_val)); END IF; io.writeline(dbms_utility.format_error_backtrace); END; END LOOP; END; END mal; / show errors; quit; ================================================ FILE: impls/plsql/types.sql ================================================ -- --------------------------------------------------------- -- persistent values BEGIN EXECUTE IMMEDIATE 'DROP TYPE mal_T FORCE'; EXCEPTION WHEN OTHERS THEN IF SQLCODE != -4043 THEN RAISE; END IF; END; / -- list of types for type_id -- 0: nil -- 1: false -- 2: true -- 3: integer -- 4: float -- 5: string -- 6: long string (CLOB) -- 7: symbol -- 8: list -- 9: vector -- 10: hashmap -- 11: function -- 12: malfunc -- 13: atom -- nil (0), false (1), true (2) CREATE OR REPLACE TYPE mal_T FORCE AS OBJECT ( type_id integer ) NOT FINAL; / -- general nested table of mal values (integers) -- used frequently for argument passing CREATE OR REPLACE TYPE mal_vals FORCE AS TABLE OF integer; / -- integer (3) CREATE OR REPLACE TYPE mal_int_T FORCE UNDER mal_T ( val_int integer ) FINAL; / -- string/keyword (5,6), symbol (7) CREATE OR REPLACE TYPE mal_str_T FORCE UNDER mal_T ( val_str varchar2(4000) ) NOT FINAL; / CREATE OR REPLACE TYPE mal_long_str_T FORCE UNDER mal_str_T ( val_long_str CLOB -- long character object (for larger than 4000 chars) ) FINAL; / show errors; -- list (8), vector (9) CREATE OR REPLACE TYPE mal_seq_T FORCE UNDER mal_T ( val_seq mal_vals, meta integer ) FINAL; / CREATE OR REPLACE TYPE mal_map_T FORCE UNDER mal_T ( map_idx integer, -- index into map entry table meta integer ) FINAL; / -- malfunc (12) CREATE OR REPLACE TYPE mal_func_T FORCE UNDER mal_T ( ast integer, params integer, env integer, is_macro integer, meta integer ) FINAL; / -- atom (13) CREATE OR REPLACE TYPE mal_atom_T FORCE UNDER mal_T ( val integer -- index into mal_table ); / -- --------------------------------------------------------- CREATE OR REPLACE PACKAGE types IS -- memory pool for mal_objects (non-hash-map) TYPE mal_table IS TABLE OF mal_T; -- memory pool for hash-map objects TYPE map_entry IS TABLE OF integer INDEX BY varchar2(256); TYPE map_entry_table IS TABLE OF map_entry; -- general functions FUNCTION mem_new RETURN mal_table; FUNCTION tf(val boolean) RETURN integer; FUNCTION equal_Q(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, a integer, b integer) RETURN boolean; FUNCTION clone(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, obj integer, meta integer DEFAULT 1) RETURN integer; -- scalar functions FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer; FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean; -- sequence functions FUNCTION seq(M IN OUT NOCOPY mal_table, type_id integer, items mal_vals, meta integer DEFAULT 1) RETURN integer; FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer; FUNCTION list(M IN OUT NOCOPY mal_table, a integer) RETURN integer; FUNCTION list(M IN OUT NOCOPY mal_table, a integer, b integer) RETURN integer; FUNCTION list(M IN OUT NOCOPY mal_table, a integer, b integer, c integer) RETURN integer; FUNCTION first(M IN OUT NOCOPY mal_table, seq integer) RETURN integer; FUNCTION slice(M IN OUT NOCOPY mal_table, seq integer, idx integer, last integer DEFAULT NULL) RETURN integer; FUNCTION slice(M IN OUT NOCOPY mal_table, items mal_vals, idx integer) RETURN integer; FUNCTION islice(items mal_vals, idx integer) RETURN mal_vals; FUNCTION nth(M IN OUT NOCOPY mal_table, seq integer, idx integer) RETURN integer; FUNCTION count(M IN OUT NOCOPY mal_table, seq integer) RETURN integer; FUNCTION atom_new(M IN OUT NOCOPY mal_table, val integer) RETURN integer; FUNCTION atom_reset(M IN OUT NOCOPY mal_table, atm integer, val integer) RETURN integer; -- hash-map functions FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, midx integer, kvs mal_vals) RETURN integer; FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, midx integer, ks mal_vals) RETURN integer; FUNCTION hash_map(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, kvs mal_vals, meta integer DEFAULT 1) RETURN integer; -- function functions FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer; FUNCTION malfunc(M IN OUT NOCOPY mal_table, ast integer, params integer, env integer, is_macro integer DEFAULT 0, meta integer DEFAULT 1) RETURN integer; END types; / show errors; CREATE OR REPLACE PACKAGE BODY types IS -- --------------------------------------------------------- -- general functions FUNCTION mem_new RETURN mal_table IS BEGIN -- initialize mal type memory pool -- 1 -> nil -- 2 -> false -- 3 -> true RETURN mal_table(mal_T(0), mal_T(1), mal_T(2)); END; FUNCTION tf(val boolean) RETURN integer IS BEGIN IF val THEN RETURN 3; -- true ELSE RETURN 2; -- false END IF; END; FUNCTION equal_Q(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, a integer, b integer) RETURN boolean IS atyp integer; btyp integer; aseq mal_vals; bseq mal_vals; amidx integer; bmidx integer; i integer; k varchar2(256); BEGIN atyp := M(a).type_id; btyp := M(b).type_id; IF NOT (atyp = btyp OR (atyp IN (8,9) AND btyp IN (8,9))) THEN RETURN FALSE; END IF; CASE WHEN atyp IN (0,1,2) THEN RETURN TRUE; WHEN atyp = 3 THEN RETURN TREAT(M(a) AS mal_int_T).val_int = TREAT(M(b) AS mal_int_T).val_int; WHEN atyp IN (5,6,7) THEN IF TREAT(M(a) AS mal_str_T).val_str IS NULL AND TREAT(M(b) AS mal_str_T).val_str IS NULL THEN RETURN TRUE; ELSE RETURN TREAT(M(a) AS mal_str_T).val_str = TREAT(M(b) AS mal_str_T).val_str; END IF; WHEN atyp IN (8,9) THEN aseq := TREAT(M(a) AS mal_seq_T).val_seq; bseq := TREAT(M(b) AS mal_seq_T).val_seq; IF aseq.COUNT <> bseq.COUNT THEN RETURN FALSE; END IF; FOR i IN 1..aseq.COUNT LOOP IF NOT equal_Q(M, H, aseq(i), bseq(i)) THEN RETURN FALSE; END IF; END LOOP; RETURN TRUE; WHEN atyp = 10 THEN amidx := TREAT(M(a) AS mal_map_T).map_idx; bmidx := TREAT(M(b) AS mal_map_T).map_idx; IF H(amidx).COUNT() <> H(bmidx).COUNT() THEN RETURN FALSE; END IF; k := H(amidx).FIRST(); WHILE k IS NOT NULL LOOP IF H(amidx)(k) IS NULL OR H(bmidx)(k) IS NULL THEN RETURN FALSE; END IF; IF NOT equal_Q(M, H, H(amidx)(k), H(bmidx)(k)) THEN RETURN FALSE; END IF; k := H(amidx).NEXT(k); END LOOP; RETURN TRUE; ELSE RETURN FALSE; END CASE; END; FUNCTION clone(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, obj integer, meta integer DEFAULT 1) RETURN integer IS type_id integer; new_hm integer; old_midx integer; new_midx integer; k varchar2(256); malfn mal_func_T; BEGIN type_id := M(obj).type_id; CASE WHEN type_id IN (8,9) THEN -- list/vector RETURN seq(M, type_id, TREAT(M(obj) AS mal_seq_T).val_seq, meta); WHEN type_id = 10 THEN -- hash-map new_hm := types.hash_map(M, H, mal_vals(), meta); old_midx := TREAT(M(obj) AS mal_map_T).map_idx; new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; k := H(old_midx).FIRST(); WHILE k IS NOT NULL LOOP H(new_midx)(k) := H(old_midx)(k); k := H(old_midx).NEXT(k); END LOOP; RETURN new_hm; WHEN type_id = 12 THEN -- mal function malfn := TREAT(M(obj) AS mal_func_T); RETURN types.malfunc(M, malfn.ast, malfn.params, malfn.env, malfn.is_macro, meta); ELSE raise_application_error(-20008, 'clone not supported for type ' || type_id, TRUE); END CASE; END; -- --------------------------------------------------------- -- scalar functions FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_int_T(3, num); RETURN M.COUNT(); END; FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS BEGIN M.EXTEND(); IF LENGTH(name) <= 4000 THEN M(M.COUNT()) := mal_str_T(5, name); ELSE M(M.COUNT()) := mal_long_str_T(6, NULL, name); END IF; RETURN M.COUNT(); END; FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS str CLOB; BEGIN IF M(val).type_id IN (5,6) THEN IF M(val).type_id = 5 THEN str := TREAT(M(val) AS mal_str_T).val_str; ELSE str := TREAT(M(val) AS mal_long_str_T).val_long_str; END IF; IF str IS NULL OR str = EMPTY_CLOB() OR SUBSTR(str, 1, 1) <> chr(127) THEN RETURN TRUE; ELSE RETURN FALSE; END IF; ELSE RETURN FALSE; END IF; END; FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_str_T(7, name); RETURN M.COUNT(); END; FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_str_T(5, chr(127) || name); RETURN M.COUNT(); END; FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS str CLOB; BEGIN IF M(val).type_id = 5 THEN str := TREAT(M(val) AS mal_str_T).val_str; IF LENGTH(str) > 0 AND SUBSTR(str, 1, 1) = chr(127) THEN RETURN TRUE; ELSE RETURN FALSE; END IF; ELSE RETURN FALSE; END IF; END; FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS str CLOB; BEGIN IF M(val).type_id IN (3,4) THEN RETURN TRUE; ELSE RETURN FALSE; END IF; END; FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS str CLOB; BEGIN IF M(val).type_id = 11 THEN RETURN TRUE; ELSIF M(val).type_id = 12 THEN RETURN TREAT(M(val) AS mal_func_T).is_macro = 0; ELSE RETURN FALSE; END IF; END; FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS str CLOB; BEGIN IF M(val).type_id = 12 THEN RETURN TREAT(M(val) AS mal_func_T).is_macro > 0; ELSE RETURN FALSE; END IF; END; -- --------------------------------------------------------- -- sequence functions FUNCTION seq(M IN OUT NOCOPY mal_table, type_id integer, items mal_vals, meta integer DEFAULT 1) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_seq_T(type_id, items, meta); RETURN M.COUNT(); END; -- list: -- return a mal list FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, mal_vals(), 1); RETURN M.COUNT(); END; FUNCTION list(M IN OUT NOCOPY mal_table, a integer) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, mal_vals(a), 1); RETURN M.COUNT(); END; FUNCTION list(M IN OUT NOCOPY mal_table, a integer, b integer) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b), 1); RETURN M.COUNT(); END; FUNCTION list(M IN OUT NOCOPY mal_table, a integer, b integer, c integer) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b, c), 1); RETURN M.COUNT(); END; FUNCTION first(M IN OUT NOCOPY mal_table, seq integer) RETURN integer IS BEGIN RETURN TREAT(M(seq) AS mal_seq_T).val_seq(1); END; FUNCTION slice(M IN OUT NOCOPY mal_table, seq integer, idx integer, last integer DEFAULT NULL) RETURN integer IS old_items mal_vals; new_items mal_vals; i integer; final_idx integer; BEGIN old_items := TREAT(M(seq) AS mal_seq_T).val_seq; new_items := mal_vals(); IF last IS NULL THEN final_idx := old_items.COUNT(); ELSE final_idx := last + 1; END IF; IF final_idx > idx THEN new_items.EXTEND(final_idx - idx); FOR i IN idx+1..final_idx LOOP new_items(i-idx) := old_items(i); END LOOP; END IF; M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, new_items, 1); RETURN M.COUNT(); END; FUNCTION slice(M IN OUT NOCOPY mal_table, items mal_vals, idx integer) RETURN integer IS new_items mal_vals; BEGIN new_items := islice(items, idx); M.EXTEND(); M(M.COUNT()) := mal_seq_T(8, new_items, 1); RETURN M.COUNT(); END; FUNCTION islice(items mal_vals, idx integer) RETURN mal_vals IS new_items mal_vals; i integer; BEGIN new_items := mal_vals(); IF items.COUNT > idx THEN new_items.EXTEND(items.COUNT - idx); FOR i IN idx+1..items.COUNT LOOP new_items(i-idx) := items(i); END LOOP; END IF; RETURN new_items; END; FUNCTION nth(M IN OUT NOCOPY mal_table, seq integer, idx integer) RETURN integer IS BEGIN RETURN TREAT(M(seq) AS mal_seq_T).val_seq(idx+1); END; FUNCTION count(M IN OUT NOCOPY mal_table, seq integer) RETURN integer IS BEGIN RETURN TREAT(M(seq) AS mal_seq_T).val_seq.COUNT; END; -- --------------------------------------------------------- -- hash-map functions FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, midx integer, kvs mal_vals) RETURN integer IS i integer; BEGIN IF MOD(kvs.COUNT(), 2) = 1 THEN raise_application_error(-20007, 'odd number of arguments to assoc', TRUE); END IF; i := 1; WHILE i <= kvs.COUNT() LOOP H(midx)(TREAT(M(kvs(i)) AS mal_str_T).val_str) := kvs(i+1); i := i + 2; END LOOP; RETURN midx; END; FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, midx integer, ks mal_vals) RETURN integer IS i integer; BEGIN FOR i IN 1..ks.COUNT() LOOP H(midx).DELETE(TREAT(M(ks(i)) AS mal_str_T).val_str); END LOOP; RETURN midx; END; FUNCTION hash_map(M IN OUT NOCOPY mal_table, H IN OUT NOCOPY map_entry_table, kvs mal_vals, meta integer DEFAULT 1) RETURN integer IS midx integer; BEGIN H.EXTEND(); midx := H.COUNT(); midx := assoc_BANG(M, H, midx, kvs); M.EXTEND(); M(M.COUNT()) := mal_map_T(10, midx, meta); RETURN M.COUNT(); END; -- --------------------------------------------------------- -- function functions FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_str_T(11, name); RETURN M.COUNT(); END; FUNCTION malfunc(M IN OUT NOCOPY mal_table, ast integer, params integer, env integer, is_macro integer DEFAULT 0, meta integer DEFAULT 1) RETURN integer IS BEGIN M.EXTEND(); M(M.COUNT()) := mal_func_T(12, ast, params, env, is_macro, meta); RETURN M.COUNT(); END; -- --------------------------------------------------------- -- atom functions FUNCTION atom_new(M IN OUT NOCOPY mal_table, val integer) RETURN integer IS aidx integer; BEGIN M.EXTEND(); M(M.COUNT()) := mal_atom_T(13, val); RETURN M.COUNT(); END; FUNCTION atom_reset(M IN OUT NOCOPY mal_table, atm integer, val integer) RETURN integer IS BEGIN M(atm) := mal_atom_T(13, val); RETURN val; END; END types; / show errors; ================================================ FILE: impls/plsql/wrap.sh ================================================ #!/usr/bin/env bash RL_HISTORY_FILE=${HOME}/.mal-history SKIP_INIT="${SKIP_INIT:-}" ORACLE_LOGON=${ORACLE_LOGON:-system/oracle} SQLPLUS="sqlplus -S ${ORACLE_LOGON}" FILE_PID= cleanup() { trap - TERM QUIT INT EXIT #echo cleanup: ${FILE_PID} [ "${FILE_PID}" ] && kill ${FILE_PID} } trap "cleanup" TERM QUIT INT EXIT # Load the SQL code if [ -z "${SKIP_INIT}" ]; then out=$(echo "" | ${SQLPLUS} @$1) if echo "${out}" | grep -vs "^No errors.$" \ | grep -si error >/dev/null; then #if echo "${out}" | grep -si error >/dev/null; then echo "${out}" exit 1 fi fi # open I/O streams echo -e "BEGIN io.open(0); io.open(1); END;\n/" \ | ${SQLPLUS} >/dev/null # Stream from table to stdout ( while true; do out="$(echo "SELECT io.read(1) FROM dual;" \ | ${SQLPLUS} 2>/dev/null)" || break #echo "out: [${out}] (${#out})" echo "${out}" done ) & STDOUT_PID=$! # Perform readline input into stream table when requested ( [ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE} while true; do prompt=$(echo "SELECT io.wait_rl_prompt(0) FROM dual;" \ | ${SQLPLUS} 2>/dev/null) || break # Prompt is returned single-quoted because sqlplus trims trailing # whitespace. Remove the single quotes from the beginning and end: prompt=${prompt%\'} prompt=${prompt#\'} #echo "prompt: [${prompt}]" IFS= read -u 0 -r -e -p "${prompt}" line || break if [ "${line}" ]; then history -s -- "${line}" # add to history history -a ${RL_HISTORY_FILE} # save history to file fi # Escape (double) single quotes per SQL norm line=${line//\'/\'\'} #echo "line: [${line}]" ( echo -n "BEGIN io.writeline('${line}', 0); END;"; echo -en "\n/" ) \ | ${SQLPLUS} >/dev/null || break done echo -e "BEGIN io.close(0); END;\n/" \ | ${SQLPLUS} > /dev/null ) <&0 >&1 & # File read if requested ( while true; do files="$(echo "SELECT path FROM file_io WHERE in_or_out = 'in';" \ | ${SQLPLUS} 2>/dev/null \ | grep -v "^no rows selected")" || break for f in ${files}; do if [ ! -r ${f} ]; then echo "UPDATE file_io SET error = 'Cannot read ''${f}''' WHERE path = '${f}' AND in_or_out = 'in';" \ | ${SQLPLUS} >/dev/null continue; fi IFS= read -rd '' content < "${f}" # sqlplus limits lines to 2499 characters so split the update # into chunks of the file ORed together over multiple lines query="UPDATE file_io SET data = TO_CLOB('')" while [ -n "${content}" ]; do chunk="${content:0:2000}" content="${content:${#chunk}}" chunk="${chunk//\'/\'\'}" chunk="${chunk//$'\n'/\\n}" query="${query}"$'\n'" || TO_CLOB('${chunk}')" done query="${query}"$'\n'" WHERE path = '${f}' AND in_or_out = 'in';" echo "${query}" | ${SQLPLUS} > /dev/null #echo "file read: ${f}: ${?}" done sleep 1 done ) & FILE_PID=$! res=0 shift if [ $# -gt 0 ]; then # If there are command line arguments then run a command and exit args=$(for a in "$@"; do echo -n "\"$a\" "; done) echo -e "SELECT mal.MAIN('(${args})') FROM dual;" \ | ${SQLPLUS} > /dev/null res=$? else # Start main loop in the background echo "SELECT mal.MAIN() FROM dual;" \ | ${SQLPLUS} > /dev/null res=$? fi # Wait for output to flush wait ${STDOUT_PID} exit ${res} ================================================ FILE: impls/powershell/Dockerfile ================================================ FROM ubuntu:16.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Nothing additional needed for python RUN apt-get -y install libunwind8 libicu55 # For dist packaging RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ dpkg -i powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ rm powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb ENV HOME=/mal ================================================ FILE: impls/powershell/Makefile ================================================ all: true clean: ================================================ FILE: impls/powershell/core.psm1 ================================================ function time_ms { $ms = [double]::Parse((Get-Date (get-date).ToUniversalTime() -UFormat %s)) [int64] ($ms * 1000) } function get($hm, $key) { if ($hm -eq $null) { $null } else { $hm.values.Item($key) } } function concat { $res = @() foreach($a in $args) { $res = $res + $a.values } 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" } $lst.nth($idx) } function do_map($f, $l) { if (malfunc?($f)) { $f = $f.fn } new-list @($l.values | ForEach-Object { &$f $_ }) } function do_apply($f) { if (malfunc?($f)) { $f = $f.fn } if ($args.Count -gt 1) { $fargs = $args[0..($args.Count-2)] + $args[-1].values } else { $fargs = $args[$args.Count-1].values } &$f @fargs } function conj($lst) { if (list? $lst) { [Array]::Reverse($args) return new-list ($args + $lst.values) } else { return new-vector ($lst.values + $args) } } function seq($obj) { if ($obj -eq $null) { return $null } elseif (list? $obj) { if ($obj.values.Count -gt 0) { return $obj } else { return $null } } elseif (vector? $obj) { if ($obj.values.Count -gt 0) { return new-list $obj.values } else { return $null } } elseif (string? $obj) { if ($obj.Length -gt 0) { return new-list ($obj -split '')[1..$obj.Length] } else { return $null } return new-list $obj } else { throw "seq: called on non-sequence" } } function swap_BANG($a, $f) { if (malfunc?($f)) { $f = $f.fn } $fargs = @($a.value) + $args if ($fargs.Count -eq 0) { $a.value = &$f } else { $a.value = &$f @fargs } $a.value } $core_ns = @{ "=" = { param($a, $b); equal? $a $b }; "throw" = Get-Command mal_throw; "nil?" = { param($a); $a -eq $null }; "true?" = { param($a); $a -is [Boolean] -and $a -eq $true }; "false?" = { param($a); $a -is [Boolean] -and $a -eq $false }; "number?" = { param($a); $a -is [int32] }; "string?" = { param($a); string? $a }; "symbol" = Get-Command new-symbol; "symbol?" = { param($a); symbol? $a }; "keyword" = Get-Command new-keyword; "keyword?" = { param($a); keyword? $a }; "fn?" = { param($a); (fn? $a) -or ((malfunc? $a) -and (-not $a.macro)) }; "macro?" = { param($a); (malfunc? $a) -and $a.macro }; "pr-str" = { pr_seq $args $true " " }; "str" = { pr_seq $args $false "" }; "prn" = { Write-Host (pr_seq $args $true " "); $null }; "println" = { Write-Host (pr_seq $args $false " "); $null }; "read-string" = { read_str $args[0] }; "readline" = { Write-Host $args[0] -NoNewline; [Console]::Readline() }; "slurp" = { Get-Content -Path $args[0] -Raw }; "<" = { param($a, $b); $a -lt $b }; "<=" = { param($a, $b); $a -le $b }; ">" = { param($a, $b); $a -gt $b }; ">=" = { param($a, $b); $a -ge $b }; "+" = { param($a, $b); $a + $b }; "-" = { param($a, $b); $a - $b }; "*" = { param($a, $b); $a * $b }; "/" = { param($a, $b); $a / $b }; "time-ms" = Get-Command time_ms; "list" = { new-list $args }; "list?" = Get-Command list?; "vector" = { new-vector $args }; "vector?" = Get-Command vector?; "hash-map" = { new-hashmap $args }; "map?" = Get-Command hashmap?; "assoc" = { param($a); assoc_BANG $a.copy() $args }; "dissoc" = { param($a); dissoc_BANG $a.copy() $args }; "get" = { param($a,$b); get $a $b }; "contains?" = { param($a,$b); $a.values.Contains($b) }; "keys" = Get-Command keys; "vals" = Get-Command vals; "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() } }; "empty?" = { param($a); $a -eq $null -or $a.values.Count -eq 0 }; "count" = { param($a); $a.values.Count }; "apply" = Get-Command do_apply; "map" = Get-Command do_map; "conj" = Get-Command conj; "seq" = Get-Command seq; "meta" = { param($a); $a.meta }; "with-meta" = { param($a, $b); $c = $a.copy(); $c.meta = $b; $c }; "atom" = { param($a); new-atom($a) }; "atom?" = { param($a); atom?($a) }; "deref" = { param($a); $a.value }; "reset!" = { param($a, $b); $a.value = $b; $b }; "swap!" = Get-Command swap_BANG; } Export-ModuleMember -Variable core_ns ================================================ FILE: impls/powershell/env.psm1 ================================================ Import-Module $PSScriptRoot/types.psm1 Class Env { [HashTable] $data [Env] $outer Env([Env] $out, $binds, $exprs) { # Case-sensitive hash table $this.data = New-Object System.Collections.HashTable $this.outer = $out if ($binds -ne $null) { for ($i = 0; $i -lt $binds.Length; $i++) { if ($binds[$i].value -eq "&") { if ($exprs.Length -gt $i) { $rest = $exprs[$i..($exprs.Length-1)] } else { $rest = @() } $this.data[$binds[($i+1)].value] = new-list($rest) break } else { $this.data[$binds[$i].value] = $exprs[$i] } } } } [Object] set($key, $value) { $this.data[$key] = $value return $value } [Env] find($key) { if ($this.data.Contains($key)) { return $this } elseif ($this.outer -ne $null) { return $this.outer.find($key) } else { return $null } } [Object] get($key) { $e = $this.find($key) if ($e -ne $null) { return $e.data[$key] } else { throw "'$($key)' not found" } } } function new-env([Env] $out, $binds, $exprs) { [Env]::new($out, $binds, $exprs) } ================================================ FILE: impls/powershell/printer.psm1 ================================================ function pr_str { param($obj, $print_readably = $true) if ($obj -eq $null) { return "nil" } switch ($obj.GetType().Name) { "String" { if ($obj[0] -eq "$([char]0x29e)") { return ":$($obj.substring(1))" } elseif ($print_readably) { $s = $obj -replace "\\", "\\" $s = $s -replace "`"", "\`"" $s = $s -replace "`n", "\n" return "`"$s`"" } else { return "$obj" } } "Vector" { $res = @($obj.values | ForEach-Object { (pr_str $_ $print_readably) }) return "[" + ($res -join " ") + "]" } "List" { $res = @($obj.values | ForEach-Object { (pr_str $_ $print_readably) }) return "(" + ($res -join " ") + ")" } "HashMap" { $res = @() foreach ($k in $obj.values.Keys) { $res += pr_str $k $print_readably $res += pr_str $obj.values[$k] $print_readably } return "{" + ($res -join " ") + "}" } "Symbol" { return $obj.value } "Boolean" { return $obj.ToString().ToLower() } "Atom" { return "(atom $(pr_str $obj.value $print_readably))" } "PSCustomObject" { return "(fn* $(pr_str (new-list $obj.params) $print_readably) $(pr_str $obj.ast $print_readably))" } default { return $obj.ToString() } } } function pr_seq { param($seq, $print_readably, $sep) $lst = foreach($a in $seq) { pr_str $a $print_readably } $lst -join $sep } ================================================ FILE: impls/powershell/reader.psm1 ================================================ Import-Module $PSScriptRoot/types.psm1 Class Reader { [String[]] $tokens [int] $pos Reader([String[]] $toks) { $this.tokens = $toks $this.pos = 0 } [String] peek() { return $this.tokens[$this.pos] } [String] next() { return $this.tokens[$this.pos++] } } function tokenize { $r = [regex]"[\s,]*(~@|[\[\]{}()'``~^@]|`"(?:\\.|[^\\`"])*`"?|;.*|[^\s\[\]{}('`"``,;)]*)" $r.Matches($args) | Where-Object { $_.Groups.Item(1).Value.Length -gt 0 -and $_.Groups.Item(1).Value[0] -ne ";" } | Foreach-Object { $_.Groups.Item(1).Value } } function read_atom([Reader] $rdr) { $token = $rdr.next() if ($token -match "^-?[0-9]+$") { return [convert]::ToInt32($token, 10) } elseif ($token -match "^`"(?:\\.|[^\\`"])*`"$") { $s = $token.Substring(1,$token.Length-2) $s = $s -replace "\\\\", "$([char]0x29e)" $s = $s -replace "\\`"", "`"" $s = $s -replace "\\n", "`n" $s = $s -replace "$([char]0x29e)", "\" return $s } elseif ($token -match "^`".*") { throw "expected '`"', got EOF" } elseif ($token -match "^:.*") { return "$([char]0x29e)$($token.substring(1))" } elseif ($token -eq "true") { return $true } elseif ($token -eq "false") { return $false } elseif ($token -eq "nil") { return $null } else { return new-symbol($token) } } function read_seq([Reader] $rdr, $start, $end) { $seq = @() $token = $rdr.next() if ($token -ne $start) { throw "expected '$start'" } while (($token = $rdr.peek()) -ne $end) { if ($token -eq "") { throw "expected '$end', got EOF" } $form = read_form $rdr $seq += $form } $token = $rdr.next() return ,$seq } function read_list([Reader] $rdr) { return new-list (read_seq $rdr "(" ")") } function read_vector([Reader] $rdr) { return new-vector (read_seq $rdr "[" "]") } function read_hash_map([Reader] $rdr) { return new-hashmap (read_seq $rdr "{" "}") } function read_form([Reader] $rdr) { $token = $rdr.peek() switch ($token) { # reader macros/transforms "'" { $_ = $rdr.next(); return new-list @((new-symbol "quote"), (read_form $rdr)) } "``" { $_ = $rdr.next(); return new-list @((new-symbol "quasiquote"), (read_form $rdr)) } "~" { $_ = $rdr.next(); return (new-list @((new-symbol "unquote"), (read_form $rdr))) } "~@" { $_ = $rdr.next(); return (new-list @((new-symbol "splice-unquote"), (read_form $rdr))) } "^" { $_ = $rdr.next(); $meta = read_form $rdr return (new-list @((new-symbol "with-meta"), (read_form $rdr), $meta)) } "@" { $_ = $rdr.next(); return (new-list @((new-symbol "deref"), (read_form $rdr))) } # list ")" { throw "unexpected ')'" } "(" { return read_list $rdr } # vector "]" { throw "unexpected ']'" } "[" { return read_vector $rdr } # hashmap "}" { throw "unexpected '}'" } "{" { return read_hash_map $rdr } default { return read_atom $rdr } } } function read_str { $toks = tokenize($args[0]) if ($toks.Length -eq 0) { return $null } read_form([Reader]::new($toks)) } ================================================ FILE: impls/powershell/run ================================================ #!/bin/sh exec powershell $(dirname $0)/${STEP:-stepA_mal}.ps1 "${@}" ================================================ FILE: impls/powershell/step0_repl.ps1 ================================================ while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } "$line" } ================================================ FILE: impls/powershell/step1_read_print.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { return $ast } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL function REP([String] $str) { return PRINT (EVAL (READ $str) @{}) } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step2_eval.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { # Write-Host "EVAL: $(pr_str $ast)" if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env[$ast.value] } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL # Case sensitive hashtable $repl_env = New-Object System.Collections.HashTable $repl_env["+"] = { param($a, $b); $a + $b } $repl_env["-"] = { param($a, $b); $a - $b } $repl_env["*"] = { param($a, $b); $a * $b } $repl_env["/"] = { param($a, $b); $a / $b } function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step3_env.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } return EVAL $a2 $let_env } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env $_ = $repl_env.set("+", { param($a, $b); $a + $b }) $_ = $repl_env.set("-", { param($a, $b); $a - $b }) $_ = $repl_env.set("*", { param($a, $b); $a * $b }) $_ = $repl_env.set("/", { param($a, $b); $a / $b }) function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step4_if_fn_do.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } return EVAL $a2 $let_env } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } return (EVAL $ast.values[$i] $env) } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { return (EVAL $ast.nth(3) $env) } else { return (EVAL $a2 $env) } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL return { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step5_tco.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step6_file.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } $_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) $_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if ($args.Count -gt 0) { $_ = REP('(load-file "' + $args[0] + '")') exit 0 } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step7_quote.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL 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 qq_loop($elt, $acc) { if ((list? $elt) -and (starts_with $elt "splice-unquote")) { return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { 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 } } default { return $ast } } } function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "quote" { return $a1 } "quasiquote" { $ast = quasiquote $a1 } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } $_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) $_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if ($args.Count -gt 0) { $_ = REP('(load-file "' + $args[0] + '")') exit 0 } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step8_macros.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL 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 qq_loop($elt, $acc) { if ((list? $elt) -and (starts_with $elt "splice-unquote")) { return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { 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 } } default { return $ast } } } function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "quote" { return $a1 } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env $m = $m.copy() $m.macro = $true return $env.set($a1.value, $m) } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values) if ($f.macro) { $ast = &$f.fn @fargs # TCO continue } $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } $_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) $_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') $_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") if ($args.Count -gt 0) { $_ = REP('(load-file "' + $args[0] + '")') exit 0 } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { Write-Host "Exception: $($_.Exception.Message)" } } ================================================ FILE: impls/powershell/step9_try.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL 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 qq_loop($elt, $acc) { if ((list? $elt) -and (starts_with $elt "splice-unquote")) { return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { 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 } } default { return $ast } } } function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "quote" { return $a1 } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env $m = $m.copy() $m.macro = $true return $env.set($a1.value, $m) } "try*" { try { return EVAL $a1 $env } catch { if ($a2 -and ($a2.nth(0).value -ceq "catch*")) { if ($_.Exception.GetType().Name -eq "MalException") { $e = @($_.Exception.object) } else { $e = @($_.Exception.Message) } return (EVAL $a2.nth(2) (new-env $env @($a2.nth(1)) $e)) } else { throw } } } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values) if ($f.macro) { $ast = &$f.fn @fargs # TCO continue } $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } $_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) $_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') $_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") if ($args.Count -gt 0) { $_ = REP('(load-file "' + $args[0] + '")') exit 0 } while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { if ($_.Exception.GetType().Name -eq "MalException") { Write-Host "Exception: $(pr_str $_.Exception.object)" } else { Write-Host "Exception: $($_.Exception.Message)" } } } ================================================ FILE: impls/powershell/stepA_mal.ps1 ================================================ $ErrorActionPreference = "Stop" Import-Module $PSScriptRoot/types.psm1 Import-Module $PSScriptRoot/reader.psm1 Import-Module $PSScriptRoot/printer.psm1 Import-Module $PSScriptRoot/env.psm1 Import-Module $PSScriptRoot/core.psm1 # READ function READ([String] $str) { return read_str($str) } # EVAL 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 qq_loop($elt, $acc) { if ((list? $elt) -and (starts_with $elt "splice-unquote")) { return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { 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 } } default { return $ast } } } function EVAL($ast, $env) { while ($true) { $dbgeval_env = ($env.find("DEBUG-EVAL")) if ($dbgeval_env -ne $null) { $dbgeval = $dbgeval_env.get("DEBUG-EVAL") if ($dbgeval -ne $null -and -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { Write-Host "EVAL: $(pr_str $ast)" } } if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env.get($ast.value) } "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() foreach ($k in $ast.values.Keys) { $hm.values[$k] = EVAL $ast.values[$k] $env } return $hm } default { return $ast } } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "quote" { return $a1 } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env $m = $m.copy() $m.macro = $true return $env.set($a1.value, $m) } "try*" { try { return EVAL $a1 $env } catch { if ($a2 -and ($a2.nth(0).value -ceq "catch*")) { if ($_.Exception.GetType().Name -eq "MalException") { $e = @($_.Exception.object) } else { $e = @($_.Exception.Message) } return (EVAL $a2.nth(2) (new-env $env @($a2.nth(1)) $e)) } else { throw } } } "do" { for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { $_ = (EVAL $ast.values[$i] $env) } $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) if ($cond -eq $null -or ($cond -is [Boolean] -and $cond -eq $false)) { $ast = $ast.nth(3) # TCO } else { $ast = $a2 # TCO } } "fn*" { # Save EVAL into a variable that will get closed over $feval = Get-Command EVAL $fn = { return (&$feval $a2 (new-env $env $a1.values $args)) }.GetNewClosure() return new-malfunc $a2 $a1.values $env $fn } default { $f = ( EVAL $ast.first() $env ) $fargs = @($ast.rest().values) if ($f.macro) { $ast = &$f.fn @fargs # TCO continue } $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO } else { return &$f @fargs } } } } } # PRINT function PRINT($exp) { return pr_str $exp $true } # REPL $repl_env = new-env function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) } # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { $_ = $repl_env.set($kv.Key, $kv.Value) } $_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) $_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! *host-language* "powershell")') $_ = REP('(def! not (fn* (a) (if a false true)))') $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') $_ = REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`")) (cons 'cond (rest (rest xs)))))))") if ($args.Count -gt 0) { $_ = REP('(load-file "' + $args[0] + '")') exit 0 } $_ = REP('(println (str "Mal [" *host-language* "]"))') while ($true) { Write-Host "user> " -NoNewline $line = [Console]::ReadLine() if ($line -eq $null) { break } try { Write-Host (REP($line)) } catch { if ($_.Exception.GetType().Name -eq "MalException") { Write-Host "Exception: $(pr_str $_.Exception.object)" } else { Write-Host "Exception: $($_.Exception.Message)" } } } ================================================ FILE: impls/powershell/types.psm1 ================================================ # # Exceptions # Class MalException : Exception { [Object] $object MalException($obj) { $this.object = $obj } } function mal_throw($obj) { throw [MalException] $obj } # # Symbols # Class Symbol { [String] $value Symbol([String] $val) { $this.value = $val } copy() { $this } } function new-symbol([String] $val) { [Symbol]::new($val) } function symbol?($obj) { $obj -is [Symbol] } # # Strings # function string?($obj) { ($obj -is [String]) -and ($obj[0] -ne "$([char]0x29e)") } # # Keywords # function new-keyword($obj) { if (keyword? $obj) { $obj } else { "$([char]0x29e)$obj" } } function keyword?($obj) { ($obj -is [String]) -and ($obj[0] -eq "$([char]0x29e)") } # # Lists # Class List { #[System.Collections.ArrayList] $values [Object[]] $values [Object] $meta List() { $this.values = @() #$this.values = New-Object System.Collections.ArrayList } List([Object[]] $vals) { #List([System.Collections.ArrayList] $vals) { $this.values = $vals } [List] copy() { return [List]::new($this.values) } [void] push([Object] $val) { $this.values.Add($val) } [Object] first() { return $this.values[0] } [List] rest() { if ($this.values.Count -le 1) { return [List]::new(@()) } else { return [List]::new($this.values[1..($this.values.Count)]) } } [Object] last() { if ($this.values.Count -eq 0) { return $null } else { return $this.values[$this.values.Count-1] } } [Object] nth([int64] $idx) { return $this.values[$idx] } } function new-list([Object[]] $vals) { #function new-list([System.Collections.ArrayList] $vals) { if ($vals.Count -eq 0) { return [List]::new() } else { return [List]::new($vals) } } function list?($obj) { $obj -is [List] -and -not ($obj -is [Vector]) } # # Vectors # Class Vector : List { Vector() { $this.values = @() #$this.values = New-Object System.Collections.ArrayList } Vector([Object[]] $vals) { #Vector([System.Collections.ArrayList] $vals) { $this.values = $vals } [Vector] copy() { return [Vector]::new($this.values) } } function new-vector([Object[]] $vals) { if ($vals.Count -eq 0) { return [Vector]::new() } else { return [Vector]::new($vals) } } function vector?($obj) { $obj -is [Vector] } # # HashMaps # Class HashMap { [Hashtable] $values [Object] $meta HashMap() { # Case-sensitive hashtable $this.values = New-Object System.Collections.HashTable } HashMap([Hashtable] $vals) { $this.values = $vals } [HashMap] copy() { return [HashMap]::new($this.values.clone()) } } function assoc_BANG($hm, $kvs) { $ht = $hm.values for ($i = 0; $i -lt $kvs.Count; $i+=2) { $ht[$kvs[$i]] = $kvs[($i+1)] } return $hm } function dissoc_BANG($hm, $ks) { $ht = $hm.values foreach ($k in $ks) { $ht.Remove($k) } return $hm } function new-hashmap([Object[]] $vals) { $hm = [HashMap]::new() assoc_BANG $hm $vals } function hashmap?($obj) { $obj -is [HashMap] } function keys($hm) { return new-list @($hm.values.GetEnumerator() | ForEach-Object { $_.Key }) } function vals($hm) { return new-list @($hm.values.GetEnumerator() | ForEach-Object { $_.Value }) } # # Atoms Class Atom { [Object] $value Atom([Object] $val) { $this.value = $val } } function new-atom([Object] $val) { [Atom]::new($val) } function atom?($obj) { $obj -is [Atom] } # Functions Class MalFunc { [Object] $ast [Object[]] $params [Object] $env [scriptBlock] $fn [Boolean] $macro [Object] $meta MalFunc($ast, $params, $env, $fn, $macro, $meta){ $this.ast = $ast $this.params = $params $this.env = $env $this.fn = $fn $this.macro = $macro $this.meta = $meta } [MalFunc] copy() { return [MalFunc]::new($this.ast, $this.params, $this.env, $this.fn, $this.macro, $this.meta) } } function new-malfunc($ast, $params, $env, $fn, $macro, $meta) { [MalFunc]::new($ast, $params, $env, $fn, $macro, $meta) } function malfunc?($obj) { $obj -is [MalFunc] } function fn?($obj) { $obj -is [System.Management.Automation.ScriptBlock] -or $obj -is [System.Management.Automation.CommandInfo] } # # General functions # function equal?($a, $b) { if ($a -eq $null -and $b -eq $null) { return $true } elseif ($a -eq $null -or $b -eq $null) { return $false } $ta, $tb = $a.GetType().Name, $b.GetType().Name if (-not (($ta -eq $tb) -or ((sequential?($a)) -and (sequential?($b))))) { return $false } switch ($ta) { { $_ -eq "List" -or $_ -eq "Vector" } { if ($a.values.Count -ne $b.values.Count) { return $false } for ($i = 0; $i -lt $a.value.Count; $i++) { if (-not (equal? $a.values[$i] $b.values[$i])) { return $false } } return $true } "HashMap" { $hta, $htb = $a.values, $b.values $alen = ($hta.GetEnumerator | Measure-Object).Count $blen = ($htb.GetEnumerator | Measure-Object).Count if ($alen -ne $blen) { return $false } foreach ($kv in $hta.GetEnumerator()) { if (-not (equal? $kv.Value $htb[$kv.Key])) { return $false } } return $true } "Symbol" { return $a.value -ceq $b.value } default { return $a -ceq $b } } } # # Sequence functions # function sequential?($obj) { $obj -is [List] } function empty?($obj) { $obj.values.Count -eq 0 } ================================================ FILE: impls/prolog/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install swi-prolog-nox ================================================ FILE: impls/prolog/Makefile ================================================ # Stub Makefile to make Travis test mode happy. all clean: ================================================ FILE: impls/prolog/core.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor wrap_failure(Goal, Args, Res) :- check(call(Goal,Args, Res), "~a: wrong arguments: ~L", [Goal, Args]). bool(Goal, true) :- call(Goal), !. bool(_, false). 'nil?'([X], R) :- bool(=(nil,X), R). 'false?'([X], R) :- bool(=(false, X), R). 'true?'([X], R) :- bool(=(true, X), R). % Numbers 'number?'([X], R) :- bool(integer(X), R). add([X, Y], R) :- integer(X), integer(Y), R is X + Y. sub([X, Y], R) :- integer(X), integer(Y), R is X - Y. mul([X, Y], R) :- integer(X), integer(Y), R is X * Y. div([X, Y], R) :- integer(X), integer(Y), Y \= 0, R is X / Y. '<='([X, Y], R) :- integer(X), integer(Y), bool(=<(X, Y), R). ge( [X, Y], R) :- integer(X), integer(Y), bool(>=(X, Y), R). lt( [X, Y], R) :- integer(X), integer(Y), bool(<(X, Y), R). gt( [X, Y], R) :- integer(X), integer(Y), bool(>(X, Y), R). % Symbols 'symbol?'([false], false). 'symbol?'([nil], false). 'symbol?'([true], false). 'symbol?'([X], R) :- bool(atom(X), R). symbol([X], R) :- string(X), atom_string(R, X). % Keywords 'keyword?'([X], R) :- bool(=(X, mal_kwd(_)), R). keyword([X], mal_kwd(X)) :- string(X). keyword([R], R) :- R = mal_kwd(_). % Sequences 'list?'([X], R) :- bool(list(_, X), R). 'vector?'([X], R) :- bool(vector(_, X), R). 'sequential?'([X], R) :- bool(unbox_seq(X, _), R). 'empty?'([X], R) :- bool(unbox_seq(X, []), R). count([X], R) :- unbox_seq(X, S), !, length(S, R). count([nil], 0). vec([X], R) :- unbox_seq(X, S), vector(S, R). cons([X, Y], R) :- unbox_seq(Y, Ys), list([X | Ys], R). concat(Xs, Z) :- maplist(unbox_seq, Xs, Ys), append(Ys, Zs), list(Zs, Z). nth([Sequence, Index], Element) :- unbox_seq(Sequence, Xs), check(nth0(Index, Xs, Element), "nth: index ~d out of bounds of ~F", [Index, Sequence]). first([X], Y) :- unbox_seq(X, Xs), !, (Xs = [Y | _] -> true ; Y = nil). first([nil], nil). rest([X], R) :- unbox_seq(X, Xs), !, (Xs = [_ | Rs] -> true ; Rs = []), list(Rs, R). rest([nil], R) :- list([], R). map([Fn, Seq], R) :- unbox_seq(Seq, Xs), mal_fn(Goal, Fn), maplist(enlist_apply(Goal), Xs, Rs), list(Rs, R). enlist_apply(Goal, X, R) :- call(Goal, [X], R). conj([Vector | Ys], R) :- vector(Xs, Vector), !, append(Xs, Ys, Zs), vector(Zs, R). conj([List | Ys], R) :- list(Xs, List), foldl(cons, Ys, Xs, Zs), list(Zs, R). cons(X, Xs, [X | Xs]). seq([X], nil) :- unbox_seq(X, []). seq([X], X) :- list(_, X). seq([X], R) :- vector(Xs, X), !, list(Xs, R). seq([""], nil). seq([S], R) :- string(S), !, string_chars(S, Chars), maplist(atom_string, Chars, Strings), list(Strings, R). seq([nil], nil). % Maps (there is little not much we can do out of types). 'map?'([X], R) :- bool(is_map(X), R). get([Map, Key], R) :- get(Map, Key, R). get([_, _], nil). 'contains?'([Map, Key], R) :- bool(get(Map, Key, _), R). dissoc([Map | Keys], Res) :- foldl(dissoc, Keys, Map, Res). % Atoms 'atom?'([X], R) :- bool(mal_atom(_, X), R). atom([A], R) :- mal_atom(A, R). deref([A], R) :- mal_atom(R, A). 'reset!'([A, R], R) :- mal_atom(_, A), set_mal_atom_value(A, R). 'swap!'([Atom, Function | Args], R) :- mal_atom(Old, Atom), mal_fn(Goal, Function), call(Goal, [Old | Args], R), set_mal_atom_value(Atom, R). apply([Fn | Xs], R) :- flatten_last(Xs, Args), (mal_fn(Goal, Fn) ; (mal_macro(F, Fn), mal_fn(Goal, F))), call(Goal, Args, R). flatten_last([X], Xs) :- unbox_seq(X, Xs). flatten_last([X | Xs], [X | Ys]) :- flatten_last(Xs, Ys). % Strings 'string?'([X], R) :- bool(string(X), R). 'pr-str'(Args, R) :- with_output_to(string(R), print_list(t, " ", Args)). str( Args, R) :- with_output_to(string(R), print_list(f, "", Args)). prn( Args, nil) :- print_list(t, " ", Args), nl. println( Args, nil) :- print_list(f, " ", Args), nl. 'read-string'([S], R) :- string(S), read_str(S, R). slurp([Path], R) :- string(Path), (read_file_to_string(Path, R, []) -> true ; R = nil). readline([Prompt], R) :- string(Prompt), write(Prompt), read_line_to_string(current_input, R), (R = end_of_file -> R = nil ; true). throw([X], nil) :- throw(mal_error(X)). 'time-ms'([], Ms) :- get_time(S), Ms is round(1_000*S). eq([X, Y], R) :- bool(mal_equal(X, Y), R). 'fn?'([X], R) :- bool(mal_fn(_, X), R). 'macro?'([X], R) :- bool(mal_macro(_, X), R). 'prolog-asserta'([String], nil) :- string(String), catch((read_term_from_atom(String, Term, []), asserta(Term)), Error, throwf("prolog-asserta: ~w", [Error])). 'prolog-call'([String], Res) :- string(String), catch((read_term_from_atom(String, Term, []), call(Term, Res)), Error, throwf("prolog-call: ~w", [Error])), check(valid_mal(Res), "prolog-call: invalid result: ~w", [Res]). core_ns([ % naming exceptions '+', add, '-', sub, '*', mul, '/', div, '=', eq, '<', lt, '>=', ge, '>', gt, % step 4 '<=', '<=', prn, prn, list, list, 'list?', 'list?', 'empty?', 'empty?', count, count, 'pr-str', 'pr-str', str, str, println, println, % step 6 'read-string', 'read-string', slurp, slurp, atom, atom, 'atom?', 'atom?', deref, deref, 'reset!', 'reset!', 'swap!', 'swap!', % step 7 cons, cons, concat, concat, vec, vec, % step 8 nth, nth, first, first, rest, rest, % step 9 throw, throw, apply, apply, map, map, 'nil?', 'nil?', 'true?', 'true?', 'false?', 'false?', 'symbol?', 'symbol?', symbol, symbol, keyword, keyword, 'keyword?', 'keyword?', vector, vector, 'vector?', 'vector?', 'sequential?', 'sequential?', 'hash-map', 'hash-map', 'map?', 'map?', assoc, assoc, dissoc, dissoc, get, get, 'contains?', 'contains?', keys, keys, vals, vals, % step A readline, readline, meta, meta, 'with-meta', 'with-meta', 'time-ms', 'time-ms', conj, conj, 'string?', 'string?', 'number?', 'number?', 'fn?', 'fn?', 'macro?', 'macro?', seq, seq, 'prolog-asserta', 'prolog-asserta', 'prolog-call', 'prolog-call']). ================================================ FILE: impls/prolog/env.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- format_predicate('V', env_format(_Arg,_Env)). env(mal_env(Assoc, t)) :- empty_assoc(Assoc). env(Outer, mal_env(Assoc, Outer)) :- empty_assoc(Assoc). env_get(mal_env(Assoc, _), Key, Value) :- get_assoc(Key, Assoc, Value). env_get(mal_env(_, Outer), Key, Value) :- env_get(Outer, Key, Value). env_set(Env, Key, Value) :- Env = mal_env(Old, _), put_assoc(Key, Old, Value, New), setarg(1, Env, New). env_format(_Arg, mal_env(Assoc, _Outer)) :- assoc_to_list(Assoc, Pairs), maplist(env_format_pair, Pairs). env_format_pair(K - V) :- format(" ~a:~F", [K, V]). % Does *not* check that the keys are symbols. This is done once when % the fn* structure is created. env_bind(_Env, [], []). env_bind(Env, ['&', K], Vs) :- !, list(Vs, List), env_set(Env, K, List). env_bind(Env, [K | Ks], [V | Vs]) :- env_set(Env, K, V), env_bind(Env, Ks, Vs). ================================================ FILE: impls/prolog/printer.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- format_predicate('F', format_mal_form(_Arg,_Form)). :- format_predicate('L', format_mal_list(_Arg,_Forms)). format_mal_list(_Arg, Forms) :- print_list(t, " ", Forms). format_mal_form(_Arg, Form) :- pr_str(t, Form). pr_str(t, String) :- string(String), !, write("\""), string_codes(String, Codes), maplist(pr_str_escape, Codes), write("\""). pr_str(_, Atomic) :- atomic(Atomic), !, % number, symbol, nil, true, false, unreadable string. write(Atomic). pr_str(_, mal_kwd(Keyword)) :- !, put_char(:), write(Keyword). pr_str(Readably, Vector) :- vector(Elements, Vector), !, write("["), print_list(Readably, " ", Elements), write("]"). pr_str(Readably, List) :- list(Elements, List), !, write("("), print_list(Readably, " ", Elements), write(")"). pr_str(Readably, Map) :- map_to_key_value_list(Map, Key_Value_List), !, write("{"), print_list(Readably, " ", Key_Value_List), write("}"). pr_str(_, Fn) :- mal_fn(_Goal, Fn), !, write(""). pr_str(_, Macro) :- mal_macro(_Fn, Macro), !, write(""). pr_str(_, Atom) :- mal_atom(Value, Atom), !, format("(atom ~F)", [Value]). pr_str(_, Invalid) :- format(string(Msg), "pr_str detected an invalid form: ~w\n", [Invalid]), print_message(warning, Msg), abort. pr_str_escape(0'\n) :- write("\\n"). pr_str_escape(0'") :- write("\\\""). pr_str_escape(0'\\) :- write("\\\\"). pr_str_escape(C) :- put_code(C). print_list(_, _, []). print_list(Readably, Separator, [X | Xs]) :- pr_str(Readably, X), maplist(print_list_append(Readably, Separator), Xs). print_list_append(Readably, Separator, Element) :- write(Separator), pr_str(Readably, Element). ================================================ FILE: impls/prolog/reader.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- use_module(library(dcg/basics)). read_str(String, Form) :- string_codes(String, Codes), check(phrase(read_form(Form), Codes, _Rest), "unbalanced expression: '~s'", [String]). read_form(Res) --> zero_or_more_separators, ( `(`, !, read_list(`)`, Forms), { list(Forms, Res) } | `[`, !, read_list(`]`, Forms), { vector(Forms, Res) } | `{`, !, read_list(`}`, Forms), { 'hash-map'(Forms, Res) } | `\``, !, read_form(Form), { list([quasiquote, Form], Res) } | `\'`, !, read_form(Form), { list([quote, Form], Res) } | `^`, !, read_form(Meta), read_form(Data), { list(['with-meta', Data, Meta], Res) } | `:`, !, at_least_one_symcode(Codes), { string_codes(String, Codes), Res = mal_kwd(String) } | `\"`, !, until_quotes(Codes), { string_codes(Res, Codes) } | `@`, !, read_form(Form), { list([deref, Form], Res) } | `~@`, !, read_form(Form), { list(['splice-unquote', Form], Res) } | `~`, !, read_form(Form), { list([unquote, Form], Res) } | integer(Res) | at_least_one_symcode(Cs), { atom_codes(Res, Cs) }). read_list(Closing, [Form | Forms]) --> read_form(Form), !, read_list(Closing, Forms). read_list(Closing, []) --> zero_or_more_separators, Closing. zero_or_more_separators --> separator, !, zero_or_more_separators | []. separator --> [C], { sepcode(C) }, !. separator --> `;`, string_without(`\n`, _Comment). at_least_one_symcode([C | Cs]) --> [C], { symcode(C) }, zero_or_more_symcodes(Cs). until_quotes([]) --> [0'"]. until_quotes([0'\n | Cs]) --> `\\n`, !, until_quotes(Cs). until_quotes([0'" | Cs]) --> `\\\"`, !, until_quotes(Cs). until_quotes([0'\\ | Cs]) --> `\\\\`, !, until_quotes(Cs). until_quotes([C | Cs]) --> [C], until_quotes(Cs). zero_or_more_symcodes(Cs) --> at_least_one_symcode(Cs), !. zero_or_more_symcodes([]) --> []. sepcode(0',). sepcode(0' ). sepcode(0'\n). symcode(C) :- code_type(C, alnum). symcode(0'!). symcode(0'#). symcode(0'$). symcode(0'%). symcode(0'&). symcode(0'*). symcode(0'+). symcode(0'-). symcode(0'/). symcode(0'<). symcode(0'=). symcode(0'>). symcode(0'?). symcode(0'_). symcode(0'|). symcode(0':). ================================================ FILE: impls/prolog/run ================================================ #!/usr/bin/env bash exec swipl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}" ================================================ FILE: impls/prolog/step0_repl.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). % Read mal_read(Line) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true). % fails for duplicate lines % Eval eval(Ast, Ast). % Print print(Ast) :- writeln(Ast). % REP rep :- mal_read(Ast), eval(Ast, Evaluated), print(Evaluated). % Main program repl :- rep, repl. main(_Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), catch(repl, exit_repl, nl), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step1_read_print.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval eval(Ast, Ast). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep :- mal_read(Ast), eval(Ast, Evaluated), print(Evaluated). % Main program repl :- catch(rep, mal_error(Message), writeln(Message)), repl. main(_Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), catch(repl, exit_repl, nl), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step2_eval.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res). % The eval function itself. % Uncomment this to get a trace. %% eval(_, Ast, _) :- %% format("EVAL: ~F\n", [Ast]), %% fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(get_assoc(Symbol, Env, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y. sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y. mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y. div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y. main(_Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), mal_fn(add, Add), mal_fn(sub, Sub), mal_fn(mul, Mul), mal_fn(div, Div), list_to_assoc(['+' - Add, '-' - Sub, '*' - Mul, '/' - Div], Env), catch(repl(Env), exit_repl, nl), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step3_env.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y. sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y. mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y. div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y. define_core_function(Env, Symbol, Core_Function) :- mal_fn(Core_Function, Form), env_set(Env, Symbol, Form). main(_Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), map_keyvals(define_core_function(Env), ['+', add, '-', sub, '*', mul, '/', div]), catch(repl(Env), exit_repl, nl), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step4_if_fn_do.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). main(_Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), re(Env, "(def! not (fn* [a] (if a false true)))"), catch(repl(Env), exit_repl, nl), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step6_file.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). main(Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), re(Env, "(def! not (fn* [a] (if a false true)))"), re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), ( maplist(atom_string, Argv, [Script | Args]) -> % If Argv starts with a script, set arguments and load it. list(Args, Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), format(string(Load_Script), "(load-file \"~s\")", [Script]), re(Env, Load_Script) ; % else read from standard input. list([], Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), catch(repl(Env), exit_repl, nl) ), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step7_quote.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), eval(Env, Y, Res). quasiquote(List, Res) :- list(Xs, List), !, ( Xs = [unquote | Args] -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) ; list([], Empty), foldr(qq_loop, Empty, Xs, Res)). quasiquote(Vector, Res) :- vector(Xs, Vector), !, list([], Empty), foldr(qq_loop, Empty, Xs, Y), list([vec, Y], Res). quasiquote(nil, nil). quasiquote(true, true). quasiquote(false, false). quasiquote(Symbol_Or_Map, Res) :- (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, list([quote, Symbol_Or_Map], Res). quasiquote(Anything_Else, Anything_Else). qq_loop(Elt, Acc, Res) :- list(['splice-unquote' | Args], Elt), !, check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), list([concat, X, Acc], Res). qq_loop(Elt, Acc, Res) :- quasiquote(Elt, Quasiquoted), list([cons, Quasiquoted, Acc], Res). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). main(Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), re(Env, "(def! not (fn* [a] (if a false true)))"), re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), ( maplist(atom_string, Argv, [Script | Args]) -> % If Argv starts with a script, set arguments and load it. list(Args, Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), format(string(Load_Script), "(load-file \"~s\")", [Script]), re(Env, Load_Script) ; % else read from standard input. list([], Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), catch(repl(Env), exit_repl, nl) ), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step8_macros.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), eval(Env, Y, Res). quasiquote(List, Res) :- list(Xs, List), !, ( Xs = [unquote | Args] -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) ; list([], Empty), foldr(qq_loop, Empty, Xs, Res)). quasiquote(Vector, Res) :- vector(Xs, Vector), !, list([], Empty), foldr(qq_loop, Empty, Xs, Y), list([vec, Y], Res). quasiquote(nil, nil). quasiquote(true, true). quasiquote(false, false). quasiquote(Symbol_Or_Map, Res) :- (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, list([quote, Symbol_Or_Map], Res). quasiquote(Anything_Else, Anything_Else). qq_loop(Elt, Acc, Res) :- list(['splice-unquote' | Args], Elt), !, check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), list([concat, X, Acc], Res). qq_loop(Elt, Acc, Res) :- quasiquote(Elt, Quasiquoted), list([cons, Quasiquoted, Acc], Res). eval_list(Env, 'defmacro!', Args, Res) :- !, check(Args = [Key, Form], "defmacro!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "defmacro!: ~F is not a key", [Key]), eval(Env, Form, Fn), check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), mal_macro(Fn, Res), env_set(Env, Key, Res). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), ( mal_macro(F, Fn) -> % If the Fn macro refers to F, apply F then evaluate, mal_fn(Goal, F), call(Goal, Rest, New_Ast), eval(Env, New_Ast, Res) ; % else evaluate arguments, apply Fn. check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res)). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(Message), writeln(Message)), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). main(Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), re(Env, "(def! not (fn* [a] (if a false true)))"), re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), re(Env, "(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)))))))"), ( maplist(atom_string, Argv, [Script | Args]) -> % If Argv starts with a script, set arguments and load it. list(Args, Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), format(string(Load_Script), "(load-file \"~s\")", [Script]), re(Env, Load_Script) ; % else read from standard input. list([], Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), catch(repl(Env), exit_repl, nl) ), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/step9_try.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), eval(Env, Y, Res). quasiquote(List, Res) :- list(Xs, List), !, ( Xs = [unquote | Args] -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) ; list([], Empty), foldr(qq_loop, Empty, Xs, Res)). quasiquote(Vector, Res) :- vector(Xs, Vector), !, list([], Empty), foldr(qq_loop, Empty, Xs, Y), list([vec, Y], Res). quasiquote(nil, nil). quasiquote(true, true). quasiquote(false, false). quasiquote(Symbol_Or_Map, Res) :- (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, list([quote, Symbol_Or_Map], Res). quasiquote(Anything_Else, Anything_Else). qq_loop(Elt, Acc, Res) :- list(['splice-unquote' | Args], Elt), !, check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), list([concat, X, Acc], Res). qq_loop(Elt, Acc, Res) :- quasiquote(Elt, Quasiquoted), list([cons, Quasiquoted, Acc], Res). eval_list(Env, 'try*', Args, Res) :- !, ( Args = [Test] -> eval(Env, Test, Res) ; check(Args = [Test, Catch], "try*: expects 1 or 2 arguments, got: ~L", [Args]), check(list(['catch*', Key, Form], Catch), "try*: ~F is not a catch* list", [Catch]), check(atom(Key), "catch*: ~F is not a key", [Key]), catch(eval(Env, Test, Res), mal_error(Error), (env(Env, Try_Env), env_set(Try_Env, Key, Error), eval(Try_Env, Form, Res)))). eval_list(Env, 'defmacro!', Args, Res) :- !, check(Args = [Key, Form], "defmacro!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "defmacro!: ~F is not a key", [Key]), eval(Env, Form, Fn), check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), mal_macro(Fn, Res), env_set(Env, Key, Res). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), ( mal_macro(F, Fn) -> % If the Fn macro refers to F, apply F then evaluate, mal_fn(Goal, F), call(Goal, Rest, New_Ast), eval(Env, New_Ast, Res) ; % else evaluate arguments, apply Fn. check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res)). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). main(Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), re(Env, "(def! not (fn* [a] (if a false true)))"), re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), re(Env, "(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)))))))"), ( maplist(atom_string, Argv, [Script | Args]) -> % If Argv starts with a script, set arguments and load it. list(Args, Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), format(string(Load_Script), "(load-file \"~s\")", [Script]), re(Env, Load_Script) ; % else read from standard input. list([], Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), catch(repl(Env), exit_repl, nl) ), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/stepA_mal.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- initialization(main, main). :- consult([core, env, printer, reader, types, utils]). % Read mal_read(Ast) :- write("user> "), read_line_to_string(current_input, Line), (Line = end_of_file -> throw(exit_repl) ; true), (rl_add_history(Line) -> true ; true), % fails for duplicate lines read_str(Line, Ast). % Eval non-empty list depending on their first element. :- discontiguous eval_list/4. eval_list(Env, 'def!', Args, Res) :- !, check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "def!: ~F is not a symbol", [Key]), eval(Env, Form, Res), env_set(Env, Key, Res). eval_list(Env, 'let*', Args, Res) :- !, check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]), env(Env, Let_Env), check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]), eval(Let_Env, Form, Res). let_loop(Env, Key, Form) :- !, check(atom(Key), "let*: ~F is not a key", [Key]), eval(Env, Form, Value), env_set(Env, Key, Value). eval_list(Env, if, Args, Res) :- !, check(if_assign_args(Args, Form, Then, Else), "if: expects 2 or 3 arguments, got: ~L", [Args]), eval(Env, Form, Test), if_select(Test, Then, Else, Selected), eval(Env, Selected, Res). if_assign_args([Form, Then, Else], Form, Then, Else). if_assign_args([Form, Then], Form, Then, nil). if_select(false, _, Else, Else) :- !. if_select(nil, _, Else, Else) :- !. if_select(_, Then, _, Then). eval_list(Env, 'fn*', Args, Res) :- !, check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]), check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]), check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]), mal_fn(apply_fn(Keys, Form, Env), Res). apply_fn(Keys, Form, Env, Args, Res) :- env(Env, Apply_Env), check(env_bind(Apply_Env, Keys, Args), "cannot apply fn*[~L] to [~L]", [Keys, Args]), eval(Apply_Env, Form, Res). eval_list(Env, do, Args, Res) :- !, foldl(do_loop(Env), Args, nil, Res). do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc). eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), eval(Env, Y, Res). quasiquote(List, Res) :- list(Xs, List), !, ( Xs = [unquote | Args] -> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args]) ; list([], Empty), foldr(qq_loop, Empty, Xs, Res)). quasiquote(Vector, Res) :- vector(Xs, Vector), !, list([], Empty), foldr(qq_loop, Empty, Xs, Y), list([vec, Y], Res). quasiquote(nil, nil). quasiquote(true, true). quasiquote(false, false). quasiquote(Symbol_Or_Map, Res) :- (atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !, list([quote, Symbol_Or_Map], Res). quasiquote(Anything_Else, Anything_Else). qq_loop(Elt, Acc, Res) :- list(['splice-unquote' | Args], Elt), !, check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]), list([concat, X, Acc], Res). qq_loop(Elt, Acc, Res) :- quasiquote(Elt, Quasiquoted), list([cons, Quasiquoted, Acc], Res). eval_list(Env, 'try*', Args, Res) :- !, ( Args = [Test] -> eval(Env, Test, Res) ; check(Args = [Test, Catch], "try*: expects 1 or 2 arguments, got: ~L", [Args]), check(list(['catch*', Key, Form], Catch), "try*: ~F is not a catch* list", [Catch]), check(atom(Key), "catch*: ~F is not a key", [Key]), catch(eval(Env, Test, Res), mal_error(Error), (env(Env, Try_Env), env_set(Try_Env, Key, Error), eval(Try_Env, Form, Res)))). eval_list(Env, 'defmacro!', Args, Res) :- !, check(Args = [Key, Form], "defmacro!: expects 2 arguments, got: ~L", [Args]), check(atom(Key), "defmacro!: ~F is not a key", [Key]), eval(Env, Form, Fn), check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]), mal_macro(Fn, Res), env_set(Env, Key, Res). % apply phase eval_list(Env, First, Rest, Res) :- eval(Env, First, Fn), ( mal_macro(F, Fn) -> % If the Fn macro refers to F, apply F then evaluate, mal_fn(Goal, F), call(Goal, Rest, New_Ast), eval(Env, New_Ast, Res) ; % else evaluate arguments, apply Fn. check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]), maplist(eval(Env), Rest, Args), call(Goal, Args, Res)). % The eval function itself. debug_eval(_, _, nil). debug_eval(_, _, false). debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). eval(Env, Ast, _) :- env_get(Env, 'DEBUG-EVAL', Flag), debug_eval(Env, Ast, Flag), fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, eval_list(Env, First, Args, Res). eval(_, nil, nil). eval(_, true, true). eval(_, false, false). eval(Env, Symbol, Res) :- atom(Symbol), !, check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]). eval(Env, Vector, Res) :- vector(Xs, Vector), !, maplist(eval(Env), Xs, Ys), vector(Ys, Res). eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). % Print print(Ast) :- format("~F\n", [Ast]). % REP rep(Env) :- mal_read(Ast), eval(Env, Ast, Evaluated), print(Evaluated). % Main program repl(Env) :- catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])), repl(Env). re(Env, String) :- read_str(String, Ast), eval(Env, Ast, _). define_core_function(Env, Symbol, Core_Function) :- mal_fn(wrap_failure(Core_Function), Form), env_set(Env, Symbol, Form). core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res). main(Argv) :- getenv("HOME", Home), string_concat(Home, "/.mal-history", History), (exists_file(History) -> rl_read_history(History) ; true), env(Env), core_ns(Core_Ns), map_keyvals(define_core_function(Env), Core_Ns), define_core_function(Env, eval, core_eval(Env)), env_set(Env, '*host-language*', "prolog"), re(Env, "(def! not (fn* [a] (if a false true)))"), re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), re(Env, "(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)))))))"), ( maplist(atom_string, Argv, [Script | Args]) -> % If Argv starts with a script, set arguments and load it. list(Args, Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), format(string(Load_Script), "(load-file \"~s\")", [Script]), re(Env, Load_Script) ; % else read from standard input. list([], Mal_Argv), env_set(Env, '*ARGV*', Mal_Argv), re(Env, "(println (str \"Mal [\" *host-language* \"]\"))"), catch(repl(Env), exit_repl, nl) ), (rl_write_history(History) -> true ; true). ================================================ FILE: impls/prolog/tests/stepA_mal.mal ================================================ ;; Testing basic prolog interop (prolog-call "1+") ;/.*prolog-call: .*syntax_error.* (prolog-call "atom_length(\"ab\")") ;=>2 (prolog-call "atom_concat(\"ab\", \"cd\")") ;=>abcd (prolog-call "number_string(42)") ;=>"42" (prolog-call "=(mal_kwd(\"kw\"))") ;=>:kw (prolog-call "list([a, b])") ;=>(a b) (prolog-call "vector([a, b])") ;=>[a b] (prolog-call "'hash-map'([\"a\", 1])") ;=>{"a" 1} (meta (prolog-call "=(mal_vector([a, b], 12))")) ;=>12 (prolog-call "=(mal_list([1, mal_formed(1)]))") ;/.*prolog-call: invalid result.* (prolog-asserta "(mal_setenv(Name, Value, nil) :- setenv(Name, Value))") ;=>nil (prolog-call "mal_setenv(\"answer\", 42)") ;=>nil (prolog-call "getenv(\"answer\")") ;=>42 ================================================ FILE: impls/prolog/types.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor :- discontiguous mal_equal/2. :- discontiguous 'with-meta'/2. :- discontiguous meta/2. :- discontiguous valid_mal/1. % A MAL number is represented by a Prolog integer. % A MAL symbol is represented by a Prolog atom, % including `false`, `nil` and `true`. % A MAL string is represented by a Prolog string. % A MAL keyword is represented as mal_kwd(String), and there is no % reason to encapsulate this information. % The remaining representations are encapsulated because they may have % to evolve, and interfer directly with metadata. mal_equal(X, X) :- atomic(X), !. mal_equal(mal_kwd(S), mal_kwd(S)) :- !. valid_mal(X) :- integer(X), !. valid_mal(X) :- atom(X), !. valid_mal(X) :- string(X), !. valid_mal(mal_kwd(S)) :- !, string(S). % Sequences % list(?Forms, ?List) % Bi-directional conversion between a list of MAL forms and a MAL list. % At least one of the two arguments must be instantiated. % Fails if the second argument is instantiated but not a MAL list. % vector(?Forms, ?Vector) % Similar for MAL vectors. list(Forms, mal_list(Forms)) :- !. list(Forms, mal_list(Forms, _Meta)) :- !. vector(Forms, mal_vector(Forms)) :- !. vector(Forms, mal_vector(Forms, _Meta)) :- !. mal_equal(S1, S2) :- unbox_seq(S1, L1), !, unbox_seq(S2, L2), maplist(mal_equal, L1, L2). 'with-meta'([X, Meta], mal_list( Forms, Meta)) :- list( Forms, X), !. 'with-meta'([X, Meta], mal_vector(Forms, Meta)) :- vector(Forms, X), !. meta([mal_list(_, Meta)], Meta) :- !. meta([mal_vector(_, Meta)], Meta) :- !. valid_mal(mal_list(F)) :- !, maplist(valid_mal, F). valid_mal(mal_list(F, M)) :- !, maplist(valid_mal, F), valid_mal(M). valid_mal(mal_vector(F)) :- !, maplist(valid_mal, F). valid_mal(mal_vector(F, M)) :- !, maplist(valid_mal, F), valid_mal(M). % Maps % Other files should not directly depend on Assoc, as there may be % good reasons to change the map representation. 'hash-map'(Key_Value_List, mal_map(Res)) :- empty_assoc(Assoc), check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res), "hash-map: odd count of key and values in ~L", [Key_Value_List]). is_map(mal_map(_Assoc)) :- !. is_map(mal_map(_Assoc, _Meta)) :- !. is_key(Key) :- string(Key), !. is_key(mal_kwd(_)) :- !. unbox_map(mal_map(Assoc), Assoc) :- !. unbox_map(mal_map(Assoc, _Meta), Assoc) :- !. get(Map, Key, Res) :- unbox_map(Map, Assoc), is_key(Key), get_assoc(Key, Assoc, Res). assoc([Map | Key_Value_List], mal_map(Res)) :- unbox_map(Map, Assoc), check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res), "assoc: odd count of key and values in [~L]", [Key_Value_List]). assoc(Assoc, Key, Value, Res) :- check(is_key(Key), "map keys must be strings or symbol, not ~F", [Key]), put_assoc(Key, Assoc, Value, Res). % This order of parameter is convenient with foldl. dissoc(Key, Map, mal_map(Res)) :- unbox_map(Map, Assoc), is_key(Key), % del_assoc fails if the key did previously exist, % and we do not want to search twice. (del_assoc(Key, Assoc, _Value, Res) -> true ; Res = Assoc). map_map(Goal, Map, mal_map(Res)) :- unbox_map(Map, Assoc), map_assoc(Goal, Assoc, Res). keys([Map], Res) :- unbox_map(Map, Assoc), assoc_to_keys(Assoc, Keys), list(Keys, Res). vals([Map], Res) :- unbox_map(Map, Assoc), assoc_to_values(Assoc, Vals), list(Vals, Res). % MAL map -> key/value Prolog list % Fail if the form is not a map. map_to_key_value_list(Map, Forms) :- unbox_map(Map, Assoc), assoc_to_list(Assoc, Pairs), foldr(convert_pair, [], Pairs, Forms). convert_pair(Key - Value, Acc, [Key, Value | Acc]). mal_equal(Map1, Map2) :- unbox_map(Map1, Assoc1), !, unbox_map(Map2, Assoc2), % map_assoc(mal_equal) does not work here because its result % depends on the internal structure. assoc_to_list(Assoc1, Pairs1), assoc_to_list(Assoc2, Pairs2), maplist(map_pair_equal, Pairs1, Pairs2). map_pair_equal(K1 - V1, K2 - V2) :- K1 = K2, mal_equal(V1, V2). 'with-meta'([X, Meta], mal_map(Assoc, Meta)) :- unbox_map(X, Assoc), !. meta([mal_map(_, Meta)], Meta) :- !. valid_mal(mal_map(Assoc)) :- !, is_assoc(Assoc), assoc_to_list(Assoc, Pairs), maplist(valid_mal_pair, Pairs). valid_mal(mal_map(Assoc, Meta)) :- !, is_assoc(Assoc), assoc_to_list(Assoc, Pairs), maplist(valid_mal_pair, Pairs), valid_mal(Meta). valid_mal_pair(K - V) :- is_key(K), valid_mal(V). % Functions % Goal is called with call(Goal, [Arg1, Arg2..], Res). % It should never fail, and use mal_error/1 to report problems. mal_fn(Goal, mal_fn(Goal)) :- !. mal_fn(Goal, mal_fn(Goal, _Meta)) :- !. 'with-meta'([mal_fn(Goal), Meta], mal_fn(Goal, Meta)) :- !. 'with-meta'([mal_fn(Goal, _Meta), Meta], mal_fn(Goal, Meta)) :- !. meta([mal_fn(_,Meta)], Meta) :- !. valid_mal(mal_fn(_)) :- !. valid_mal(mal_fn(_, Meta)) :- !, valid_mal(Meta). % Macros mal_macro(Fn, mal_macro(Fn)). % Atoms mal_atom(Value, mal_atom(Value)). set_mal_atom_value(Atom, Value) :- setarg(1, Atom, Value). valid_mal(mal_atom(Value)) :- !, valid_mal(Value). % Catch-all clause for objects without metadata. meta([_], nil) :- !. ================================================ FILE: impls/prolog/utils.pl ================================================ % -*- mode: prolog; -*- select prolog mode in the emacs text editor % Convenient shortcuts, especially during steps 1 to 6. % Similar to "assert", but raise an non-fatal error. check(Condition, _, _) :- call(Condition), !. check(_, Format, Arguments) :- throwf(Format, Arguments). throwf(Format, Arguments) :- format(string(Message), Format, Arguments), throw(mal_error(Message)). % Convenient shortcut: unbox(+Sequence, -List). unbox_seq(Sequence, Forms) :- list(Forms, Sequence). unbox_seq(Sequence, Forms) :- vector(Forms, Sequence). % Abstract some loops. % foldr(Goal, Vn, [X1, X2,...,Xn], V0) :- % Goal(Xn, Vn, Vn-1), % ... % Goal(X2, V2, V1), % Goal(X1, V1, V0), foldr(_, Vn, [], Vn). foldr(Goal, Vn, [X|Xs], V0) :- foldr(Goal, Vn, Xs, V1), call(Goal, X, V1, V0). % foldl_keyvals(Goal, Init, [K1, V1, K2, V2, K3, V3], Acc3) :- % Goal(Init, K1, V1, Acc1), % Goal(Acc1, K2, V2, Acc2), % Goal(Acc2, K3, V3, Acc3). foldl_keyvals(_, Init, [], Init). foldl_keyvals(Goal, Init, [K, V | KVs], Res) :- call(Goal, Init, K, V, Acc), foldl_keyvals(Goal, Acc, KVs, Res). % map_keyvals(Goal, [K1, V1, K2, V2, K3, V3]) :- % Goal(K1, V1), % Goal(K2, V2), % Goal(K3, V3). map_keyvals(_, []). map_keyvals(Goal, [K, V | KVs]) :- call(Goal, K, V), map_keyvals(Goal, KVs). ================================================ FILE: impls/ps/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # PostScript/ghostscript RUN apt-get -y install ghostscript ================================================ FILE: impls/ps/Makefile ================================================ SOURCES_BASE = types.ps reader.ps printer.ps SOURCES_LISP = env.ps core.ps stepA_mal.ps SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.ps mal mal.ps: $(SOURCES) cat $+ | grep -v "runlibfile$$" > $@ mal: mal.ps echo "#!/bin/sh" > $@ echo "\":\" pop pop pop pop %#; exec gs -d'#!'=null -d'\":\"'=null -q -dNODISPLAY -- \"\$$0\" \"\$$@\"" >> $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.ps mal ================================================ FILE: impls/ps/core.ps ================================================ % requires types.ps % Errors/Exceptions % data -> throw -> % Takes arbitrary data and throws it as an exception. /throw { 0 _nth _throw } def % Predicates /fn? { 0 _nth dup _mal_function? { %if mal_function /macro? get true eq not %if not marked as macro }{ _function? %if function } ifelse } def /macro? { 0 _nth dup _mal_function? { %if user defined function /macro? get true eq %if marked as macro }{ pop false } ifelse } def % Hash Map functions % [hashmap key val ...] -> assoc -> new_hashmap /assoc { 4 dict begin /args exch def /src_dict args 0 _nth /data get def /new_dict src_dict dup length args _count 1 sub 2 idiv add % new length dict % new dict of that length copy def 1 2 args _count 1 sub { %for each key idx /idx exch def new_dict args idx _nth args idx 1 add _nth put } for new_dict _hash_map_from_dict end } def % [hashmap key...] -> dissoc -> new_hashmap /dissoc { 4 dict begin /args exch def /src_dict args 0 _nth /data get def /new_dict src_dict dup length dict copy def 1 1 args _count 1 sub { %for each key idx /idx exch def new_dict args idx _nth undef } for new_dict _hash_map_from_dict end } def % [hashmap key] -> hash_map_get -> value /hash_map_get { dup 0 _nth % stack: args hash_map dup null eq { %if hash_map is a nil pop pop null }{ %else hash_map is not a nil exch 1 _nth % stack: hash_map key _hash_map_get } ifelse } def % [hashmap key] -> contains? -> bool /contains? { dup 0 _nth /data get % stack: args dict exch 1 _nth % stack: dict key known } def % [hashmap] -> vals -> val_list /vals { 0 _nth /data get [ exch { exch pop } forall ] _list_from_array } def % sequence functions % [obj list] -> cons -> new_list /cons { 3 dict begin /args exch def /elem args 0 _nth def /lst args 1 _nth def lst _count 1 add array dup 0 elem put % first element dup 1 lst /data get putinterval % rest of the elements _list_from_array end } def % [listA listB] -> do_concat -> [listA... listB...] /do_concat { dup _count 0 eq { %if just concat pop 0 _list }{ dup _count 1 eq { %elseif concat of single item 0 _nth dup _vector? { %if vector /data get _list_from_array } if }{ % else [] exch /data get { /data get concatenate } forall _list_from_array } ifelse } ifelse } def % [seq idx] -> nth -> obj /nth { 3 dict begin /args exch def /seq args 0 _nth /data get def /idx args 1 _nth def idx seq length lt { seq idx get }{ (nth: index out of range) _throw } ifelse end } def % [obj] -> do_count -> number /do_count { 0 _nth dup _nil? { pop 0 }{ _count } ifelse } def % [obj ...] -> first -> obj /first { 0 _nth dup _nil? { pop null }{ _first } ifelse } def % [obj objs...] -> first -> [objs..] /rest { 0 _nth dup _nil? { pop 0 _list }{ _rest } ifelse } def % [function args... arg_list] -> apply -> result /apply { 1 dict begin /args exch def args 0 _nth callable % make sure function is callable args /data get 1 args _count 2 sub getinterval % get args slice args args _count 1 sub _nth /data get % get arg_list array concatenate _list_from_array exch % stack: args function exec end } def % [function list] -> _map -> new_list /map { 1 dict begin dup 0 _nth exch 1 _nth % stack: function list /args exch def callable % make sure function is callable %/new_list args length array def args /data get { %foreach arg 1 array astore _list_from_array % stack: fn arglist exch dup 3 1 roll % stack: fn arglist fn exec exch % stack: result fn } forall pop % remove the function args _count array astore _list_from_array end } def % [vect elem...] -> conj -> new_vect % [list elem...] -> conj -> new_list /conj { 5 dict begin /args exch def /src_arr args 0 _nth /data get def /new_len src_arr length args _count 1 sub add def /new_arr new_len array def args 0 _nth _list? { %if list new_arr new_len src_arr length sub src_arr putinterval args _count 1 sub -1 1 { /idx exch def new_arr args _count idx sub 1 sub args idx _nth put } for new_arr _list_from_array }{ %else vector src_arr new_arr copy pop 1 1 args _count 1 sub { /idx exch def new_arr src_arr length idx add 1 sub args idx _nth put } for new_arr _vector_from_array } ifelse end } def % [obj] -> seq -> new_list/nil/error /seq { 1 dict begin 0 _nth /obj exch def obj _list? { % if list obj _count 0 eq { null }{ obj } ifelse }{ obj _vector? { % if vector obj _count 0 eq { null }{ obj /data get _list_from_array } ifelse }{ obj _string? { % if string obj length 0 eq { null }{ % convert string to 1 character strings obj { 1 string dup 0 % chr string string 0 4 -1 roll % string string 0 chr put } forall obj length _list } ifelse }{ null obj eq { % if nil null }{ % invalid seq argument (seq: called on non-sequence) _throw } ifelse } ifelse } ifelse } ifelse end } def % Metadata functions % [obj meta] -> with_meta -> new_obj /with_meta { dup 1 _nth exch 0 _nth % stack: meta obj dup length dict copy % stack: meta new_obj dup 3 -1 roll % stack: new_obj new_obj meta /meta exch put } def % [obj] -> meta -> meta /meta { 0 _nth % stack: obj dup type /dicttype eq { %if dictionary dup /meta known { /meta get }{ pop null } ifelse }{ %else pop null % no meta on non-collections } ifelse } def % Atom functions /deref { 0 _nth /data get } def % [atm val] -> reset! -> val /reset! { dup 0 _nth exch 1 _nth % stack: atm val dup 3 1 roll % stack: val atm val /data exch put } def % [atm f args...] -> swap! -> new_val /swap! { 3 dict begin /args exch def /atm args 0 _nth def [ atm /data get ] args 2 args _count 2 sub _slice /data get concatenate _list_from_array args 1 _nth callable % extract proc exec /new_val exch def atm /data new_val put new_val end } def % core_ns is namespace of core functions /core_ns << (=) { dup 0 _nth exch 1 _nth _equal? } (throw) { throw } (nil?) { 0 _nth _nil? } (true?) { 0 _nth _true? } (false?) { 0 _nth _false? } (string?) { 0 _nth _string? } (symbol) { 0 _nth _symbol } (symbol?) { 0 _nth _symbol? } (keyword) { 0 _nth _keyword } (keyword?) { 0 _nth _keyword? } (number?) { 0 _nth type /integertype eq } (fn?) { fn? } (macro?) { macro? } (pr-str) { /data get ( ) true _pr_str_args } (str) { /data get () false _pr_str_args } (prn) { /data get ( ) true _pr_str_args print (\n) print null } (println) { /data get ( ) false _pr_str_args print (\n) print null } (readline) { 0 _nth _readline not { pop null } if } (read-string) { 0 _nth read_str } (slurp) { 0 _nth (r) file dup bytesavailable string readstring pop } (<) { dup 0 _nth exch 1 _nth lt } (<=) { dup 0 _nth exch 1 _nth le } (>) { dup 0 _nth exch 1 _nth gt } (>=) { dup 0 _nth exch 1 _nth ge } (+) { dup 0 _nth exch 1 _nth add } (-) { dup 0 _nth exch 1 _nth sub } (*) { dup 0 _nth exch 1 _nth mul } (/) { dup 0 _nth exch 1 _nth idiv } (time-ms) { pop realtime } (list) { /data get _list_from_array } (list?) { 0 _nth _list? } (vector) { /data get _vector_from_array } (vector?) { 0 _nth _vector? } (hash-map) { /data get _hash_map_from_array } (map?) { 0 _nth _hash_map? } (assoc) { assoc } (dissoc) { dissoc } (get) { hash_map_get } (contains?) { contains? } (keys) { 0 _nth _keys } (vals) { vals } (sequential?) { 0 _nth _sequential? } (cons) { cons } (concat) { do_concat } (vec) { 0 _nth /data get _vector_from_array } (nth) { nth } (first) { first } (rest) { rest } (empty?) { 0 _nth _count 0 eq } (count) { do_count } (apply) { apply } (map) { map } (conj) { conj } (seq) { seq } (with-meta) { with_meta } (meta) { meta } (atom) { 0 _nth _atom } (atom?) { 0 _nth _atom? } (deref) { deref } (reset!) { reset! } (swap!) { swap! } >> def ================================================ FILE: impls/ps/env.ps ================================================ % outer binds exprs -> env_new -> new_env /env_new { 3 dict begin %(in env_new\n) print /exprs exch dup _sequential? { /data get }{ pop [ ] } ifelse def /binds exch dup _sequential? { /data get }{ pop [ ] } ifelse def /outer exch def << /__outer__ outer 0 1 binds length 1 sub { /idx exch def binds idx get (&) eq { %if & binds idx 1 add get % key exprs idx exprs length idx sub getinterval % value _list_from_array exit } if binds idx get % key exprs idx get % value } for >> end } def /env_set { % env key value -> put } def /env_get { % env key -> value true OR false { 2 copy known { get true exit } if exch /__outer__ get dup null eq { pop pop false exit } if exch } loop } def ================================================ FILE: impls/ps/interop.ps ================================================ % [ ps_val1...] -> ps2mal -> [ mal_val1...] /ps2mal { % convert returned values to Mal types [ exch { %forall returned values dup == dup type /arraytype eq { (here1\n) print _list_from_array }{ dup type /dicttype eq { (here2\n) print _hash_map_from_dict }{ (here3\n) print % no-op } ifelse } ifelse } forall ] (here4\n) print } def ================================================ FILE: impls/ps/printer.ps ================================================ % requires types.ps to be included first % ast print_readably -> _pr_str -> string /_pr_str { 4 dict begin /print_readably exch def dup xcheck { (Cannot print proc: ) print dup == quit } if % assert /obj exch def obj _sequential? { obj _list? { (\() (\)) }{ ([) (]) } ifelse obj /data get ( ) print_readably _pr_str_args exch concatenate concatenate }{ obj _hash_map? { ({) % get array of contents with keys stringified [ obj /data get { exch dup length string cvs exch } forall ] ( ) print_readably _pr_str_args concatenate (}) concatenate }{ obj _function? { % if builtin function (<\(builtin_fn* {) obj /data get dup length array copy cvlit ( ) print_readably _pr_str_args (}>) concatenate concatenate }{ obj _mal_function? { % if user defined mal_function (<\(fn* ) obj /params get print_readably _pr_str ( ) obj /ast get print_readably _pr_str (\)>) concatenate concatenate concatenate concatenate }{ obj _atom? { % if atom (\(atom ) obj /data get print_readably _pr_str (\)) concatenate concatenate }{ /arraytype obj type eq { % if list or code block % accumulate an array of strings (\() obj ( ) print_readably _pr_str_args concatenate (\)) concatenate }{ /integertype obj type eq { % if number /slen obj abs 1 max log floor cvi 1 add % positive size obj 0 lt { 1 add } if % account for sign def obj 10 slen string cvrs }{ /stringtype obj type eq { % if string obj length 0 gt { % if string length > 0 obj 0 get 127 eq { %if starts with 0x7f (keyword) obj dup length string copy dup 0 58 put % 58 is ':' }{ print_readably { (") obj (\\) (\\\\) replace (") (\\") replace (\n) (\\n) replace (") concatenate concatenate }{ obj } ifelse } ifelse }{ % else empty string print_readably { ("") }{ obj } ifelse } ifelse }{ null obj eq { % if nil (nil) }{ true obj eq { % if true (true) }{ false obj eq { % if false (false) }{ /nametype obj type eq { % if symbol obj dup length string cvs }{ () } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse end } def % array delim print_readably -> _pr_str_args -> new_string /_pr_str_args { 3 dict begin /print_readably exch def /delim exch def /args exch def () args length 0 gt { %if any elements [ args { %foreach argument in array dup xcheck { %if executable 255 string cvs }{ print_readably _pr_str } ifelse } forall ] { concatenate delim concatenate } forall dup length delim length sub 0 exch getinterval % strip off final delim } if end } def % utility function /print_dict { (DICT contents:\n) print { ( - ) print exch dup length string cvs print % key (: ) print == } forall } def ================================================ FILE: impls/ps/reader.ps ================================================ % requires types.ps to be included first /token_delim (;,"` \n{}\(\)[]) def /token_number (0123456789-) def % read_number: read a single number from string/idx % string idx -> read_number -> number string new_idx /read_number { 5 dict begin %(in read_number\n) print /idx exch def /str exch def /start idx def /cnt 0 def { % loop idx str length ge { exit } if % EOF, break loop /ch str idx get def % current character ch 48 ge ch 57 le and 45 ch eq or { %if number /cnt cnt 1 add def }{ % else exit } ifelse /idx idx 1 add def % increment idx } loop str start cnt getinterval cvi % the matched number str idx % return: number string new_idx end } def % read_symbol: read a single symbol from string/idx % string idx -> read_symbol -> name string new_idx /read_symbol { 5 dict begin %(in read_symbol\n) print /idx exch def /str exch def /start idx def /cnt 0 def { % loop idx str length ge { exit } if % EOF, break loop /ch str idx 1 getinterval def token_delim ch search { % if token delimeter pop pop pop exit }{ % else not a delim pop /cnt cnt 1 add def } ifelse /idx idx 1 add def % increment idx } loop str start cnt getinterval cvn % the matched symbol str idx % return: symbol string new_idx end } def % read_keyword: read a single keyword from string/idx % string idx -> read_keyword -> name string new_idx /read_keyword { 5 dict begin %(in read_keyword\n) print /idx exch def /str exch def /start idx def /cnt 0 def { % loop idx str length ge { exit } if % EOF, break loop /ch str idx 1 getinterval def token_delim ch search { % if token delimeter pop pop pop exit }{ % else not a delim pop /cnt cnt 1 add def } ifelse /idx idx 1 add def % increment idx } loop str start cnt getinterval % the matched keyword string dup 0 127 put % TODO: something like (\x029e) would be better str idx % return: keyword string new_idx end } def % read_string: read a single string from string/idx % string idx -> read_string -> new_string string new_idx /read_string { 5 dict begin %(in read_string\n) print /idx exch 1 add def /str exch def /start idx def /cnt 0 def { % loop idx str length ge { %if EOF (unexpected EOF reading string) _throw } if /ch str idx get def % current character /idx idx 1 add def ch 92 eq { % if \ /idx idx 1 add def /cnt cnt 1 add def % 1 more below } if ch 34 eq { exit } if % '"' is end of string /cnt cnt 1 add def } loop str start cnt getinterval % the matched string (\\\\) (\177) replace (\\") (") replace (\\n) (\n) replace (\177) (\\) replace str idx % return: new_string string new_idx end } def % read_atom: read a single atom from string/idx % string idx -> read_atom -> int string new_idx /read_atom { 4 dict begin %(in read_atom\n) print /idx exch def /str exch def str length idx le { % ifelse exit % EOF }{ /ch str idx get def % current character str length idx 1 add le { /nextch 0 def }{ /nextch str idx 1 add get def % next character } ifelse ch 48 ge ch 57 le and { %if digit (number) str idx read_number }{ ch 45 eq nextch 48 ge nextch 57 le and and { %elseif minus and digit str idx read_number }{ ch 34 eq { %elseif double-quote (string) str idx read_string }{ ch 58 eq { %elseif colon (keyword) str idx read_keyword }{ str idx read_symbol /idx exch def pop dup /nil eq { %if nil pop null str idx }{ dup /true eq { %elseif true pop true str idx }{ dup /false eq { %elseif false pop false str idx }{ %else str idx % return the original symbol/name } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse }ifelse % return: atom string new_idx end } def % read_until: read a list from string/idx until stopchar is found % string idx stopchar -> read_until -> list string new_idx /read_until { 3 dict begin %(in read_until\n) print /stopchar exch def /idx exch 1 add def /str exch def [ { % loop str idx read_spaces /idx exch def pop str length idx le { %if EOF (unexpected EOF reading list) _throw } if /ch str idx get def % current character ch stopchar eq { exit } if % stop at stopchar str idx read_form /idx exch def pop } loop ] str idx 1 add end } def % read_spaces: advance idx to the first non-whitespace % string idx -> read_form -> string new_idx /read_spaces { 3 dict begin %(in read_spaces\n) print /idx exch def /str exch def { % loop str length idx le { exit } if % EOF, break loop /ch str idx get def % current character %(left1.1:) print str idx str length idx sub getinterval print (\n) print % eliminate comments ch 59 eq { %if ';' { % loop /idx idx 1 add def % increment idx str length idx le { exit } if % EOF, break loop /ch str idx get def % current character %(left1.2:) print str idx str length idx sub getinterval print (\n) print % if newline then we are done ch 10 eq { exit } if } loop /idx idx 1 add def str length idx le { exit } if % EOF, break loop /ch str idx get def % current character } if % if not whitespace then exit ch 32 ne ch 10 ne ch 44 ne ch 59 ne and and and { exit } if /idx idx 1 add def % increment idx } loop %(left1.3:) print str idx str length idx sub getinterval print (\n) print str idx % return: string new_idx end } def % read_form: read the next form from string start at idx % string idx -> read_form -> ast string new_idx /read_form { 3 dict begin %(in read_form\n) print read_spaces /idx exch def /str exch def %idx str length ge { (unexpected EOF) _throw } if % EOF idx str length ge { null str idx }{ %if EOF /ch str idx get def % current character %(LEFT2.1:) print str idx str length idx sub getinterval print (\n) print ch 39 eq { %if '\'' /idx idx 1 add def str idx read_form 3 -1 roll /quote exch 2 _list 3 1 roll }{ ch 96 eq { %if '`' /idx idx 1 add def str idx read_form 3 -1 roll /quasiquote exch 2 _list 3 1 roll }{ ch 126 eq { %if '~' /idx idx 1 add def /ch str idx get def % current character ch 64 eq { %if '~@' /idx idx 1 add def str idx read_form 3 -1 roll /splice-unquote exch 2 _list 3 1 roll }{ %else just '~' str idx read_form 3 -1 roll /unquote exch 2 _list 3 1 roll } ifelse }{ ch 94 eq { %if '^' /idx idx 1 add def str idx read_form read_form % stack: meta form str idx 4 2 roll exch /with-meta 3 1 roll 3 _list 3 1 roll }{ ch 64 eq { %if '@' /idx idx 1 add def str idx read_form 3 -1 roll /deref exch 2 _list 3 1 roll }{ ch 40 eq { %if '(' str idx 41 read_until dup /idx exch def %(LEFT2.2:) print str idx str length idx sub getinterval print (\n) print 3 -1 roll _list_from_array 3 1 roll %(LEFT2.3:) print str idx str length idx sub getinterval print (\n) print }{ ch 41 eq { %elseif ')' (unexpected '\)') _throw }{ ch 91 eq { %if '[' str idx 93 read_until dup /idx exch def %(LEFT2.4:) print str idx str length idx sub getinterval print (\n) print 3 -1 roll _vector_from_array 3 1 roll }{ ch 93 eq { %elseif ']' (unexpected ']') _throw }{ ch 123 eq { %elseif '{' str idx 125 read_until dup /idx exch def 3 -1 roll _hash_map_from_array 3 1 roll }{ ch 125 eq { %elseif '}' (unexpected '}') _throw }{ % else str idx read_atom } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse % not EOF % return: ast string new_idx end } def % string -> read_str -> ast /read_str { %(in read_str\n) print 0 % current index into the string read_form pop pop % drop the string, idx. return: ast } def ================================================ FILE: impls/ps/run ================================================ #!/usr/bin/env bash exec gs -q -I$(dirname $0) -dNOSAFER -dNODISPLAY -- $(dirname $0)/${STEP:-stepA_mal}.ps "${@}" ================================================ FILE: impls/ps/step0_repl.ps ================================================ % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { % just "return" the input string /str exch def str } def % eval /EVAL { % just "return" the "ast" /env exch def /ast exch def ast } def % print /PRINT { % just "return" the expression /exp exch def exp } def % repl /REP { READ (stub env) EVAL PRINT } def % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF REP print (\n) print } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step1_read_print.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 2 dict begin % just "return" the "ast" /env exch def /ast exch def ast end } def % print /PRINT { true _pr_str } def % repl /REP { READ (stub env) EVAL PRINT } def % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step2_eval.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 3 dict begin /env exch def /ast exch def %(eval_ast: ) print ast == ast _symbol? { %if symbol env ast known { env ast get }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse }{ ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array }{ ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict }{ ast _list? not { ast }{ ast _count 0 eq { ast }{ /a0 ast 0 _nth def a0 env EVAL [ ast _rest /data get { env EVAL } forall ] _list_from_array exch exec % apply function to args } ifelse } ifelse } ifelse } ifelse } ifelse end } def % print /PRINT { true _pr_str } def % repl /repl_env << (+) { dup 0 _nth exch 1 _nth add } (-) { dup 0 _nth exch 1 _nth sub } (*) { dup 0 _nth exch 1 _nth mul } (/) { dup 0 _nth exch 1 _nth idiv } >> def /REP { READ repl_env EVAL PRINT } def % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step3_env.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 7 dict begin /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get not { (') ast dup length string cvs (' not found) concatenate concatenate _throw } if }{ ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array }{ ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict }{ ast _list? not { ast }{ ast _count 0 eq { ast }{ /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set }{ /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env EVAL }{ a0 env EVAL [ ast _rest /data get { env EVAL } forall ] _list_from_array exch exec % apply function to args } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /REP { READ repl_env EVAL PRINT } def repl_env (+) { dup 0 _nth exch 1 _nth add } env_set repl_env (-) { dup 0 _nth exch 1 _nth sub } env_set repl_env (*) { dup 0 _nth exch 1 _nth mul } env_set repl_env (/) { dup 0 _nth exch 1 _nth idiv } env_set % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step4_if_fn_do.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 7 dict begin /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get not { (') ast dup length string cvs (' not found) concatenate concatenate _throw } if }{ ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array }{ ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict }{ ast _list? not { ast }{ ast _count 0 eq { ast }{ /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set }{ /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env EVAL }{ /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env EVAL }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env EVAL }{ % else false branch with no a3 null } ifelse }{ % true branch ast 2 _nth env EVAL } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function }{ a0 env EVAL dup _mal_function? { %if user defined function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env EVAL }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step5_tco.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step6_file.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall repl_env (eval) { 0 _nth repl_env EVAL } _function env_set repl_env (*ARGV*) [ ] _list_from_array env_set % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments repl_env (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array env_set ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step7_quote.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval % 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 _sequential? not { ast _symbol? ast _hash_map? or { /quote ast 2 _list }{ ast } ifelse }{ /unquote ast starts_with { ast 1 _nth }{ /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 } ifelse } ifelse end } def /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /quote a0 eq { %if quote ast 1 _nth exit } if /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env % loop }{ /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall repl_env (eval) { 0 _nth repl_env EVAL } _function env_set repl_env (*ARGV*) [ ] _list_from_array env_set % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments repl_env (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array env_set ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step8_macros.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval % 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 _sequential? not { ast _symbol? ast _hash_map? or { /quote ast 2 _list }{ ast } ifelse }{ /unquote ast starts_with { ast 1 _nth }{ /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 } ifelse } ifelse end } def /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /quote a0 eq { %if quote ast 1 _nth exit } if /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env % loop }{ /defmacro! a0 eq { %if defmacro! ast 2 _nth env EVAL _macro env ast 1 _nth 2 index env_set exit } if /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function dup /macro? get true eq { ast _rest exch % stack: args macro fload % stack: args new_env EVAL % stack: new_ast env % stack: new_ast env % loop }{ [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop } ifelse }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall repl_env (eval) { 0 _nth repl_env EVAL } _function env_set repl_env (*ARGV*) [ ] _list_from_array env_set % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop (\(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\)\)\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments repl_env (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array env_set ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/step9_try.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval % 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 _sequential? not { ast _symbol? ast _hash_map? or { /quote ast 2 _list }{ ast } ifelse }{ /unquote ast starts_with { ast 1 _nth }{ /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 } ifelse } ifelse end } def /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /quote a0 eq { %if quote ast 1 _nth exit } if /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env % loop }{ /defmacro! a0 eq { %if defmacro! ast 2 _nth env EVAL _macro env ast 1 _nth 2 index env_set exit } if /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /try* a0 eq { %if try* ast _count 2 gt { %if has catch* block { %try 2 dict begin % special dict for dict stack count countdictstack /dictcnt exch def count /stackcnt exch def ast 1 _nth env EVAL end } stopped { %catch % clean up the dictionary stack 1 1 countdictstack dictcnt sub { %foreach added dict %(popping dict\n) print pop end % pop idx and pop dict %(new ast: ) print ast true _pr_str print (\n) print } for % clean up the operand stack count 1 exch 1 exch stackcnt sub { %foreach added operand %(op stack: ) print pstack pop pop % pop idx and operand %(popped op stack\n) print pstack } for end % remove special dict % get error data and reset $error dict /errdata get_error_data def $error /newerror false put $error /errorinfo null put ast _count 3 lt { %if no third (catch*) form errdata throw } if ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* (No catch* in throw form) _throw } if ast 2 _nth 2 _nth env ast 2 _nth 1 _nth 1 _list errdata 1 _list env_new EVAL } if }{ % else no catch* block ast 1 _nth env EVAL } ifelse exit } if /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function dup /macro? get true eq { ast _rest exch % stack: args macro fload % stack: args new_env EVAL % stack: new_ast env % stack: new_ast env % loop }{ [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop } ifelse }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall repl_env (eval) { 0 _nth repl_env EVAL } _function env_set repl_env (*ARGV*) [ ] _list_from_array env_set % core.mal: defined using the language itself (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop (\(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\)\)\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments repl_env (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array env_set ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/stepA_mal.ps ================================================ /runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval % 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 _sequential? not { ast _symbol? ast _hash_map? or { /quote ast 2 _list }{ ast } ifelse }{ /unquote ast starts_with { ast 1 _nth }{ /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 } ifelse } ifelse end } def /EVAL { 7 dict begin { %loop (TCO) /env exch def /ast exch def env (DEBUG-EVAL) env_get { dup null ne exch false ne and { (EVAL: ) print ast true _pr_str print (\n) print } if } if ast _symbol? { %if symbol env ast env_get { exit }{ (') ast dup length string cvs (' not found) concatenate concatenate _throw } ifelse } if ast _vector? { [ ast /data get { %forall items env EVAL } forall ] _vector_from_array exit } if ast _hash_map? { << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict exit } if ast _list? not { ast exit } if ast _count 0 eq { ast exit } if /a0 ast 0 _nth def /def! a0 eq { %if def! ast 2 _nth env EVAL env ast 1 _nth 2 index env_set exit } if /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set } for a2 let_env % loop }{ /quote a0 eq { %if quote ast 1 _nth exit } if /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env % loop }{ /defmacro! a0 eq { %if defmacro! ast 2 _nth env EVAL _macro env ast 1 _nth 2 index env_set exit } if /ps* a0 eq { %if ps* count /stackcnt exch def ast 1 _nth cvx exec count stackcnt gt { % if new operands on stack % return an list of new operands count stackcnt sub array astore }{ null % return nil } ifelse exit } if /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice /data get { env EVAL pop } forall } if ast ast _count 1 sub _nth % last ast becomes new ast env % loop }{ /try* a0 eq { %if try* ast _count 2 gt { %if has catch* block { %try 2 dict begin % special dict for dict stack count countdictstack /dictcnt exch def count /stackcnt exch def ast 1 _nth env EVAL end } stopped { %catch % clean up the dictionary stack 1 1 countdictstack dictcnt sub { %foreach added dict %(popping dict\n) print pop end % pop idx and pop dict %(new ast: ) print ast true _pr_str print (\n) print } for % clean up the operand stack count 1 exch 1 exch stackcnt sub { %foreach added operand %(op stack: ) print pstack pop pop % pop idx and operand %(popped op stack\n) print pstack } for end % remove special dict % get error data and reset $error dict /errdata get_error_data def $error /newerror false put $error /errorinfo null put ast _count 3 lt { %if no third (catch*) form errdata throw } if ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* (No catch* in throw form) _throw } if ast 2 _nth 2 _nth env ast 2 _nth 1 _nth 1 _list errdata 1 _list env_new EVAL } if }{ % else no catch* block ast 1 _nth env EVAL } ifelse exit } if /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env % loop }{ % else false branch with no a3 null exit } ifelse }{ % true branch ast 2 _nth env % loop } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function exit } if a0 env EVAL dup _mal_function? { %if user defined function dup /macro? get true eq { ast _rest exch % stack: args macro fload % stack: args new_env EVAL % stack: new_ast env % stack: new_ast env % loop }{ [ ast _rest /data get { env EVAL } forall ] _list_from_array exch fload % stack: ast new_env % loop } ifelse }{ dup _function? { %else if builtin function [ ast _rest /data get { env EVAL } forall ] _list_from_array exch /data get exec exit } if %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript core_ns { _function repl_env 3 1 roll env_set } forall repl_env (eval) { 0 _nth repl_env EVAL } _function env_set repl_env (*ARGV*) [ ] _list_from_array env_set % core.mal: defined using the language itself (\(def! *host-language* "postscript"\)) RE pop (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop (\(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\)\)\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments repl_env (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array env_set ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop (\(println \(str "Mal [" *host-language* "]"\)\)) RE pop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit ================================================ FILE: impls/ps/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/ps/tests/stepA_mal.mal ================================================ ;; Testing basic ps interop (ps* "7") ;=>(7) (ps* "(7)") ;=>("7") (ps* "7 8 9 3 array astore") ;=>((7 8 9)) (ps* "1 1 eq") ;=>(true) (ps* "/sym") ;=>(sym) (ps* "1 1 eq { (yep) }{ (nope) } ifelse") ;=>("yep") (ps* "1 0 eq { (yep) }{ (nope) } ifelse") ;=>("nope") (ps* "1 2 3 pop pop pop") ;=>nil ================================================ FILE: impls/ps/types.ps ================================================ % General functions % concatenate: concatenate two strings or two arrays % From Thinking in PostScript 1990 Reid, Example 11.7 % (string1) (string2) concatenate string3 % array1 array2 concatenate array3 /concatenate { %def dup type 2 index type 2 copy ne { %if pop pop errordict begin (concatenate) typecheck end }{ %else /stringtype ne exch /arraytype ne and { errordict begin (concatenate) typecheck end } if } ifelse dup length 2 index length add 1 index type /arraytype eq { array }{ string } ifelse % stack: arg1 arg2 new dup 0 4 index putinterval % stack: arg1 arg2 new dup 4 -1 roll length 4 -1 roll putinterval % stack: new } bind def % reverse: array1 -> reverse -> array2 /reverse { [ exch aload % push array onto stack length -1 0 { 1 roll } for % reverse ] } bind def % string1 string2 string3 -> replace -> string4 % Return a string4 with all occurrences of string2 in string1 replaced % with string3 /replace { 4 dict begin /repstr exch def /needle exch def /haystack exch def /result () def { % loop haystack needle search { %if found % stack: post match pre repstr concatenate 3 1 roll pop % stack: pre+ post /haystack exch def % stack: pre+ result exch concatenate /result exch def }{ result exch concatenate /result exch def exit } ifelse } loop result end } def % objA objB -> _equal? -> bool /_equal? { 6 dict begin /b exch def /a exch def a type b type eq a _sequential? b _sequential? and or not { %if type mismatch and not sequential false }{ a _sequential? b _sequential? and { %if list/vector /ret true def a _count b _count eq not { %if length mismatch /ret false def }{ %else (length is the same) 0 1 a _count 1 sub { /idx exch def a idx _nth b idx _nth _equal? not { %if not items _equal? /ret false def exit } if } for } ifelse ret }{ %else not list/vector a _hash_map? b _hash_map? and { %if hash_map /ret true def /a_keys a _keys def a_keys _count b _keys _count eq not { /ret false def }{ a_keys /data get { %foreach key in a_keys /key exch def a key _hash_map_get b key _hash_map_get _equal? not { %if not items _equal? /ret false def exit } if } forall } ifelse ret }{ %else not hash_map a b eq } ifelse } ifelse } ifelse end } def % Low-level sequence operations /_sequential? { dup _list? exch _vector? or } def /_count { /data get length } def /_first { /data get dup length 0 gt { 0 get }{ pop null } ifelse } def % seq start count -> _slice -> new_seq /_slice { 3 -1 roll /data get 3 1 roll % stack: array start count getinterval _list_from_array } def % seq idx -> _nth -> ith_item /_nth { exch /data get % stack: idx array dup length 0 gt { exch get }{ pop pop null } ifelse } def % seq -> _rest -> rest_seq /_rest { /data get dup length 0 gt { dup length 1 sub 1 exch getinterval }{ pop 0 array } ifelse _list_from_array } def % hashmap -> _keys -> key_list /_keys { /data get [ exch { pop dup length string cvs } forall ] _list_from_array } def % hashmap key -> _hash_map_get -> val /_hash_map_get { exch % stack: key hashmap /data get % stack: key dict exch % stack: dict key 2 copy known { %if has key get }{ pop pop null } ifelse } def % Errors/Exceptions % data -> _throw -> % Takes arbitrary data and puts it in $error:/errorinfo. Then calls % stop to transfer control to end of nearest stopped context. /_throw { $error exch /errorinfo exch put $error /command /throw put stop } def /errorinfo? { $error /errorinfo known { % if set $error /errorinfo get null ne { true }{ false } ifelse }{ false } ifelse } def /get_error_data { errorinfo? { %if $error /errorinfo get }{ $error /errorname get 255 string cvs (: ) $error /command get 99 string cvs ( at ) $error /position get 10 99 string cvrs concatenate concatenate concatenate concatenate } ifelse } def % Scalars /_nil? { null eq } def /_true? { true eq } def /_false? { false eq } def /_string? { dup type /stringtype eq { dup length 0 eq { % if length == 0 pop true }{ 0 get 127 eq not } ifelse }{ pop false } ifelse } def % Symbols /_symbol { dup length string copy cvn } def /_symbol? { type /nametype eq } def % Keywords /_keyword { 1 dict begin dup _keyword? not { /str exch def str length 1 add string % str2 dup 1 str putinterval dup 0 127 put % TODO: something like (\x029e) would be better } if end } def /_keyword? { dup type /stringtype eq { dup length 0 eq { % if length == 0 pop false }{ 0 get 127 eq } ifelse }{ pop false } ifelse } def % Functions % block -> _function -> boxed_function /_function { << /_maltype_ /function %/data 5 -1 roll cvlit /data 5 -1 roll >> %%dup length dict copy } def % ast env params -> _mal_function -> boxed_mal_function /_mal_function { << /_maltype_ /mal_function % user defined function /macro? false % macro flag, false by default /params null % close over parameters /ast null % close over ast /env null % close over environment /data { __self__ fload EVAL } % forward reference to EVAL dup length array copy cvx % actual copy/new instance of block >> % make an actual copy/new instance of dict dup length dict copy % stack: ast env params mal_fn % "Close over" parameters dup 3 -1 roll % stack: ast env mal_fn mal_fn params /params exch put % stack: ast env mal_fn dup 3 -1 roll % stack: ast mal_fn mal_fn env /env exch put % stack: ast mal_fn dup 3 -1 roll % stack: mal_fn mal_fn ast /ast exch put % stack: mal_fn % insert self reference into position 0 of data dup /data get % stack: mal_fn data 1 index % stack: mal_fn data mal_fn 0 exch % stack: mal_fn data 0 mal_fn put % stack: mal_fn } def % fn -> _defmacro -> macro /_macro { dup /ast get exch dup /env get exch /params get _mal_function dup /macro? true put } def /_function? { dup type /dicttype eq { /_maltype_ get /function eq }{ pop false } ifelse } def /_mal_function? { dup type /dicttype eq { /_maltype_ get /mal_function eq }{ pop false } ifelse } def % args mal_function -> fload -> ast new_env % fload: sets up arguments on the stack for an EVAL call /fload { dup /ast get 3 1 roll % stack: ast args mal_function dup /env get 3 1 roll % stack: ast env args mal_function /params get exch % stack: ast env params args env_new % stack: ast new_env } def % function_or_mal_function -> callable -> block % if this is a function or mal_function, get its executable block /callable { dup _mal_function? { %if mal_function /data get }{ dup _function? { %else if function /data get }{ %else something invalid (callable called on non-function!\n) print quit cvx } ifelse } ifelse } def % Lists % array -> _list_from_array -> mal_list /_list_from_array { << /data 3 -1 roll % grab the array argument /_maltype_ /list /meta null >> } def % elem... cnt -> _list -> mal_list /_list { array astore _list_from_array } def /_list? { dup type /dicttype eq { /_maltype_ get /list eq }{ pop false } ifelse } def % Vectors % array -> _vector_from_array -> mal_vector /_vector_from_array { << /data 3 -1 roll % grab the array argument /_maltype_ /vector /meta null >> } def % elem... cnt -> _vector -> mal_vector /_vector { array astore _vector_from_array } def /_vector? { dup type /dicttype eq { /_maltype_ get /vector eq }{ pop false } ifelse } def % Hash Maps % dict -> _hash_map_from_dict -> mal_hash_map /_hash_map_from_dict { << /data 3 -1 roll /_maltype_ /hash_map /meta null >> } def % array -> _hash_map_from_array -> mal_hash_map /_hash_map_from_array { << /data << 4 -1 roll % grab the array argument aload pop % unpack the array >> /_maltype_ /hash_map /meta null >> } def % elem... cnt -> _hash_map -> mal_hash_map /_hash_map { array astore _hash_map_from_array } def /_hash_map? { dup type /dicttype eq { /_maltype_ get /hash_map eq }{ pop false } ifelse } def % Atoms % obj -> atom -> new_atom /_atom { << /data 3 -1 roll /_maltype_ /atom /meta null >> } def /_atom? { dup type /dicttype eq { /_maltype_ get /atom eq }{ pop false } ifelse } def % Sequence operations ================================================ FILE: impls/purs/.gitignore ================================================ /bower_components/ /node_modules/ /.pulp-cache/ /output/ /generated-docs/ /.psc-package/ /.psc* /.purs* /.psa* /.spago /step*.js ================================================ FILE: impls/purs/Dockerfile ================================================ FROM ubuntu:21.10 ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # For building node modules RUN apt-get -y install g++ # Add nodesource apt repo config for 10.x stable RUN apt-get -y install gnupg RUN curl -sL https://deb.nodesource.com/setup_12.x | bash - # Install nodejs RUN apt-get -y install nodejs # Install purescript and deps RUN apt-get install -y git libtinfo5 RUN npm install -g --unsafe-perm purescript spago ENV NPM_CONFIG_CACHE /mal/.npm ENV HOME /mal ================================================ FILE: impls/purs/Makefile ================================================ BINS = step0_repl.js step1_read_print.js step2_eval.js step3_env.js \ step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js \ step8_macros.js step9_try.js stepA_mal.js OTHER_SRCS = src/Readline.js src/Readline.purs src/Types.purs src/Reader.purs \ src/Printer.purs src/Env.purs src/Core.purs all: $(BINS) $(BINS): %.js: src/%.purs $(OTHER_SRCS) node_modules/readline-sync spago bundle-app --main $($(<:src/%=%)) --to $@ node_modules/readline-sync: npm install ##################### step0_repl.purs = Mal.Step0 step1_read_print.purs = Mal.Step1 step2_eval.purs = Mal.Step2 step3_env.purs = Mal.Step3 step4_if_fn_do.purs = Mal.Step4 step5_tco.purs = Mal.Step5 step6_file.purs = Mal.Step6 step7_quote.purs = Mal.Step7 step8_macros.purs = Mal.Step8 step9_try.purs = Mal.Step9 stepA_mal.purs = Mal.StepA clean: rm -rf step*.js output/* ================================================ FILE: impls/purs/package.json ================================================ { "dependencies": { "readline-sync": "^1.4.10" } } ================================================ FILE: impls/purs/packages.dhall ================================================ {- Welcome to your new Dhall package-set! Below are instructions for how to edit this file for most use cases, so that you don't need to know Dhall to use it. ## Use Cases Most will want to do one or both of these options: 1. Override/Patch a package's dependency 2. Add a package not already in the default package set This file will continue to work whether you use one or both options. Instructions for each option are explained below. ### Overriding/Patching a package Purpose: - Change a package's dependency to a newer/older release than the default package set's release - Use your own modified version of some dependency that may include new API, changed API, removed API by using your custom git repo of the library rather than the package set's repo Syntax: where `entityName` is one of the following: - dependencies - repo - version ------------------------------- let upstream = -- in upstream with packageName.entityName = "new value" ------------------------------- Example: ------------------------------- let upstream = -- in upstream with halogen.version = "master" with halogen.repo = "https://example.com/path/to/git/repo.git" with halogen-vdom.version = "v4.0.0" with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies ------------------------------- ### Additions Purpose: - Add packages that aren't already included in the default package set Syntax: where `` is: - a tag (i.e. "v4.0.0") - a branch (i.e. "master") - commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977") ------------------------------- let upstream = -- in upstream with new-package-name = { dependencies = [ "dependency1" , "dependency2" ] , repo = "https://example.com/path/to/git/repo.git" , version = "" } ------------------------------- Example: ------------------------------- let upstream = -- in upstream with benchotron = { dependencies = [ "arrays" , "exists" , "profunctor" , "strings" , "quickcheck" , "lcg" , "transformers" , "foldable-traversable" , "exceptions" , "node-fs" , "node-buffer" , "node-readline" , "datetime" , "now" ] , repo = "https://github.com/hdgarrood/purescript-benchotron.git" , version = "v7.0.0" } ------------------------------- -} let upstream = https://github.com/purescript/package-sets/releases/download/psc-0.14.2-20210713/packages.dhall sha256:654c3148cb995f642c73b4508d987d9896e2ad3ea1d325a1e826c034c0d3cd7b in upstream ================================================ FILE: impls/purs/run ================================================ #!/usr/bin/env bash exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ================================================ FILE: impls/purs/spago.dhall ================================================ {- Welcome to a Spago project! You can edit this file as you like. Need help? See the following resources: - Spago documentation: https://github.com/purescript/spago - Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html When creating a new Spago project, you can use `spago init --no-comments` or `spago init -C` to generate this file without the comments in this block. -} { name = "mal-purescript" , dependencies = [ "arrays" , "console" , "control" , "datetime" , "effect" , "either" , "exceptions" , "foldable-traversable" , "freet" , "identity" , "integers" , "lists" , "maybe" , "node-buffer" , "node-fs" , "now" , "ordered-collections" , "parsing" , "prelude" , "psci-support" , "refs" , "strings" , "tailrec" , "transformers" , "tuples" ] , packages = ./packages.dhall , sources = [ "src/**/*.purs", "test/**/*.purs" ] } ================================================ FILE: impls/purs/src/Core.purs ================================================ module Core (ns) where import Prelude import Data.DateTime.Instant (unInstant) import Data.Int (ceil, toNumber) import Data.List (List(..), concat, drop, foldM, fromFoldable, length, reverse, (:)) import Data.Map.Internal as Map import Data.Maybe (Maybe(..)) import Data.String (take) import Data.String.CodeUnits (singleton) import Data.Time.Duration (Milliseconds(..), toDuration) import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (liftEffect) import Effect.Console (log) import Effect.Exception (throw) import Effect.Now (now) import Effect.Ref as Ref import Reader (readStr) import Node.Encoding (Encoding(..)) import Node.FS.Sync (readTextFile) import Printer (keyValuePairs, printList, printListReadably, printStrReadably) import Readline (readLine) import Types (Key(..), MalExpr(..), MalFn, Meta(..), keyToString, stringToCharList, toAtom, toHashMap, toList, toVector) ns :: List (Tuple String MalFn) ns = fromFoldable [ Tuple "throw" throw' , Tuple "true?" $ pred1 trueQ , Tuple "false?" $ pred1 falseQ , Tuple "=" eqQ , Tuple "+" $ numOp (+) , Tuple "-" $ numOp (-) , Tuple "*" $ numOp (*) , Tuple "/" $ numOp (/) , Tuple "<" $ cmpOp (<) , Tuple "<=" $ cmpOp (<=) , Tuple ">" $ cmpOp (>) , Tuple ">=" $ cmpOp (>=) , Tuple "number?" $ pred1 numberQ , Tuple "pr-str" prStr , Tuple "str" str , Tuple "string?" $ pred1 stringQ , Tuple "prn" prn , Tuple "println" println , Tuple "slurp" slurp , Tuple "readline" readline' , Tuple "read-string" readString , Tuple "time-ms" timeMs , Tuple "symbol?" $ pred1 symbolQ , Tuple "symbol" symbol , Tuple "keyword?" $ pred1 keywordQ , Tuple "keyword" keyword , Tuple "list" list , Tuple "list?" $ pred1 listQ , Tuple "nil?" $ pred1 nilQ , Tuple "empty?" $ pred1 emptyQ , Tuple "count" count , Tuple "sequential?" $ pred1 sequentialQ , Tuple "cons" cons , Tuple "concat" concat' , Tuple "nth" nth , Tuple "first" first , Tuple "rest" rest , Tuple "apply" apply' , Tuple "map" map' , Tuple "map?" $ pred1 mapQ , Tuple "conj" conj' , Tuple "seq" seq , Tuple "vec" vec , Tuple "vector" vector , Tuple "vector?" $ pred1 vectorQ , Tuple "hash-map" hashMap , Tuple "assoc" assoc , Tuple "dissoc" dissoc , Tuple "get" get , Tuple "contains?" containsQ , Tuple "keys" keys , Tuple "vals" vals , Tuple "meta" meta , Tuple "with-meta" withMeta , Tuple "atom" atom , Tuple "atom?" $ pred1 atomQ , Tuple "deref" deref , Tuple "reset!" resetB , Tuple "swap!" swapB , Tuple "macro?" $ pred1 macroQ , Tuple "fn?" $ pred1 fnQ ] -- General functions eqQ :: MalFn eqQ (a:b:Nil) = pure $ MalBoolean $ a == b eqQ _ = throw "illegal arguments to =" -- Error/Exception functions throw' :: MalFn throw' (e:Nil) = throw =<< printStrReadably e throw' _ = throw "illegal arguments to throw" -- Boolean functions trueQ :: MalExpr -> Boolean trueQ (MalBoolean true) = true trueQ _ = false falseQ :: MalExpr -> Boolean falseQ (MalBoolean false) = true falseQ _ = false -- Numeric functions numOp ∷ (Number → Number → Number) → MalFn numOp op (MalInt n1 : MalInt n2 : Nil) = pure $ MalInt $ ceil $ op (toNumber n1) (toNumber n2) numOp op (MalInt n1 : MalTime n2 : Nil) = pure $ MalInt $ ceil $ op (toNumber n1) n2 numOp op (MalTime n1 : MalInt n2 : Nil) = pure $ MalInt $ ceil $ op n1 (toNumber n2) numOp op (MalTime n1 : MalTime n2 : Nil) = pure $ MalTime $ op n1 n2 numOp _ _ = throw "invalid operator" cmpOp ∷ (Number → Number → Boolean) → List MalExpr → Effect MalExpr cmpOp op (MalInt n1 : MalInt n2 : Nil) = pure $ MalBoolean $ op (toNumber n1) (toNumber n2) cmpOp op (MalInt n1 : MalTime n2 : Nil) = pure $ MalBoolean $ op (toNumber n1) n2 cmpOp op (MalTime n1 : MalInt n2 : Nil) = pure $ MalBoolean $ op n1 (toNumber n2) cmpOp op (MalTime n1 : MalTime n2 : Nil) = pure $ MalBoolean $ op n1 n2 cmpOp _ _ = throw "invalid operator" numberQ :: MalExpr -> Boolean numberQ (MalInt _) = true numberQ (MalTime _) = true numberQ _ = false -- String functions prStr :: MalFn prStr a = liftEffect $ MalString <$> printList a str :: MalFn str a = liftEffect $ MalString <$> printListReadably "" a stringQ :: MalExpr -> Boolean stringQ (MalString "") = true stringQ (MalString s) = take 1 s /= ":" stringQ _ = false prn :: MalFn prn args = liftEffect $ do log =<< printList args pure MalNil println :: MalFn println args = liftEffect $ do log =<< printListReadably " " args pure MalNil slurp :: MalFn slurp (MalString path : Nil) = MalString <$> liftEffect (readTextFile UTF8 path) slurp _ = throw "invalid arguments to slurp" readline' :: MalFn readline' (MalString prompt : Nil) = MalString <$> readLine prompt readline' _ = throw "invalid arguments to readline" readString :: MalFn readString (MalString s : Nil) = readStr s readString _ = throw "invalid read-string" timeMs :: MalFn timeMs Nil = do n <- now pure $ MalTime $ (unwap <<< toDuration <<< unInstant) n where unwap :: Milliseconds -> Number unwap (Milliseconds n) = n timeMs _ = throw "invalid time-ms" -- Scalar functions symbolQ :: MalExpr -> Boolean symbolQ (MalSymbol _) = true symbolQ _ = false symbol :: MalFn symbol (MalString s : Nil) = pure $ MalSymbol s symbol _ = throw "symbol called with non-string" keywordQ :: MalExpr -> Boolean keywordQ (MalKeyword s) = take 1 s == ":" keywordQ _ = false keyword :: MalFn keyword (kw@(MalString s) : Nil) | take 1 s == ":" = pure kw keyword (MalString s : Nil) = pure $ MalKeyword (":" <> s) keyword (kw@(MalKeyword s) : Nil) | take 1 s == ":" = pure kw keyword (MalKeyword s : Nil) = pure $ MalKeyword (":" <> s) keyword _ = throw "keyword called with non-string" -- List functions list :: MalFn list = pure <<< toList listQ :: MalExpr -> Boolean listQ (MalList _ _ ) = true listQ _ = false nilQ :: MalExpr -> Boolean nilQ MalNil = true nilQ _ = false emptyQ :: MalExpr -> Boolean emptyQ (MalList _ Nil) = true emptyQ (MalVector _ Nil) = true emptyQ _ = false count :: MalFn count (MalNil:Nil) = pure $ MalInt 0 count (MalList _ ex : Nil) = pure $ MalInt $ length ex count (MalVector _ ex : Nil) = pure $ MalInt $ length ex count _ = throw "non-sequence passed to count" sequentialQ :: MalExpr -> Boolean sequentialQ (MalList _ _) = true sequentialQ (MalVector _ _) = true sequentialQ _ = false cons :: MalFn cons (x:Nil) = pure $ toList $ x:Nil cons (x : MalList _ xs : Nil) = pure $ toList $ x:xs cons (x : MalVector _ xs : Nil) = pure $ toList $ x:xs cons _ = throw "illegal call to cons" concat' :: MalFn concat' args = toList <<< concat <$> traverse unwrapSeq args where unwrapSeq :: MalExpr -> Effect (List MalExpr) unwrapSeq (MalList _ xs) = pure xs unwrapSeq (MalVector _ xs) = pure xs unwrapSeq _ = throw "invalid concat" nth :: MalFn nth (MalList _ xs : MalInt n : Nil) = case drop n xs of x:_ -> pure x Nil -> throw "nth: index out of range" nth (MalVector _ xs : MalInt n : Nil) = case drop n xs of x:_ -> pure x Nil -> throw "nth: index out of range" nth _ = throw "invalid call to nth" first :: MalFn first (MalNil:Nil) = pure MalNil first (MalList _ Nil : Nil) = pure MalNil first (MalList _ (x:_) : Nil) = pure x first (MalVector _ Nil : Nil) = pure MalNil first (MalVector _ (x:_) : Nil) = pure x first _ = throw "illegal call to first" rest :: MalFn rest (MalNil:Nil) = pure $ toList Nil rest (MalList _ Nil : Nil) = pure $ toList Nil rest (MalList _ (_:xs) : Nil) = pure $ toList xs rest (MalVector _ Nil : Nil) = pure $ toList Nil rest (MalVector _ (_:xs) : Nil) = pure $ toList xs rest _ = throw "illegal call to rest" apply' :: MalFn apply' (MalFunction {fn:f} : as) = f =<< concatLast as where concatLast :: List MalExpr -> Effect (List MalExpr) concatLast (MalList _ lst : Nil) = pure lst concatLast (MalVector _ lst : Nil) = pure lst concatLast (x:xs) = (:) x <$> concatLast xs concatLast _ = throw "last argument of apply must be a sequence" apply' _ = throw "Illegal call to apply" map' :: MalFn map' (MalFunction {fn:f} : MalList _ args : Nil) = toList <$> traverse (\x -> f (x:Nil)) args map' (MalFunction {fn:f} : MalVector _ args : Nil) = toList <$> traverse (\x -> f (x:Nil)) args map' _ = throw "Illegal call to map" mapQ :: MalExpr -> Boolean mapQ (MalHashMap _ _) = true mapQ _ = false conj' :: MalFn conj' (MalList _ es : args) = pure $ toList $ reverse args <> es conj' (MalVector _ es : args) = pure $ toVector $ es <> args conj' _ = throw "illegal arguments to conj" seq :: MalFn seq (MalNil:Nil) = pure MalNil seq (MalList _ Nil : Nil) = pure MalNil seq (MalList _ es : Nil) = pure $ toList es seq (MalVector _ Nil : Nil) = pure MalNil seq (MalVector _ es : Nil) = pure $ toList es seq (MalString "" : Nil) = pure MalNil seq (MalString s : Nil) = pure $ toList $ map (MalString <<< singleton) (stringToCharList s) seq _ = throw "seq: called on non-sequence" -- Vector functions vec :: MalFn vec (MalList _ xs : Nil) = pure $ toVector xs vec (MalVector _ xs : Nil) = pure $ toVector xs vec Nil = throw "vec: arg type" vec _ = throw "vec: arg type" vector :: MalFn vector = pure <<< toVector vectorQ :: MalExpr -> Boolean vectorQ (MalVector _ _) = true vectorQ _ = false -- Hash Map functions hashMap :: MalFn hashMap kvs = case keyValuePairs kvs of Just pairs -> pure $ toHashMap $ Map.fromFoldable pairs Nothing -> throw "invalid call to hash-map" assoc :: MalFn assoc (MalHashMap _ hm : kvs) = case keyValuePairs kvs of Just pairs -> pure $ toHashMap $ Map.union (Map.fromFoldable pairs) hm Nothing -> throw "invalid assoc" assoc _ = throw "invalid call to assoc" dissoc :: MalFn dissoc (MalHashMap _ hm : ks) = toHashMap <$> foldM remover hm ks where remover :: Map.Map Key MalExpr -> MalExpr -> Effect (Map.Map Key MalExpr) remover m (MalKeyword k) = pure $ Map.delete (KeywordKey k) m remover m (MalString k) = pure $ Map.delete (StringKey k) m remover _ _ = throw "invalid dissoc" dissoc _ = throw "invalid call to dissoc" get :: MalFn get (MalHashMap _ hm : MalString k : Nil) = pure case Map.lookup (StringKey k) hm of Just mv -> mv Nothing -> MalNil get (MalHashMap _ hm : MalKeyword k : Nil) = pure case Map.lookup (KeywordKey k) hm of Just mv -> mv Nothing -> MalNil get (MalNil : MalString _ : Nil) = pure MalNil get _ = throw "invalid call to get" containsQ :: MalFn containsQ (MalHashMap _ hm : MalString k : Nil) = pure $ MalBoolean $ Map.member (StringKey k) hm containsQ (MalHashMap _ hm : MalKeyword k : Nil) = pure $ MalBoolean $ Map.member (KeywordKey k) hm containsQ (MalNil : MalString _ : Nil) = pure $ MalBoolean false containsQ _ = throw "invalid call to contains?" keys :: MalFn keys (MalHashMap _ hm : Nil) = pure $ toList $ keyToString <$> Map.keys hm keys _ = throw "invalid call to keys" vals :: MalFn vals (MalHashMap _ hm : Nil) = pure $ toList $ Map.values hm vals _ = throw "invalid call to vals" -- Metadata functions meta :: MalFn meta (MalList (Meta m) _ : Nil) = pure m meta (MalVector (Meta m) _ : Nil) = pure m meta (MalHashMap (Meta m) _ : Nil) = pure m meta (MalAtom (Meta m) _ : Nil) = pure m meta (MalFunction {meta:m} : Nil) = pure m meta _ = throw "invalid meta call" withMeta :: MalFn withMeta (MalList _ es : m : Nil) = pure $ MalList (Meta m) es withMeta (MalVector _ es : m : Nil) = pure $ MalVector (Meta m) es withMeta (MalHashMap _ es : m : Nil) = pure $ MalHashMap (Meta m) es withMeta (MalAtom _ es : m : Nil) = pure $ MalAtom (Meta m) es withMeta ((MalFunction f) : m : Nil) = pure $ MalFunction $ f {meta = m} withMeta _ = throw "invalid with-meta call" -- Atom functions atom :: MalFn atom (v:Nil) = toAtom <$> liftEffect (Ref.new v) atom _ = throw "invalid atom call" atomQ :: MalExpr -> Boolean atomQ (MalAtom _ _) = true atomQ _ = false deref :: MalFn deref (MalAtom _ ref : Nil) = liftEffect $ Ref.read ref deref _ = throw "invalid deref call" resetB :: MalFn resetB (MalAtom _ ref : val : Nil) = liftEffect $ Ref.write val ref *> pure val resetB _ = throw "invalid reset!" swapB :: MalFn swapB (MalAtom _ ref : MalFunction {fn:f} : args) = do val <- liftEffect $ Ref.read ref newVal <- f $ val:args liftEffect $ Ref.write newVal ref pure newVal swapB _ = throw "Illegal swap!" -- Macro macroQ :: MalExpr -> Boolean macroQ (MalFunction {macro:true}) = true macroQ _ = false -- Function fnQ :: MalExpr -> Boolean fnQ (MalFunction {macro:false}) = true fnQ _ = false -- Utils pred1 :: (MalExpr -> Boolean) -> MalFn pred1 f (x:Nil) = pure $ MalBoolean $ f x pred1 _ _ = throw "illegal call to unary predicate" ================================================ FILE: impls/purs/src/Env.purs ================================================ module Env where import Prelude import Data.List (List(..), (:)) import Data.Map (fromFoldable, insert, lookup) import Data.Maybe (Maybe(..)) import Effect (Effect) import Effect.Console (error) import Effect.Ref as Ref import Types (Local, MalExpr, RefEnv, toList) -- Environment initEnv :: Local initEnv = fromFoldable Nil newEnv :: RefEnv -> Effect RefEnv newEnv re = flip (:) re <$> Ref.new initEnv -- VARIABLE get :: RefEnv -> String -> Effect (Maybe MalExpr) get Nil _ = pure Nothing get (ref:outer) ky = do envs <- Ref.read ref case lookup ky envs of Nothing -> get outer ky ex -> pure ex sets :: RefEnv -> List String -> List MalExpr -> Effect Boolean sets _ Nil Nil = pure true sets env ("&":k:Nil) exs = set env k (toList exs) *> pure true sets env (ky:kys) (ex:exs) = set env ky ex *> sets env kys exs sets _ _ _ = pure false set :: RefEnv -> String -> MalExpr -> Effect Unit set (re:_) ky ex = Ref.modify_ (insert ky ex) re set Nil _ _ = error "assertion failed in env_set" ================================================ FILE: impls/purs/src/Printer.purs ================================================ module Printer where import Prelude import Data.List (List(..), (:)) import Data.Map (toUnfoldable) import Data.Maybe (Maybe(..)) import Data.String.CodeUnits (singleton) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Ref as Ref import Types (Key(..), MalExpr(..), flatTuples, flatStrings, stringToCharList) -- PRINT STRING printStr :: MalExpr -> Effect String printStr MalNil = pure "nil" printStr (MalBoolean b) = pure $ show b printStr (MalInt n) = pure $ show n printStr (MalTime n) = pure $ show n printStr (MalString str) = pure $ "\"" <> (str # stringToCharList # map unescape # flatStrings) <> "\"" printStr (MalKeyword key) = pure key printStr (MalAtom _ r) = "(atom " <<> (Ref.read r >>= printStr) <>> ")" printStr (MalSymbol name) = pure name printStr (MalList _ xs) = "(" <<> printList xs <>> ")" printStr (MalVector _ vs) = "[" <<> printList vs <>> "]" printStr (MalHashMap _ hm) = "{" <<> (hm # toUnfoldable # flatTuples # printList) <>> "}" printStr (MalFunction _) = pure "#" printList :: List MalExpr -> Effect String printList Nil = pure "" printList (x:Nil) = printStr x printList (x:xs) = printStr x <> pure " " <> printList xs -- PRINT STRING READABLY printStrReadably :: MalExpr -> Effect String printStrReadably (MalString str) = pure str printStrReadably (MalList _ xs) = "(" <<> printListReadably " " xs <>> ")" printStrReadably (MalVector _ vs) = "[" <<> printListReadably " " vs <>> "]" printStrReadably (MalHashMap _ hm) = "{" <<> (hm # toUnfoldable # flatTuples # printListReadably " ") <>> "}" printStrReadably ex = printStr ex printListReadably :: String -> List MalExpr -> Effect String printListReadably _ Nil = pure "" printListReadably _ (x:Nil) = printStrReadably x printListReadably sep (x:xs) = printStrReadably x <> pure sep <> printListReadably sep xs -- UTILS unescape :: Char -> String unescape '\n' = "\\n" unescape '\\' = "\\\\" unescape '"' = "\\\"" unescape c = singleton c keyValuePairs :: List MalExpr -> Maybe (List (Tuple Key MalExpr)) keyValuePairs Nil = pure Nil keyValuePairs (MalString k : v : kvs) = (:) (Tuple (StringKey k) v) <$> keyValuePairs kvs keyValuePairs (MalKeyword k : v : kvs) = (:) (Tuple (KeywordKey k) v) <$> keyValuePairs kvs keyValuePairs _ = Nothing leftConcat :: forall m s. Bind m => Applicative m => Semigroup s => s -> m s -> m s leftConcat op f = (<>) <$> pure op <*> f infixr 5 leftConcat as <<> rightConcat :: forall m s. Apply m => Semigroup s => Applicative m => m s -> s -> m s rightConcat f cl = (<>) <$> f <*> pure cl infixr 5 rightConcat as <>> ================================================ FILE: impls/purs/src/Reader.purs ================================================ module Reader (readStr) where import Prelude import Control.Alt ((<|>)) import Control.Lazy (fix) import Data.Either (Either(..)) import Data.Int (fromString) import Data.List (List(..), many, (:)) import Data.Maybe (Maybe(..), fromMaybe) import Effect (Effect) import Effect.Exception (throw) import Printer (keyValuePairs) import Text.Parsing.Parser (Parser, fail, runParser) import Text.Parsing.Parser.Combinators (endBy, skipMany, skipMany1, try) import Text.Parsing.Parser.String (char, noneOf, oneOf, string) import Text.Parsing.Parser.Token (digit, letter) import Types (MalExpr(..), charListToString, listToMap, toHashMap, toList, toVector) spaces :: Parser String Unit spaces = skipMany1 $ oneOf [',', ' ', '\n'] comment :: Parser String Unit comment = char ';' *> (skipMany $ noneOf [ '\r', '\n' ]) ignored :: Parser String Unit ignored = skipMany $ spaces <|> comment symbol :: Parser String Char symbol = oneOf ['!', '#', '$', '%', '&', '|', '*', '+', '-', '/', ':', '<', '=', '>', '?', '@', '^', '_', '~'] nat :: Parser String Int nat = do first <- digit rest <- many digit pure <<< fromMaybe 0 <<< fromString <<< charListToString $ first : rest escape :: Parser String Char escape = char '\\' *> oneOf ['\\', '\"', 'n'] <#> case _ of 'n' -> '\n' x -> x nonEscape :: Parser String Char nonEscape = noneOf [ '\"', '\\' ] -- ATOM readAtom :: Parser String MalExpr readAtom = readNumber <|> try readNegativeNumber <|> readString <|> readKeyword <|> readSymbol readNumber :: Parser String MalExpr readNumber = MalInt <$> nat readNegativeNumber :: Parser String MalExpr readNegativeNumber = MalInt <<< negate <$> (char '-' *> nat) readString :: Parser String MalExpr readString = MalString <$> charListToString <$> (char '"' *> many (escape <|> nonEscape) <* char '"') readKeyword :: Parser String MalExpr readKeyword = MalKeyword <$> charListToString <$> ((:) ':') <$> (char ':' *> many (letter <|> digit <|> symbol)) readSymbol :: Parser String MalExpr readSymbol = f <$> (letter <|> symbol) <*> many (letter <|> digit <|> symbol) where f first rest = charListToString (first:rest) # case _ of "true" -> MalBoolean true "false" -> MalBoolean false "nil" -> MalNil s -> MalSymbol s -- readList :: Parser String MalExpr readList = fix $ \_ -> toList <$> (char '(' *> ignored *> endBy readForm ignored <* char ')') -- readVector :: Parser String MalExpr readVector = fix $ \_ -> toVector <$> (char '[' *> ignored *> endBy readForm ignored <* char ']') -- readHashMap :: Parser String MalExpr readHashMap = fix $ \_ -> char '{' *> ignored *> endBy readForm ignored <* char '}' <#> keyValuePairs >>= case _ of Just ts -> pure $ toHashMap $ listToMap ts Nothing -> fail "invalid contents inside map braces" -- MACROS readMacro :: Parser String MalExpr readMacro = fix $ \_ -> macro "\'" "quote" <|> macro "`" "quasiquote" <|> try (macro "~@" "splice-unquote") <|> macro "~" "unquote" <|> macro "@" "deref" <|> readWithMeta macro :: String -> String -> Parser String MalExpr macro tok sym = addPrefix sym <$> (string tok *> readForm) where addPrefix :: String -> MalExpr -> MalExpr addPrefix s x = toList $ MalSymbol s : x : Nil readWithMeta :: Parser String MalExpr readWithMeta = addPrefix <$> (char '^' *> readForm) <*> readForm where addPrefix :: MalExpr -> MalExpr -> MalExpr addPrefix m x = toList $ MalSymbol "with-meta" : x : m : Nil -- readForm :: Parser String MalExpr readForm = fix $ \_ -> ignored *> ( readMacro <|> readList <|> readVector <|> readHashMap <|> readAtom) -- readStr :: String -> Effect MalExpr readStr str = case runParser str readForm of Left _ -> throw "EOF" Right val -> pure val ================================================ FILE: impls/purs/src/Readline.js ================================================ "use strict"; var readlineSync = require('readline-sync') exports.readLine = function (x) { return function () { const result = readlineSync.question(x); if(readlineSync.getRawInput() === String.fromCharCode(0)){ return ":q" } return result; } } exports.argv = process.argv; ================================================ FILE: impls/purs/src/Readline.purs ================================================ module Readline where import Prelude import Data.List (List, drop, fromFoldable) import Effect (Effect) foreign import readLine :: String -> Effect String foreign import argv :: Array String args :: List String args = drop 2 $ fromFoldable argv ================================================ FILE: impls/purs/src/Types.purs ================================================ module Types where import Prelude import Data.Array as Array import Data.Foldable (class Foldable) import Data.List (List(..), foldr, (:)) import Data.List as List import Data.Map (Map) import Data.Map.Internal as Map import Data.Maybe (Maybe(..)) import Data.String.CodeUnits (fromCharArray, toCharArray) import Data.Traversable (foldl) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Ref (Ref) import Effect.Ref as Ref data MalExpr = MalNil | MalBoolean Boolean | MalInt Int | MalTime Time | MalString String | MalKeyword String | MalSymbol String | MalAtom Meta (Ref MalExpr) | MalList Meta (List MalExpr) | MalVector Meta (List MalExpr) | MalHashMap Meta (Map Key MalExpr) | MalFunction { fn :: MalFn , ast :: MalExpr , env :: RefEnv , params :: List String , macro :: Boolean , meta :: MalExpr } type Time = Number instance Eq MalExpr where eq MalNil MalNil = true eq (MalBoolean a) (MalBoolean b) = a == b eq (MalInt a) (MalInt b) = a == b eq (MalTime a) (MalTime b) = a == b eq (MalString a) (MalString b) = a == b eq (MalKeyword a) (MalKeyword b) = a == b eq (MalSymbol a) (MalSymbol b) = a == b eq (MalList _ a) (MalList _ b) = a == b eq (MalVector _ a) (MalList _ b) = a == b eq (MalList _ a) (MalVector _ b) = a == b eq (MalVector _ a) (MalVector _ b) = a == b eq (MalHashMap _ a) (MalHashMap _ b) = a == b eq _ _ = false data Key = StringKey String | KeywordKey String derive instance Eq Key derive instance Ord Key type MalFn = List MalExpr -> Effect MalExpr type Local = Map String MalExpr type RefEnv = List (Ref.Ref Local) -- Metas newtype Meta = Meta MalExpr toList :: List MalExpr -> MalExpr toList = MalList (Meta MalNil) toVector :: List MalExpr -> MalExpr toVector = MalVector (Meta MalNil) toAtom :: Ref MalExpr -> MalExpr toAtom = MalAtom (Meta MalNil) toHashMap :: Map Key MalExpr -> MalExpr toHashMap = MalHashMap (Meta MalNil) -- Utils listToMap :: List (Tuple Key MalExpr) -> Map Key MalExpr listToMap = Map.fromFoldable charListToString :: List Char -> String charListToString = fromCharArray <<< Array.fromFoldable stringToCharList :: String -> List Char stringToCharList = List.fromFoldable <<< toCharArray flatStrings :: List String -> String flatStrings = foldr (<>) "" flatTuples :: List (Tuple Key MalExpr) -> List MalExpr flatTuples ((Tuple (StringKey a) b) : xs) = MalString a : b : flatTuples xs flatTuples ((Tuple (KeywordKey a) b) : xs) = MalKeyword a : b : flatTuples xs flatTuples _ = Nil foldrM :: forall a m b f. Foldable f => Monad m => (a -> b -> m b) -> b -> f a -> m b foldrM f z0 xs = foldl c pure xs z0 where c k x z = f x z >>= k keyToString :: Key -> MalExpr keyToString (StringKey k) = MalString k keyToString (KeywordKey k) = MalKeyword k keyValuePairs :: List MalExpr -> Maybe (List (Tuple String MalExpr)) keyValuePairs Nil = pure Nil keyValuePairs (MalString k : v : kvs) = (:) (Tuple k v) <$> keyValuePairs kvs keyValuePairs _ = Nothing ================================================ FILE: impls/purs/src/step0_repl.purs ================================================ module Mal.Step0 where import Prelude import Effect (Effect) import Effect.Console (log) import Readline (readLine) -- MAIN main :: Effect Unit main = loop -- EVAL eval :: String -> String eval s = s -- REPL rep :: String -> String rep = read >>> eval >>> print loop :: Effect Unit loop = do line <- readLine "user> " case line of "" -> loop ":q" -> pure unit _ -> do log line loop -- READ read :: String -> String read s = s -- PRINT print :: String -> String print s = s ================================================ FILE: impls/purs/src/step1_read_print.purs ================================================ module Mal.Step1 where import Prelude import Control.Monad.Error.Class (try) import Data.Either (Either(..)) import Effect (Effect) import Effect.Console (error, log) import Printer (printStr) import Reader (readStr) import Readline (readLine) import Types (MalExpr) -- MAIN main :: Effect Unit main = loop -- EVAL eval :: MalExpr -> MalExpr eval s = s -- REPL rep :: String -> Effect Unit rep str = do result <- try $ read str case result of Left err -> error $ show err Right exp -> print (eval exp) >>= log loop :: Effect Unit loop = do line <- readLine "user> " case line of "" -> loop ":q" -> pure unit _ -> do rep line loop -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr ================================================ FILE: impls/purs/src/step2_eval.purs ================================================ module Mal.Step2 where import Prelude import Data.Either (Either(..)) import Data.List (List(..), (:)) import Data.Map (Map, lookup) import Data.Map as Map import Data.Maybe (Maybe(..)) import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (error, log) import Effect.Exception (throw, try) import Reader (readStr) import Printer (printStr) import Readline (readLine) import Types (MalExpr(..), MalFn, toHashMap, toVector) -- MAIN main :: Effect Unit main = loop -- EVAL evalCallFn :: List MalExpr -> Effect MalExpr evalCallFn ast = do es <- traverse eval ast case es of MalFunction {fn:f}: args -> f args _ -> throw $ "invalid function" eval :: MalExpr -> Effect MalExpr eval (MalSymbol s) = case lookup s replEnv of Just f -> pure f Nothing -> throw "invalid function" eval (MalList _ es@(_ : _)) = evalCallFn es eval (MalVector _ es) = toVector <$> (traverse eval es) eval (MalHashMap _ es) = toHashMap <$> (traverse eval es) eval ast = pure ast -- ENV type ReplEnv = Map String MalExpr replEnv :: ReplEnv replEnv = Map.fromFoldable [ (Tuple "+" (fn (+))) , (Tuple "-" (fn (-))) , (Tuple "*" (fn (*))) , (Tuple "/" (fn (/))) ] fn :: (Int -> Int -> Int) -> MalExpr fn op = MalFunction { fn : g op , ast : MalNil , env : Nil , params : Nil , macro : false , meta : MalNil } where g :: (Int -> Int -> Int) -> MalFn g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2 g _ _ = throw "invalid operator" -- REPL rep :: String -> Effect Unit rep str = do result <- try $ eval =<< read str case result of Left err -> error $ show err Right exp -> print exp >>= log loop :: Effect Unit loop = do line <- readLine "user> " case line of "" -> loop ":q" -> pure unit _ -> rep line *> loop -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr ================================================ FILE: impls/purs/src/step3_env.purs ================================================ module Mal.Step3 where import Prelude import Control.Monad.Error.Class (try) import Data.Either (Either(..)) import Data.List (List(..), (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse) import Effect (Effect) import Effect.Console (error, log) import Effect.Exception (throw) import Env as Env import Reader (readStr) import Printer (printStr) import Readline (readLine) import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) -- MAIN main :: Effect Unit main = do re <- Env.newEnv Nil setArithOp re loop re -- EVAL evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr evalCallFn env ast = do es <- traverse (eval env) ast case es of MalFunction {fn:f} : args -> f args _ -> throw "invalid function" eval :: RefEnv -> MalExpr -> Effect MalExpr eval env ast = do dbgeval <- Env.get env "DEBUG-EVAL" case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ es@(_ : _) -> evalCallFn env es MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast evalDef :: RefEnv -> List MalExpr -> Effect MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" evalLet :: RefEnv -> List MalExpr -> Effect MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Effect Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do Env.set env ky =<< eval env e letBind env es letBind _ _ = throw "invalid let*" -- REPL rep :: RefEnv -> String -> Effect String rep env str = print =<< eval env =<< read str loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setArithOp :: RefEnv -> Effect Unit setArithOp env = do Env.set env "+" =<< fn (+) Env.set env "-" =<< fn (-) Env.set env "*" =<< fn (*) Env.set env "/" =<< fn (/) fn :: (Int -> Int -> Int) -> Effect MalExpr fn op = do newEnv <- Env.newEnv Nil pure $ MalFunction { fn : g op , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } where g :: (Int -> Int -> Int) -> MalFn g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2 g _ _ = throw "invalid operator" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr ================================================ FILE: impls/purs/src/step4_if_fn_do.purs ================================================ module Mal.Step4 where import Prelude import Control.Monad.Error.Class (try) import Core as Core import Data.Either (Either(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (error, log) import Effect.Exception (throw) import Env as Env import Reader (readStr) import Printer (printStr) import Readline (readLine) import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) -- MAIN main :: Effect Unit main = do re <- Env.newEnv Nil _ <- traverse (setFn re) Core.ns _ <- rep re "(def! not (fn* (a) (if a false true)))" loop re -- EVAL evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr evalCallFn env ast = do es <- traverse (eval env) ast case es of MalFunction {fn:f} : args -> f args _ -> throw "invalid function" eval :: RefEnv -> MalExpr -> Effect MalExpr eval env ast = do dbgeval <- Env.get env "DEBUG-EVAL" case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ es@(_ : _) -> evalCallFn env es MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast evalDef :: RefEnv -> List MalExpr -> Effect MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" evalLet :: RefEnv -> List MalExpr -> Effect MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Effect Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do Env.set env ky =<< eval env e letBind env es letBind _ _ = throw "invalid let*" evalIf :: RefEnv -> List MalExpr -> Effect MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" evalDo :: RefEnv -> List MalExpr -> Effect MalExpr evalDo env es = foldM (const $ eval env) MalNil es evalFnMatch :: RefEnv -> List MalExpr -> Effect MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Effect MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Effect String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- REPL rep :: RefEnv -> String -> Effect String rep env str = print =<< eval env =<< read str loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr ================================================ FILE: impls/purs/src/step5_tco.purs ================================================ module Mal.Step5 where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (readLine) import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do re <- Env.newEnv Nil traverse_ (setFn re) Core.ns rep_ re "(def! not (fn* (a) (if a false true)))" loop re -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ es@(_ : _) -> evalCallFn env es MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } -- CALL FUNCTION evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr evalCallFn env ast = do es <- traverse (eval env) ast case es of MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} : args -> do newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/purs/src/step6_file.purs ================================================ module Mal.Step6 where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (args, readLine) import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toList, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do env <- Env.newEnv Nil traverse_ (setFn env) Core.ns setFn env $ Tuple "eval" $ setEval env rep_ env "(def! not (fn* (a) (if a false true)))" rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" case args of Nil -> do Env.set env "*ARGV*" $ toList Nil loop env script:scriptArgs -> do Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs rep_ env $ "(load-file \"" <> script <> "\")" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } setEval :: RefEnv -> MalFn setEval env (ast:Nil) = runEval $ eval env ast setEval _ _ = throw "illegal call of eval" -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ es@(_ : _) -> evalCallFn env es MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- CALL FUNCTION evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr evalCallFn env ast = do es <- traverse (eval env) ast case es of MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} : args -> do newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/purs/src/step7_quote.purs ================================================ module Mal.Step7 where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (args, readLine) import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do env <- Env.newEnv Nil traverse_ (setFn env) Core.ns setFn env $ Tuple "eval" $ setEval env rep_ env "(def! not (fn* (a) (if a false true)))" rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" case args of Nil -> do Env.set env "*ARGV*" $ toList Nil loop env script:scriptArgs -> do Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs rep_ env $ "(load-file \"" <> script <> "\")" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } setEval :: RefEnv -> MalFn setEval env (ast:Nil) = runEval $ eval env ast setEval _ _ = throw "illegal call of eval" -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ (MalSymbol "quote" : es) -> evalQuote env es MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es MalList _ es@(_ : _) -> evalCallFn env es MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast -- Def evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" -- Let evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" -- If evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" -- Do evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es -- Function evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- Quote evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuote _ (e:Nil) = pure e evalQuote _ _ = throw "invalid quote" evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuasiquote env (e:Nil) = eval env =<< quasiquote e evalQuasiquote _ _ = throw "invalid quasiquote" quasiquote :: MalExpr -> Eval MalExpr quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs quasiquote (MalVector _ xs) = do lst <- foldrM qqIter (toList Nil) xs pure $ toList $ MalSymbol "vec" : lst : Nil quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast = pure ast qqIter :: MalExpr -> MalExpr -> Eval MalExpr qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" qqIter elt acc = do qqted <- quasiquote elt pure $ toList $ MalSymbol "cons" : qqted : acc : Nil -- CALL FUNCTION evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr evalCallFn env ast = do es <- traverse (eval env) ast case es of MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} : args -> do newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/purs/src/step8_macros.purs ================================================ module Mal.Step8 where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (args, readLine) import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do env <- Env.newEnv Nil traverse_ (setFn env) Core.ns setFn env $ Tuple "eval" $ setEval env rep_ env "(def! not (fn* (a) (if a false true)))" rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep_ env "(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)))))))" case args of Nil -> do Env.set env "*ARGV*" $ toList Nil loop env script:scriptArgs -> do Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs rep_ env $ "(load-file \"" <> script <> "\")" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } setEval :: RefEnv -> MalFn setEval env (ast:Nil) = runEval $ eval env ast setEval _ _ = throw "illegal call of eval" -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ (MalSymbol "quote" : es) -> evalQuote env es MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast -- DEF evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" -- LET evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" -- IF evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" -- DO evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es -- FUNCTION evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- QUOTE evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuote _ (e:Nil) = pure e evalQuote _ _ = throw "invalid quote" evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuasiquote env (e:Nil) = eval env =<< quasiquote e evalQuasiquote _ _ = throw "invalid quasiquote" quasiquote :: MalExpr -> Eval MalExpr quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs quasiquote (MalVector _ xs) = do lst <- foldrM qqIter (toList Nil) xs pure $ toList $ MalSymbol "vec" : lst : Nil quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast = pure ast qqIter :: MalExpr -> MalExpr -> Eval MalExpr qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" qqIter elt acc = do qqted <- quasiquote elt pure $ toList $ MalSymbol "cons" : qqted : acc : Nil -- MACRO evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr evalDefmacro env (MalSymbol a : b : Nil) = do f <- eval env b case f of MalFunction fn@{macro:false} -> do let m = MalFunction $ fn {macro = true} liftEffect $ Env.set env a m pure m _ -> throw "defmacro! on non-function" evalDefmacro _ _ = throw "invalid defmacro!" -- CALL FUNCTION evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr evalCallFn env rawFunc rawArgs = do func <- eval env rawFunc case func of MalFunction {fn:f, macro:true} -> do newAst <- liftEffect $ f rawArgs eval env newAst MalFunction {fn:f, ast:MalNil} -> do args <- traverse (eval env) rawArgs liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} -> do args <- traverse (eval env) rawArgs newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/purs/src/step9_try.purs ================================================ module Mal.Step9 where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (args, readLine) import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do env <- Env.newEnv Nil traverse_ (setFn env) Core.ns setFn env $ Tuple "eval" $ setEval env rep_ env "(def! not (fn* (a) (if a false true)))" rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep_ env "(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)))))))" case args of Nil -> do Env.set env "*ARGV*" $ toList Nil loop env script:scriptArgs -> do Env.set env "*ARGV*" $ toList $ MalString <$> scriptArgs rep_ env $ "(load-file \"" <> script <> "\")" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } setEval :: RefEnv -> MalFn setEval env (ast:Nil) = runEval $ eval env ast setEval _ _ = throw "illegal call of eval" -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ (MalSymbol "quote" : es) -> evalQuote env es MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast -- Def evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" -- Let evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" -- If evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" -- Do evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es -- Function evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- Quote evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuote _ (e:Nil) = pure e evalQuote _ _ = throw "invalid quote" evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuasiquote env (e:Nil) = eval env =<< quasiquote e evalQuasiquote _ _ = throw "invalid quasiquote" quasiquote :: MalExpr -> Eval MalExpr quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs quasiquote (MalVector _ xs) = do lst <- foldrM qqIter (toList Nil) xs pure $ toList $ MalSymbol "vec" : lst : Nil quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast = pure ast qqIter :: MalExpr -> MalExpr -> Eval MalExpr qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" qqIter elt acc = do qqted <- quasiquote elt pure $ toList $ MalSymbol "cons" : qqted : acc : Nil -- Macro evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr evalDefmacro env (MalSymbol a : b : Nil) = do f <- eval env b case f of MalFunction fn@{macro:false} -> do let m = MalFunction $ fn {macro = true} liftEffect $ Env.set env a m pure m _ -> throw "defmacro! on non-function" evalDefmacro _ _ = throw "invalid defmacro!" -- Try evalTry :: RefEnv -> List MalExpr -> Effect MalExpr evalTry env (a:Nil) = runEval $ eval env a evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do res <- try $ runEval $ eval env thw case res of Left err -> do tryEnv <- Env.newEnv env Env.set tryEnv e $ MalString $ Ex.message err -- FIXME: runEval $ eval tryEnv b Right v -> pure v evalTry _ _ = Ex.throw "invalid try*" -- CALL FUNCTION evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr evalCallFn env rawFunc rawArgs = do func <- eval env rawFunc case func of MalFunction {fn:f, macro:true} -> do newAst <- liftEffect $ f rawArgs eval env newAst MalFunction {fn:f, ast:MalNil} -> do args <- traverse (eval env) rawArgs liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} -> do args <- traverse (eval env) rawArgs newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/purs/src/stepA_mal.purs ================================================ module Mal.StepA where import Prelude import Control.Monad.Error.Class (try) import Control.Monad.Free.Trans (FreeT, runFreeT) import Control.Monad.Rec.Class (class MonadRec) import Core as Core import Data.Either (Either(..)) import Data.Identity (Identity(..)) import Data.List (List(..), foldM, (:)) import Data.Maybe (Maybe(..)) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import Effect.Console (error, log) import Effect.Exception as Ex import Env as Env import Printer (printStr) import Reader (readStr) import Readline (args, readLine) import Types (MalExpr(..), MalFn, RefEnv, foldrM, toHashMap, toList, toVector) -- TYPES type Eval a = FreeT Identity Effect a -- MAIN main :: Effect Unit main = do let as = args env <- Env.newEnv Nil traverse_ (setFn env) Core.ns setFn env (Tuple "eval" $ setEval env) rep_ env "(def! *host-language* \"purescript\")" rep_ env "(def! not (fn* (a) (if a false true)))" rep_ env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" rep_ env "(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)))))))" case as of Nil -> do Env.set env "*ARGV*" $ toList Nil rep_ env "(println (str \"Mal [\" *host-language* \"]\"))" loop env script:args -> do Env.set env "*ARGV*" $ toList $ MalString <$> args rep_ env $ "(load-file \"" <> script <> "\")" -- REPL rep_ :: RefEnv -> String -> Effect Unit rep_ env str = rep env str *> pure unit rep :: RefEnv -> String -> Effect String rep env str = do ast <- read str result <- runEval $ eval env ast print result loop :: RefEnv -> Effect Unit loop env = do line <- readLine "user> " case line of "" -> loop env ":q" -> pure unit _ -> do result <- try $ rep env line case result of Right exp -> log exp Left err -> error $ show err loop env setFn :: RefEnv -> Tuple String MalFn -> Effect Unit setFn env (Tuple sym f) = do newEnv <- Env.newEnv Nil Env.set env sym $ MalFunction { fn : f , ast : MalNil , env : newEnv , params : Nil , macro : false , meta : MalNil } setEval :: RefEnv -> MalFn setEval env (ast:Nil) = runEval $ eval env ast setEval _ _ = throw "illegal call of eval" -- EVAL eval :: RefEnv -> MalExpr -> Eval MalExpr eval env ast = do dbgeval <- liftEffect (Env.get env "DEBUG-EVAL") liftEffect case dbgeval of Nothing -> pure unit Just MalNil -> pure unit Just (MalBoolean false) -> pure unit _ -> do image <- print ast log ("EVAL: " <> image) case ast of MalSymbol s -> do result <- liftEffect $ Env.get env s case result of Just k -> pure k Nothing -> throw $ "'" <> s <> "'" <> " not found" MalList _ (MalSymbol "def!" : es) -> evalDef env es MalList _ (MalSymbol "let*" : es) -> evalLet env es MalList _ (MalSymbol "if" : es) -> evalIf env es MalList _ (MalSymbol "do" : es) -> evalDo env es MalList _ (MalSymbol "fn*" : es) -> evalFnMatch env es MalList _ (MalSymbol "quote" : es) -> evalQuote env es MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs MalVector _ es -> toVector <$> traverse (eval env) es MalHashMap _ es -> toHashMap <$> traverse (eval env) es _ -> pure ast -- Def evalDef :: RefEnv -> List MalExpr -> Eval MalExpr evalDef env (MalSymbol v : e : Nil) = do evd <- eval env e liftEffect $ Env.set env v evd pure evd evalDef _ _ = throw "invalid def!" -- Let evalLet :: RefEnv -> List MalExpr -> Eval MalExpr evalLet env (MalList _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet env (MalVector _ ps : e : Nil) = do letEnv <- liftEffect $ Env.newEnv env letBind letEnv ps eval letEnv e evalLet _ _ = throw "invalid let*" letBind :: RefEnv -> List MalExpr -> Eval Unit letBind _ Nil = pure unit letBind env (MalSymbol ky : e : es) = do ex <- eval env e liftEffect $ Env.set env ky ex letBind env es letBind _ _ = throw "invalid let*" -- If evalIf :: RefEnv -> List MalExpr -> Eval MalExpr evalIf env (b:t:e:Nil) = do cond <- eval env b eval env case cond of MalNil -> e MalBoolean false -> e _ -> t evalIf env (b:t:Nil) = do cond <- eval env b eval env case cond of MalNil -> MalNil MalBoolean false -> MalNil _ -> t evalIf _ _ = throw "invalid if" -- Do evalDo :: RefEnv -> List MalExpr -> Eval MalExpr evalDo env es = foldM (const $ eval env) MalNil es -- Function evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr evalFnMatch env (MalList _ params : body : Nil) = evalFn env params body evalFnMatch env (MalVector _ params : body : Nil) = evalFn env params body evalFnMatch _ _ = throw "invalid fn*" evalFn :: RefEnv -> List MalExpr -> MalExpr -> Eval MalExpr evalFn env params body = do paramsStr <- traverse unwrapSymbol params pure $ MalFunction { fn : fn paramsStr body , ast : body , env : env , params : paramsStr , macro : false , meta : MalNil } where fn :: List String -> MalExpr -> MalFn fn params' body' = \args -> do fnEnv <- Env.newEnv env ok <- Env.sets fnEnv params' args if ok then runEval $ eval fnEnv body' else throw "actual parameters do not match signature " unwrapSymbol :: MalExpr -> Eval String unwrapSymbol (MalSymbol s) = pure s unwrapSymbol _ = throw "fn* parameter must be symbols" -- Quote evalQuote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuote _ (e:Nil) = pure e evalQuote _ _ = throw "invalid quote" evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr evalQuasiquote env (e:Nil) = eval env =<< quasiquote e evalQuasiquote _ _ = throw "invalid quasiquote" quasiquote :: MalExpr -> Eval MalExpr quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote" quasiquote (MalList _ xs) = foldrM qqIter (toList Nil) xs quasiquote (MalVector _ xs) = do lst <- foldrM qqIter (toList Nil) xs pure $ toList $ MalSymbol "vec" : lst : Nil quasiquote ast@(MalHashMap _ _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast@(MalSymbol _) = pure $ toList $ MalSymbol "quote" : ast : Nil quasiquote ast = pure ast qqIter :: MalExpr -> MalExpr -> Eval MalExpr qqIter (MalList _ (MalSymbol "splice-unquote" : x : Nil)) acc = pure $ toList $ MalSymbol "concat" : x : acc : Nil qqIter (MalList _ (MalSymbol "splice-unquote" : _)) _ = throw "invalid splice-unquote" qqIter elt acc = do qqted <- quasiquote elt pure $ toList $ MalSymbol "cons" : qqted : acc : Nil -- Macro evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr evalDefmacro env (MalSymbol a : b : Nil) = do f <- eval env b case f of MalFunction fn@{macro:false} -> do let m = MalFunction $ fn {macro = true} liftEffect $ Env.set env a m pure m _ -> throw "defmacro! on non-function" evalDefmacro _ _ = throw "invalid defmacro!" -- Try evalTry :: RefEnv -> List MalExpr -> Effect MalExpr evalTry env (a:Nil) = runEval $ eval env a evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do res <- try $ runEval $ eval env thw case res of Left err -> do tryEnv <- Env.newEnv env Env.set tryEnv e $ MalString $ Ex.message err -- FIXME: runEval $ eval tryEnv b Right v -> pure v evalTry _ _ = Ex.throw "invalid try*" -- CALL FUNCTION evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr evalCallFn env rawFunc rawArgs = do func <- eval env rawFunc case func of MalFunction {fn:f, macro:true} -> do newAst <- liftEffect $ f rawArgs eval env newAst MalFunction {fn:f, ast:MalNil} -> do args <- traverse (eval env) rawArgs liftEffect $ f args MalFunction {ast:ast', params:params', env:env'} -> do args <- traverse (eval env) rawArgs newEnv <- liftEffect $ Env.newEnv env' _ <- liftEffect $ Env.sets newEnv params' args eval newEnv ast' _ -> throw "invalid function" -- READ read :: String -> Effect MalExpr read = readStr -- PRINT print :: MalExpr -> Effect String print = printStr -- Utils runEval :: ∀ m a. MonadRec m => FreeT Identity m a -> m a runEval = runFreeT $ pure <<< runIdentity runIdentity :: ∀ a. Identity a -> a runIdentity (Identity a) = a throw :: ∀ m a. MonadEffect m => String -> m a throw = liftEffect <<< Ex.throw ================================================ FILE: impls/python2/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install python2 # For dist packaging RUN apt-get -y install zip ================================================ FILE: impls/python2/Makefile ================================================ SOURCES_BASE = mal_readline.py mal_types.py reader.py printer.py SOURCES_LISP = env.py core.py stepA_mal.py SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.pyz mal SHELL := bash mal.pyz: $(SOURCES) cp stepA_mal.py __main__.py zip -q - __main__.py $+ > $@ rm __main__.py mal: mal.pyz echo '#!/usr/bin/env python' > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.pyz mal ================================================ FILE: impls/python2/core.py ================================================ import operator import time from itertools import chain import mal_types as types from mal_types import MalException, List, Vector import mal_readline import reader import printer # Errors/Exceptions def throw(obj): raise MalException(obj) # String functions def pr_str(*args): return printer.pr_list(args, " ", True) def do_str(*args): return printer.pr_list(args, "", False) def prn(*args): print(printer.pr_list(args, " ", True)) return None def println(*args): print(printer.pr_list(args, " ", False)) return None def core_readline(prompt): try: return mal_readline.readline(prompt) except EOFError: return None def slurp(path): with open(path) as f: return f.read() # Hash map functions def assoc(src_hm, *key_vals): hm = types.Hash_Map(src_hm) hm.update(types.asPairs(key_vals)) return hm def dissoc(src_hm, *keys): hm = types.Hash_Map(src_hm) for key in keys: hm.pop(key, None) return hm def get(hm, key): if hm is not None: return hm.get(key) else: return None contains_Q = types.Hash_Map.__contains__ keys = List def vals(hm): return List(hm.values()) # Sequence functions def cons(x, seq): return concat((x,), seq) def concat(*lsts): return List(chain(*lsts)) nth = tuple.__getitem__ def first(lst): if lst: return lst[0] else: # lst is nil or empty return None def rest(lst): if lst: it = iter(lst) next(it) return List(it) else: # lst is nil or empty return List() empty_Q = operator.not_ def count(lst): if types._nil_Q(lst): return 0 else: return len(lst) def apply(f, *args): return f(*chain(args[:-1], args[-1])) def mapf(f, lst): return List(map(f, lst)) def conj(lst, *args): if types._list_Q(lst): return concat(reversed(args), lst) else: return Vector(chain(lst, args)) def seq(obj): if not obj: return None # obj is nil, (), [] or "" if types._list_Q(obj): return obj elif types._vector_Q(obj) or types._string_Q(obj): return List(obj) else: throw ("seq: called on non-sequence") # Metadata functions def with_meta(obj, meta): new_obj = types._clone(obj) new_obj.__meta__ = meta return new_obj def meta(obj): return getattr(obj, "__meta__", None) # Atoms functions def deref(atm): return atm.val def reset_BANG(atm,val): atm.val = val return atm.val def swap_BANG(atm,f,*args): atm.val = f(atm.val,*args) return atm.val ns = { '=': types._equal_Q, 'throw': throw, 'nil?': types._nil_Q, 'true?': types._true_Q, 'false?': types._false_Q, 'number?': types._number_Q, 'string?': types._string_Q, 'symbol': types._symbol, 'symbol?': types._symbol_Q, 'keyword': types._keyword, 'keyword?': types._keyword_Q, 'fn?': lambda x: (types._function_Q(x) and not hasattr(x, '_ismacro_')), 'macro?': lambda x: (types._function_Q(x) and hasattr(x, '_ismacro_')), 'pr-str': pr_str, 'str': do_str, 'prn': prn, 'println': println, 'readline': core_readline, 'read-string': reader.read_str, 'slurp': slurp, '<': operator.lt, '<=': operator.le, '>': operator.gt, '>=': operator.ge, '+': operator.add, '-': operator.sub, '*': operator.mul, '/': operator.floordiv, 'time-ms': lambda : int(time.time() * 1000), 'list': types._list, 'list?': types._list_Q, 'vector': types._vector, 'vector?': types._vector_Q, 'hash-map': types._hash_map, 'map?': types._hash_map_Q, 'assoc': assoc, 'dissoc': dissoc, 'get': get, 'contains?': contains_Q, 'keys': keys, 'vals': vals, 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, 'vec': Vector, 'nth': nth, 'first': first, 'rest': rest, 'empty?': empty_Q, 'count': count, 'apply': apply, 'map': mapf, 'conj': conj, 'seq': seq, 'with-meta': with_meta, 'meta': meta, 'atom': types._atom, 'atom?': types._atom_Q, 'deref': deref, 'reset!': reset_BANG, 'swap!': swap_BANG, } ================================================ FILE: impls/python2/env.py ================================================ # Environment from mal_types import List class Env(): def __init__(self, outer=None, binds=None, exprs=None): """If binds is not None, exprs must be an iterable..""" self.data = {} self.outer = outer if binds: exprs_it = iter(exprs) for i in range(len(binds)): if binds[i] == "&": # binds may be a non-list iterable self.data[binds[i+1]] = List(exprs_it) break else: self.data[binds[i]] = next(exprs_it) def set(self, key, value): self.data[key] = value return value def get(self, key, return_nil=False): # Python prefers iteration over recursion. env = self while key not in env.data: env = env.outer if env is None: if return_nil: return None raise Exception("'" + key + "' not found") return env.data[key] ================================================ FILE: impls/python2/mal_readline.py ================================================ # Importing this module is sufficient for the 'input' builtin command # to support readline. import atexit import os.path from readline import read_history_file, set_history_length, write_history_file import sys if sys.version_info[0] < 3: _exc = Exception readline = raw_input else: _exc = FileNotFoundError readline = input histfile = os.path.join(os.path.expanduser("~"), ".mal-history") try: read_history_file(histfile) except _exc: pass set_history_length(1000) atexit.register(write_history_file, histfile) ================================================ FILE: impls/python2/mal_types.py ================================================ import copy # General functions def _equal_Q(a, b): if _sequential_Q(a): return _sequential_Q(b) \ and len(a) == len(b) \ and all(_equal_Q(a[k], b[k]) for k in range(len(a))) elif _hash_map_Q(a): return _hash_map_Q(b) \ and len(a) == len(b) \ and all(k in b and _equal_Q(v, b[k]) for k, v in a.items()) else: return type(a) == type(b) \ and a == b def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) def _clone(obj): if callable(obj): def fn(*args): return obj(*args) if hasattr(obj, '__ast__'): fn.__ast__ = obj.__ast__ fn.__gen_env__ = obj.__gen_env__ return fn return copy.copy(obj) # # Exception type # class MalException(Exception): def __init__(self, object): self.object = object # Scalars def _nil_Q(exp): return exp is None def _true_Q(exp): return exp is True def _false_Q(exp): return exp is False def _string_Q(exp): return type(exp) == str and not exp.startswith(keywordPrefix) def _number_Q(exp): return type(exp) == int # Symbols class Symbol(str): pass _symbol = Symbol def _symbol_Q(exp): return type(exp) == Symbol # Keywords # A specially prefixed string keywordPrefix = '\x7F' def _keyword(str): if str.startswith(keywordPrefix): return str else: return keywordPrefix + str def _keyword_Q(exp): return type(exp) == str and exp.startswith(keywordPrefix) # Functions # are just python functions, with # * no attributes (core functions) # * __ast__ and __gen_env__ attributes (user-defined functions) # * __ast__, __gen_env__ and _ismacro_ attributes (macro). _function_Q = callable # lists class List(tuple): pass def _list(*vals): return List(vals) def _list_Q(exp): return type(exp) == List # vectors class Vector(tuple): pass def _vector(*vals): return Vector(vals) def _vector_Q(exp): return type(exp) == Vector # Hash maps class Hash_Map(dict): pass def _hash_map(*key_vals): return Hash_Map(asPairs(key_vals)) def _hash_map_Q(exp): return type(exp) == Hash_Map def asPairs(iterable): """ k0, v0, k1, v1.. -> (k0, v0), (k1, v1).. """ it = iter(iterable) return zip(it, it) # atoms class Atom(object): def __init__(self, val): self.val = val _atom = Atom def _atom_Q(exp): return type(exp) == Atom def py_to_mal(obj): if type(obj) == list: return List(obj) if type(obj) == tuple: return List(obj) elif type(obj) == dict: return Hash_Map(obj) else: return obj ================================================ FILE: impls/python2/printer.py ================================================ from itertools import chain import mal_types as types def _escape(s): return s.replace('\\', '\\\\').replace('"', '\\"').replace('\n', '\\n') def _pr_str(obj, print_readably=True): _r = print_readably if types._list_Q(obj): return "(" + pr_list(obj, " ", _r) + ")" elif types._vector_Q(obj): return "[" + pr_list(obj, " ", _r) + "]" elif types._hash_map_Q(obj): ret = pr_list(chain.from_iterable(obj.items()), " ", _r) return "{" + ret + "}" elif types._keyword_Q(obj): return ':' + obj[1:] elif types._string_Q(obj): if _r: return '"' + _escape(obj) + '"' else: return obj elif types._nil_Q(obj): return "nil" elif types._true_Q(obj): return "true" elif types._false_Q(obj): return "false" elif types._atom_Q(obj): return "(atom " + _pr_str(obj.val,_r) + ")" else: return str(obj) def pr_list(iterable, separator, readably): return separator.join(_pr_str(exp, readably) for exp in iterable) ================================================ FILE: impls/python2/reader.py ================================================ import re from mal_types import (_symbol, _keyword, _list, List, Vector, Hash_Map, asPairs) class Blank(Exception): pass class Reader(): def __init__(self, tokens, position=0): self.tokens = tokens self.position = position def next(self): self.position += 1 return self.tokens[self.position-1] def peek(self): if len(self.tokens) > self.position: return self.tokens[self.position] else: return None def tokenize(str): tre = re.compile(r"""[\s,]*(~@|[\[\]{}()'`~^@]|"(?:[\\].|[^\\"])*"?|;.*|[^\s\[\]{}()'"`@,;]+)"""); return [t for t in re.findall(tre, str) if t[0] != ';'] def _unescape(s): return s.replace('\\\\', '\b').replace('\\"', '"').replace('\\n', '\n').replace('\b', '\\') def read_atom(reader): int_re = re.compile(r"-?[0-9]+$") float_re = re.compile(r"-?[0-9][0-9.]*$") string_re = re.compile(r'"(?:[\\].|[^\\"])*"') token = reader.next() if re.match(int_re, token): return int(token) elif re.match(float_re, token): return int(token) elif re.match(string_re, token):return _unescape(token[1:-1]) elif token[0] == '"': raise Exception("expected '\"', got EOF") elif token[0] == ':': return _keyword(token[1:]) elif token == "nil": return None elif token == "true": return True elif token == "false": return False else: return _symbol(token) def read_sequence(reader, start='(', end=')'): token = reader.next() if token != start: raise Exception("expected '" + start + "'") token = reader.peek() while token != end: if not token: raise Exception("expected '" + end + "', got EOF") yield read_form(reader) token = reader.peek() reader.next() def read_hash_map(reader): lst = read_sequence(reader, '{', '}') return Hash_Map(asPairs(lst)) def read_list(reader): return List(read_sequence(reader, '(', ')')) def read_vector(reader): return Vector(read_sequence(reader, '[', ']')) def read_form(reader): token = reader.peek() # reader macros/transforms if token[0] == ';': reader.next() return None elif token == '\'': reader.next() return _list(_symbol('quote'), read_form(reader)) elif token == '`': reader.next() return _list(_symbol('quasiquote'), read_form(reader)) elif token == '~': reader.next() return _list(_symbol('unquote'), read_form(reader)) elif token == '~@': reader.next() return _list(_symbol('splice-unquote'), read_form(reader)) elif token == '^': reader.next() meta = read_form(reader) return _list(_symbol('with-meta'), read_form(reader), meta) elif token == '@': reader.next() return _list(_symbol('deref'), read_form(reader)) # list elif token == ')': raise Exception("unexpected ')'") elif token == '(': return read_list(reader) # vector elif token == ']': raise Exception("unexpected ']'"); elif token == '[': return read_vector(reader); # hash-map elif token == '}': raise Exception("unexpected '}'"); elif token == '{': return read_hash_map(reader); # atom else: return read_atom(reader); def read_str(str): tokens = tokenize(str) if len(tokens) == 0: raise Blank("Blank Line") return read_form(Reader(tokens)) ================================================ FILE: impls/python2/run ================================================ #!/bin/sh exec python2 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" ================================================ FILE: impls/python2/step0_repl.py ================================================ import sys, traceback import mal_readline # read def READ(str): return str # eval def EVAL(ast): return ast # print def PRINT(exp): return exp # repl def REP(str): return PRINT(EVAL(READ(str))) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) ================================================ FILE: impls/python2/step1_read_print.py ================================================ import sys, traceback import mal_readline import reader, printer # read READ = reader.read_str # eval def EVAL(ast): return ast # print PRINT = printer._pr_str # repl def REP(str): return PRINT(EVAL(READ(str))) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) ================================================ FILE: impls/python2/step2_eval.py ================================================ import sys, traceback import mal_readline import mal_types as types import reader, printer # read READ = reader.read_str # eval def EVAL(ast, env): # print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): try: return env[ast] except: raise Exception("'" + ast + "' not found") elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast f = EVAL(ast[0], env) args = ast[1:] return f(*(EVAL(a, env) for a in args)) # print PRINT = printer._pr_str # repl repl_env = {} def REP(str): return PRINT(EVAL(READ(str), repl_env)) repl_env['+'] = lambda a,b: a+b repl_env['-'] = lambda a,b: a-b repl_env['*'] = lambda a,b: a*b repl_env['/'] = lambda a,b: a//b # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) ================================================ FILE: impls/python2/step3_env.py ================================================ import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env # read READ = reader.read_str # eval def EVAL(ast, env): dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) return EVAL(a2, let_env) f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) repl_env.set(types._symbol('+'), lambda a,b: a+b) repl_env.set(types._symbol('-'), lambda a,b: a-b) repl_env.set(types._symbol('*'), lambda a,b: a*b) repl_env.set(types._symbol('/'), lambda a,b: a//b) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) ================================================ FILE: impls/python2/step4_if_fn_do.py ================================================ import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def EVAL(ast, env): dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) return EVAL(a2, let_env) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) return EVAL(ast[-1], env) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: return EVAL(ast[3], env) else: return None else: return EVAL(a2, env) elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) ================================================ FILE: impls/python2/step5_tco.py ================================================ import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/step6_file.py ================================================ import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/step7_quote.py ================================================ import functools import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def qq_loop(acc, elt): if types._list_Q(elt) \ and len(elt) == 2 \ and types._symbol_Q(elt[0]) \ and elt[0] == 'splice-unquote': return types._list(types._symbol('concat'), elt[1], acc) else: return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): if len(ast) == 2 \ and types._symbol_Q(ast[0]) \ and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): return types._list(types._symbol('quote'), ast) elif types._vector_Q(ast): return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: ast = quasiquote(ast[1]) continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/step8_macros.py ================================================ import functools import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def qq_loop(acc, elt): if types._list_Q(elt) \ and len(elt) == 2 \ and types._symbol_Q(elt[0]) \ and elt[0] == 'splice-unquote': return types._list(types._symbol('concat'), elt[1], acc) else: return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): if len(ast) == 2 \ and types._symbol_Q(ast[0]) \ and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): return types._list(types._symbol('quote'), ast) elif types._vector_Q(ast): return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: ast = quasiquote(ast[1]) continue # TCO elif 'defmacro!' == a0: func = EVAL(ast[2], env) func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/step9_try.py ================================================ import functools import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def qq_loop(acc, elt): if types._list_Q(elt) \ and len(elt) == 2 \ and types._symbol_Q(elt[0]) \ and elt[0] == 'splice-unquote': return types._list(types._symbol('concat'), elt[1], acc) else: return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): if len(ast) == 2 \ and types._symbol_Q(ast[0]) \ and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): return types._list(types._symbol('quote'), ast) elif types._vector_Q(ast): return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: ast = quasiquote(ast[1]) continue # TCO elif 'defmacro!' == a0: func = EVAL(ast[2], env) func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) elif "try*" == a0: if len(ast) < 3: ast = ast[1] continue # TCO else: a1, a2 = ast[1], ast[2] err = None try: return EVAL(a1, env) except types.MalException as exc: err = exc.object except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) ast = a2[2] env = catch_env continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/stepA_mal.py ================================================ import functools import sys, traceback import mal_readline import mal_types as types import reader, printer from env import Env import core # read READ = reader.read_str # eval def qq_loop(acc, elt): if types._list_Q(elt) \ and len(elt) == 2 \ and types._symbol_Q(elt[0]) \ and elt[0] == 'splice-unquote': return types._list(types._symbol('concat'), elt[1], acc) else: return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): if len(ast) == 2 \ and types._symbol_Q(ast[0]) \ and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): return types._list(types._symbol('quote'), ast) elif types._vector_Q(ast): return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) for k, v in types.asPairs(a1): let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: ast = quasiquote(ast[1]) continue # TCO elif 'defmacro!' == a0: func = EVAL(ast[2], env) func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) elif "py!*" == a0: exec(compile(ast[1], '', 'single'), globals()) return None elif "py*" == a0: return types.py_to_mal(eval(ast[1])) elif "." == a0: el = (EVAL(ast[i], env) for i in range(2, len(ast))) f = eval(ast[1]) return f(*el) elif "try*" == a0: if len(ast) < 3: ast = ast[1] continue # TCO else: a1, a2 = ast[1], ast[2] err = None try: return EVAL(a1, env) except types.MalException as exc: err = exc.object except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) ast = a2[2] env = catch_env continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: if len(ast) > 3: ast = ast[3] continue # TCO else: return None else: ast = a2 continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] def fn(*args): return EVAL(a2, Env(env, a1, args)) fn.__ast__ = a2 fn.__gen_env__ = lambda args: Env(env, a1, args) return fn f = EVAL(a0, env) if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ env = f.__gen_env__(EVAL(a, env) for a in args) continue # TCO else: return f(*(EVAL(a, env) for a in args)) else: raise Exception('Can only apply functions') # print PRINT = printer._pr_str # repl repl_env = Env() def REP(str): return PRINT(EVAL(READ(str), repl_env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP('(def! *host-language* "python2")') REP("(def! not (fn* (a) (if a false true)))") REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') REP("""(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop REP('(println (str "Mal [" *host-language* "]"))') while True: try: line = mal_readline.readline("user> ") print(REP(line)) except EOFError: print() break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) except Exception: # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) ================================================ FILE: impls/python2/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/python2/tests/stepA_mal.mal ================================================ ;; Testing Python interop ;; Testing Python expressions (py* "7") ;=>7 (py* "'7'") ;=>"7" (py* "[7,8,9]") ;=>(7 8 9) (py* "' '.join(['X'+c+'Y' for c in ['a','b','c']])") ;=>"XaY XbY XcY" (py* "[1 + x for x in [1,2,3]]") ;=>(2 3 4) ;; Testing Python statements (py!* "print('hello')") ;/hello ;=>nil (py!* "foo = 19 % 4") ;=>nil (py* "foo") ;=>3 ================================================ FILE: impls/python3/.gitignore ================================================ .vscode/ .mypy_cache/ .idea/ ================================================ FILE: impls/python3/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # For checking: # RUN apt-get -y install flake8 mypy pylint ================================================ FILE: impls/python3/Makefile ================================================ # make check sources=reader.py may be convenient sources ?= *.py f8 += D100 # Missing docstring in public module f8 += D101 # Missing docstring in public class f8 += D102 # Missing docstring in public method f8 += D103 # Missing docstring in public function f8 += D105 # Missing docstring in magic method f8 += D107 # Missing docstring in __init__ f8 += I100 # order of import statements (incompatible with pylint) f8 += W503 # line break before binary operator (incompatible with 504) pl += missing-module-docstring pl += missing-class-docstring pl += missing-function-docstring pl += R0801 # Similar lines in 2 files (steps...) all: check: pylint --disable=$(shell echo $(pl) | sed 's/ /,/g') $(sources) mypy $(sources) flake8 --ignore=$(shell echo $(f8) | sed 's/ /,/g') $(sources) clean: rm -f *~ rm -fr __pycache__/ .mypy_cache/ ================================================ FILE: impls/python3/core.py ================================================ import collections.abc import dataclasses import itertools import time import operator import typing from collections.abc import Callable, Sequence import mal_readline from mal_types import (Atom, Boolean, Error, Fn, Form, Keyword, List, Macro, Map, Nil, Number, PythonCall, String, Symbol, ThrownException, Vector, pr_seq) import reader ns: dict[str, Form] = {} def built_in(name: str) -> Callable[[PythonCall], None]: """Register in ns and add context to Errors.""" def decorate(old_f: PythonCall) -> None: def new_f(args: Sequence[Form]) -> Form: try: return old_f(args) except Error as exc: if hasattr(exc, "add_note"): exc.add_note('The ' + name + ' core function received [' + pr_seq(args) + ' ] as arguments.') raise ns[name] = Fn(new_f) return decorate def equality(value: Form) -> PythonCall: def new_f(args: Sequence[Form]) -> Form: match args: case [form]: return Boolean(form == value) case _: raise Error('bad arguments') return new_f built_in('nil?')(equality(Nil.NIL)) built_in('false?')(equality(Boolean.FALSE)) built_in('true?')(equality(Boolean.TRUE)) def membership(*classes: type) -> PythonCall: def new_f(args: Sequence[Form]) -> Form: match args: case [form]: return Boolean(isinstance(form, classes)) case _: raise Error('bad arguments') return new_f built_in('number?')(membership(Number)) built_in('symbol?')(membership(Symbol)) built_in('keyword?')(membership(Keyword)) built_in('string?')(membership(String)) built_in('list?')(membership(List)) built_in('map?')(membership(Map)) built_in('atom?')(membership(Atom)) built_in('vector?')(membership(Vector)) built_in('macro?')(membership(Macro)) built_in('sequential?')(membership(List, Vector)) built_in('fn?')(membership(Fn)) def arithmetic(old_f: Callable[[int, int], int]) -> PythonCall: def new_f(args: Sequence[Form]) -> Form: match args: case [Number() as left, Number() as right]: return Number(old_f(left, right)) case _: raise Error('bad arguments') return new_f built_in('+')(arithmetic(operator.add)) built_in('-')(arithmetic(operator.sub)) built_in('*')(arithmetic(operator.mul)) built_in('/')(arithmetic(operator.floordiv)) def comparison(old_f: Callable[[int, int], bool]) -> PythonCall: def new_f(args: Sequence[Form]) -> Form: match args: case [Number() as left, Number() as right]: return Boolean(old_f(left, right)) case _: raise Error('bad arguments') return new_f built_in('<')(comparison(operator.lt)) built_in('<=')(comparison(operator.le)) built_in('>')(comparison(operator.gt)) built_in('>=')(comparison(operator.ge)) @built_in('=') def _(args: Sequence[Form]) -> Form: match args: case [left, right]: return Boolean(left == right) case _: raise Error('bad arguments') built_in('list')(List) built_in('vector')(Vector) @built_in('prn') def _(args: Sequence[Form]) -> Form: print(pr_seq(args)) return Nil.NIL @built_in('pr-str') def _(args: Sequence[Form]) -> Form: return String(pr_seq(args)) @built_in('println') def _(args: Sequence[Form]) -> Form: print(pr_seq(args, readably=False)) return Nil.NIL @built_in('empty?') def _(args: Sequence[Form]) -> Form: match args: case [List() | Vector() as seq]: return Boolean(not seq) case _: raise Error('bad arguments') @built_in('count') def _(args: Sequence[Form]) -> Form: match args: case [List() | Vector() as seq]: return Number(len(seq)) case [Nil()]: return Number(0) case _: raise Error('bad arguments') @built_in('read-string') def _(args: Sequence[Form]) -> Form: match args: case [String(line)]: return reader.read(line) case _: raise Error('bad arguments') @built_in('slurp') def _(args: Sequence[Form]) -> Form: match args: case [String(file_name)]: with open(file_name, 'r', encoding='utf-8') as the_file: return String(the_file.read()) case _: raise Error('bad arguments') @built_in('str') def _(args: Sequence[Form]) -> Form: return String(pr_seq(args, readably=False, sep='')) @built_in('atom') def _(args: Sequence[Form]) -> Form: match args: case [form]: return Atom(form) case _: raise Error('bad arguments') @built_in('deref') def _(args: Sequence[Form]) -> Form: match args: case [Atom(val)]: return val case _: raise Error('bad arguments') @built_in('reset!') def _(args: Sequence[Form]) -> Form: match args: case [Atom() as atm, form]: atm.val = form return form case _: raise Error('bad arguments') @built_in('vec') def _(args: Sequence[Form]) -> Form: match args: case [List() as seq]: return Vector(seq) case [Vector() as seq]: return seq case _: raise Error('bad arguments') @built_in('cons') def _(args: Sequence[Form]) -> Form: match args: case [head, List() | Vector() as tail]: return List((head, *tail)) case _: raise Error('bad arguments') def cast_sequence(arg: Form) -> List | Vector: match arg: case List() | Vector(): return arg case _: raise Error(f'{arg} is not a sequence') @built_in('concat') def _(args: Sequence[Form]) -> Form: return List(itertools.chain.from_iterable(cast_sequence(x) for x in args)) @built_in('nth') def _(args: Sequence[Form]) -> Form: match args: case [List() | Vector() as seq, Number() as idx]: # Python would accept index = -1. if 0 <= idx < len(seq): return seq[idx] raise Error(f'index {idx} not in range of {seq}') case _: raise Error('bad arguments') @built_in('apply') def _(args: Sequence[Form]) -> Form: match args: case [Fn(call) | Macro(call), *some, List() | Vector() as more]: return call((*some, *more)) case _: raise Error('bad arguments') @built_in('map') def _(args: Sequence[Form]) -> Form: match args: case [Fn(call), List() | Vector() as seq]: return List(call((x, )) for x in seq) case _: raise Error('bad arguments') @built_in('throw') def _(args: Sequence[Form]) -> Form: match args: case [form]: raise ThrownException(form) case _: raise Error('bad arguments') @built_in('keyword') def _(args: Sequence[Form]) -> Form: match args: case [String(string)]: return Keyword(string) case [Keyword() as keyword]: return keyword case _: raise Error('bad arguments') @built_in('symbol') def _(args: Sequence[Form]) -> Form: match args: case [String(string)]: return Symbol(string) case [Symbol() as symbol]: return symbol case _: raise Error('bad arguments') @built_in('readline') def _(args: Sequence[Form]) -> Form: match args: case [String(prompt)]: try: return String(mal_readline.input_(prompt)) except EOFError: return Nil.NIL case _: raise Error('bad arguments') @built_in('time-ms') def _(args: Sequence[Form]) -> Form: if args: raise Error('bad arguments') return Number(time.time() * 1000.0) @built_in('meta') def _(args: Sequence[Form]) -> Form: match args: case [Fn() | List() | Vector() | Map() as form]: return form.meta case _: raise Error('bad arguments') @built_in('with-meta') def _(args: Sequence[Form]) -> Form: # container = type(container)(container, meta=meta) confuses mypy. match args: case [List() as container, meta]: return List(container, meta=meta) case [Vector() as container, meta]: return Vector(container, meta=meta) case [Map() as container, meta]: return Map(container, meta) case [Fn() as container, meta]: return dataclasses.replace(container, meta=meta) case _: raise Error('bad arguments') @built_in('seq') def _(args: Sequence[Form]) -> Form: match args: case [List() as seq]: return seq if seq else Nil.NIL case [Vector() as seq]: return List(seq) if seq else Nil.NIL case [String(string)]: return List(String(c) for c in string) if string else Nil.NIL case [Nil()]: return Nil.NIL case _: raise Error('bad arguments') @built_in('conj') def conj(args: Sequence[Form]) -> Form: match args: case [Vector() as seq, *forms]: return Vector((*seq, *forms)) case [List() as seq, *forms]: return List((*reversed(forms), *seq)) case _: raise Error('bad arguments') @built_in('get') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping, Keyword() | String() as key]: return mapping.get(key, Nil.NIL) case [Nil(), Keyword() | String()]: return Nil.NIL case _: raise Error('bad arguments') @built_in('first') def _(args: Sequence[Form]) -> Form: match args: case [List() | Vector() as seq]: return seq[0] if seq else Nil.NIL case [Nil()]: return Nil.NIL case _: raise Error('bad arguments') @built_in('rest') def _(args: Sequence[Form]) -> Form: match args: case [List() | Vector() as seq]: return List(seq[1:]) case [Nil()]: return List() case _: raise Error('bad arguments') @built_in('hash-map') def _(args: Sequence[Form]) -> Form: return Map(Map.cast_items(args)) @built_in('assoc') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping, *binds]: return Map(itertools.chain(mapping.items(), Map.cast_items(binds))) case _: raise Error('bad arguments') @built_in('contains?') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping, Keyword() | String() as key]: return Boolean(key in mapping) case _: raise Error('bad arguments') @built_in('keys') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping]: return List(mapping.keys()) case _: raise Error('bad arguments') @built_in('vals') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping]: return List(mapping.values()) case _: raise Error('bad arguments') @built_in('dissoc') def _(args: Sequence[Form]) -> Form: match args: case [Map() as mapping, *keys]: result = Map(mapping) for key in keys: if not isinstance(key, (Keyword, String)): raise Error(f'{key} is not a valid map key') if key in result: del result[key] return result case _: raise Error('bad arguments') @built_in('swap!') def _(args: Sequence[Form]) -> Form: match args: case [Atom(old) as atm, Fn(call), *more]: new = call((old, *more)) atm.val = new return new case _: raise Error('bad arguments') @built_in('py!*') def _(args: Sequence[Form]) -> Form: match args: case [String(python_statement)]: # pylint: disable-next=exec-used exec(compile(python_statement, '', 'single'), globals()) return Nil.NIL case _: raise Error('bad arguments') def py2mal(obj: typing.Any) -> Form: match obj: case None: return Nil.NIL case bool(): return Boolean(obj) case int(): return Number(obj) case str(): return String(obj) case Sequence(): return List(py2mal(x) for x in obj) case collections.abc.Mapping(): result = Map() for py_key, py_val in obj.items(): key = py2mal(py_key) if not isinstance(key, (Keyword, String)): raise Error(f'{key} is not a valid map key') result[key] = py2mal(py_val) return Map() case _: raise Error(f'failed to translate {obj}') @built_in('py*') def _(args: Sequence[Form]) -> Form: match args: case [String(python_expression)]: # pylint: disable-next=eval-used return py2mal(eval(python_expression)) case _: raise Error('bad arguments') ================================================ FILE: impls/python3/env.py ================================================ # Env is defined in mal_types.py in order to avoid a circular dependency. from collections.abc import Sequence from mal_types import Env, Error, Form, List, pr_seq def call_env(env: Env, parms: Sequence[str], args: Sequence[Form]) -> Env: match parms: case [*required, '&', rest]: if len(args) < len(required): raise Error('not enough arguments for fn*[' + ' '.join(parms) + ']: ' + pr_seq(args)) fn_env = env.new_child(dict(zip(required, args))) fn_env[rest] = List(args[len(required):]) return fn_env case _: if len(args) != len(parms): raise Error('bad argument count for fn*[' + ' '.join(parms) + ']: ' + pr_seq(args)) return env.new_child(dict(zip(parms, args))) ================================================ FILE: impls/python3/mal_readline.py ================================================ # Importing this module is sufficient for the 'input' builtin command # to support readline. import atexit import os.path import readline histfile = os.path.join(os.path.expanduser('~'), '.mal-history') try: readline.read_history_file(histfile) except FileNotFoundError: pass readline.set_history_length(1000) atexit.register(readline.write_history_file, histfile) def input_(prompt: str) -> str: line = input(prompt) if line: readline.add_history(line) return line ================================================ FILE: impls/python3/mal_types.py ================================================ # Named mal_types because 'types' is already a standard python module. import collections import dataclasses import enum import itertools import re import typing from collections.abc import Callable, Iterable, Iterator, Mapping, Sequence # The selected representations ensure that the Python == equality # matches the MAL = equality. # pr_str is implemented here without printer.py because # __str__ is idiomatic and gives formatted error messages soon # (that is, without circular dependencies or evil tricks). # So there are three ways to format a MAL object. # str(form) # the default, used by pr_seq or format strings like f'{form}' # implemented by form.__str__(readably=True) # form.__str__(readably=False) # used by some core functions via pr_seq # implemented by form.__str__(readably=False) # repr(form) # the python representation for debugging class Nil(enum.Enum): NIL = None def __str__(self, readably: bool = True) -> str: return 'nil' class Boolean(enum.Enum): FALSE = False TRUE = True def __str__(self, readably: bool = True) -> str: return 'true' if self is self.TRUE else 'false' class Number(int): def __str__(self, readably: bool = True) -> str: return super().__str__() class Symbol(str): def __str__(self, readably: bool = True) -> str: # pylint: disable=invalid-str-returned return self # The two other string types are wrapped in dataclasses in order to # avoid problems with == (symbols) and pattern matching (list and # vectors). @dataclasses.dataclass(frozen=True, slots=True) class String: val: str @staticmethod def _repl(match: re.Match[str]) -> str: char = match.group() return '\\' + ('n' if char == '\n' else char) def __str__(self, readably: bool = True) -> str: return '"' + re.sub(r'[\\"\n]', String._repl, self.val) + '"' \ if readably else self.val @dataclasses.dataclass(frozen=True, slots=True) class Keyword: val: str def __str__(self, readably: bool = True) -> str: return ':' + self.val class List(tuple['Form', ...]): # Avoid a name clash with typing.List. This improves mypy output. def __init__(self, _: Iterable['Form'] = (), meta: 'Form' = Nil.NIL) -> None: """Add a meta field, tuple.__new__ does the rest.""" self.meta = meta def __str__(self, readably: bool = True) -> str: return '(' + pr_seq(self, readably) + ')' class Vector(tuple['Form', ...]): def __init__(self, _: Iterable['Form'] = (), meta: 'Form' = Nil.NIL) -> None: """Add a meta field, tuple.__new__ does the rest.""" self.meta = meta def __str__(self, readably: bool = True) -> str: return '[' + pr_seq(self, readably) + ']' class Map(dict[Keyword | String, 'Form']): def __init__(self, arg: Iterable[tuple[Keyword | String, 'Form']] | Mapping[Keyword | String, 'Form'] = (), meta: 'Form' = Nil.NIL, ) -> None: dict.__init__(self, arg) self.meta = meta def __str__(self, readably: bool = True) -> str: return '{' + pr_seq(itertools.chain.from_iterable(self.items()), readably) + '}' @staticmethod def cast_items(args: Iterable['Form'] ) -> Iterator[tuple[Keyword | String, 'Form']]: key: Keyword | String | None = None for form in args: if key: yield key, form key = None elif isinstance(form, (Keyword, String)): key = form else: raise Error(f'{key} is not a valid map key') if key: raise Error(f'odd count in map binds, no value for {form}') Env = collections.ChainMap[str, 'Form'] PythonCall = Callable[[Sequence['Form']], 'Form'] class TCOEnv(typing.NamedTuple): body: 'Form' fenv: Callable[[Sequence['Form']], Env] @dataclasses.dataclass(frozen=True, slots=True) class Fn: call: PythonCall tco_env: TCOEnv | None = None meta: 'Form' = Nil.NIL def __str__(self, readably: bool = True) -> str: return '#' @dataclasses.dataclass(frozen=True, slots=True) class Macro: call: PythonCall def __str__(self, readably: bool = True) -> str: return '#' @dataclasses.dataclass(slots=True) class Atom: val: 'Form' def __str__(self, readably: bool = True) -> str: return f'(atom {self.val})' Form = (Atom | Boolean | Fn | Keyword | Macro | List | Map | Nil | Number | String | Symbol | Vector) class Error(Exception): """Local exceptions, as recommended by pylint.""" @dataclasses.dataclass(frozen=True, slots=True) class ThrownException(Exception): form: Form def pr_seq(args: Iterable[Form], readably: bool = True, sep: str = ' ') -> str: # This would be OK if the signature was usual. # pylint: disable-next=unnecessary-dunder-call return sep.join(x.__str__(readably) for x in args) ================================================ FILE: impls/python3/reader.py ================================================ import re from collections.abc import Callable, Iterator, Mapping from re import Match from mal_types import (Boolean, Error, Form, Keyword, List, Map, Nil, Number, String, Symbol, Vector) # The `token` decorator adds regular expression groups all along this file. # The name of a group is the name of the decorated funtion, allowing # `read_form` to call it when it founds the token. # The global regular expression is compiled once when the module is loaded. token_groups: list[str] = [] class Lexer: # Consume unnamed groups, but do not report them. # Report None at the end of the input. def __init__(self, source: str) -> None: self._tokens = (t for t in pattern.finditer(source) if t.lastgroup) self._peek: Match[str] | None = None self.consume() def consume(self) -> None: try: self._peek = next(self._tokens) except StopIteration: self._peek = None def peek(self) -> re.Match[str] | None: return self._peek def token(regex: str): """Bind a regular expression to a function in this module. Form constuctor. The lexer does not report tokens with None as constructor. """ def decorator(fun: Callable[[Lexer, Match[str]], Form] | None): if fun: group = f'(?P<{fun.__name__}>{regex})' else: group = f'(?:{regex})' token_groups.append(group) return fun return decorator def context(match: Match[str]) -> str: """Format some information for error reporting.""" start_idx = match.start() - 10 if 0 < start_idx: start = '...' + match.string[start_idx:match.start()] else: start = match.string[:match.start()] end_idx = match.end() + 20 if end_idx < len(match.string): end = match.string[match.end():end_idx] + '...' else: end = match.string[match.end():] return f': {start}{match.group()}{end}' token(r'(?:[\s,]|;[^\n\r]*)+')(None) def unescape(match: Match[str]) -> str: """Map a backslash sequence to a character for strings.""" char = match.string[match.end() - 1] return '\n' if char == 'n' else char @token(r'"(?:(?:[^"\\]|\\.)*")?') def string(_: Lexer, tok: Match[str]) -> Form: start, end = tok.span() if end - start == 1: raise Error('read: unbalanced string delimiter' + context(tok)) return String(re.sub(r'\\.', unescape, tok.string[start + 1:end - 1])) def read_list(lexer: Lexer, closing: str, pos: Match[str]) -> Iterator[Form]: while not ((tok := lexer.peek()) and tok.group() == closing): yield read_form(lexer, pos) lexer.consume() @token(r'\(') def list_start(lexer: Lexer, tok: Match[str]) -> Form: return List(read_list(lexer, ')', tok)) @token(r'\[') def vector_start(lexer: Lexer, tok: Match[str]) -> Form: return Vector(read_list(lexer, ']', tok)) @token(r'\{') def map_start(lexer: Lexer, tok: Match[str]) -> Form: return Map(Map.cast_items(read_list(lexer, '}', tok))) single_macros = { "'": 'quote', '`': 'quasiquote', '@': 'deref', '~': 'unquote', '~@': 'splice-unquote', } @token("['`@]|~@?") def macro(lexer: Lexer, tok: Match[str]) -> Form: return List((Symbol(single_macros[tok.group()]), read_form(lexer, tok))) @token(r'\^') def with_meta(lexer: Lexer, tok: Match[str]) -> Form: tmp = read_form(lexer, tok) return List((Symbol('with-meta'), read_form(lexer, tok), tmp)) @token('[])}]') def list_end(_: Lexer, tok: Match[str]) -> Form: raise Error('read: unbalanced list/vector/map terminator' + context(tok)) @token(r'-?\d+') def number(_: Lexer, tok: Match[str]) -> Form: return Number(tok.group()) almost_symbols: Mapping[str, Form] = { 'nil': Nil.NIL, 'false': Boolean.FALSE, 'true': Boolean.TRUE, } @token(r"""[^]\s"'(),;@[^`{}~]+""") def symbol(_: Lexer, tok: Match[str]) -> Form: start, end = tok.span() if tok.string[start] == ':': return Keyword(tok.string[start + 1:end]) value = tok.group() return almost_symbols.get(value) or Symbol(value) @token('.') def should_never_match(lexer: Lexer, tok: Match[str]) -> Form: assert False, f'{lexer} {tok}' def read_form(lexer: Lexer, pos: Match[str] | None) -> Form: """Parse a form from `lexer`, reporting errors as if started from `pos`.""" if (tok := lexer.peek()): lexer.consume() assert tok.lastgroup, f'{lexer} {tok}' assert tok.lastgroup in globals(), f'{lexer} {tok}' return globals()[tok.lastgroup](lexer, tok) if pos: raise Error('read: unbalanced form, started' + context(pos)) raise Error('read: the whole input was empty') def read(source: str) -> Form: lexer = Lexer(source) result = read_form(lexer, None) if tok := lexer.peek(): raise Error('read: trailing items after the form' + context(tok)) return result pattern = re.compile('|'.join(token_groups)) ================================================ FILE: impls/python3/run ================================================ #!/bin/sh exec python3 $(dirname $0)/${STEP:-stepA_mal}.py "${@}" ================================================ FILE: impls/python3/step0_repl.py ================================================ import mal_readline def read(source: str) -> str: return source def eval_(ast: str) -> str: return ast def print_(form: str) -> str: return form def rep(source: str) -> str: return print_(eval_(read(source))) def main() -> None: while True: try: print(rep(mal_readline.input_('user> '))) except EOFError: break if __name__ == '__main__': main() ================================================ FILE: impls/python3/step1_read_print.py ================================================ import traceback import mal_readline from mal_types import Form import reader def eval_(ast: Form) -> Form: # print(repr(ast)) # the result of read, as python return ast def rep(source: str) -> str: return str(eval_(reader.read(source))) def main() -> None: while True: try: print(rep(mal_readline.input_('user> '))) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step2_eval.py ================================================ import traceback from collections.abc import Mapping, Sequence import mal_readline from mal_types import (Error, Fn, Form, List, Map, Number, Symbol, Vector, pr_seq) import reader Env = Mapping[str, Fn] def eval_(ast: Form, env: Env) -> Form: # print(f'EVAL: {ast}', repr(ast) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): match eval_(first, env): case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def add(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left + right) case _: raise Error('+: bad arguments' + pr_seq(args)) def sub(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left - right) case _: raise Error('-: bad arguments' + pr_seq(args)) def mul(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left * right) case _: raise Error('*: bad arguments' + pr_seq(args)) def floordiv(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left // right) case _: raise Error('/: bad arguments' + pr_seq(args)) def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env: Env = { '+': Fn(add), '-': Fn(sub), '*': Fn(mul), '/': Fn(floordiv), } while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step3_env.py ================================================ import traceback from collections.abc import Sequence import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Map, Nil, Number, Symbol, Vector, pr_seq) import reader def eval_def(args: Sequence[Form], env: Env) -> Form: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> Form: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return eval_(form, let_env) case _: raise Error('let*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, } def eval_(ast: Form, env: Env) -> Form: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): return spec(args, env) match eval_(first, env): case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def add(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left + right) case _: raise Error('+: bad arguments' + pr_seq(args)) def sub(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left - right) case _: raise Error('-: bad arguments' + pr_seq(args)) def mul(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left * right) case _: raise Error('*: bad arguments' + pr_seq(args)) def floordiv(args: Sequence[Form]) -> Form: match args: case [Number(left), Number(right)]: return Number(left // right) case _: raise Error('/: bad arguments' + pr_seq(args)) def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env({ '+': Fn(add), '-': Fn(sub), '*': Fn(mul), '/': Fn(floordiv), }) while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step4_if_fn_do.py ================================================ import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Map, Nil, Symbol, Vector, pr_seq) import reader def eval_def(args: Sequence[Form], env: Env) -> Form: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> Form: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return eval_(form, let_env) case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> Form: match args: case [*forms, last]: for form in forms: eval_(form, env) return eval_(last, env) case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> Form: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return eval_(args[2], env) return Nil.NIL return eval_(args[1], env) raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> Form: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def call(f_args: Sequence[Form]) -> Form: return eval_(body, call_env(env, parms, f_args)) return Fn(call) case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, } def eval_(ast: Form, env: Env) -> Form: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): return spec(args, env) match eval_(first, env): case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. rep('(def! not (fn* (a) (if a false true)))', repl_env) while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step5_tco.py ================================================ import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Map, Nil, Symbol, TCOEnv, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. rep('(def! not (fn* (a) (if a false true)))', repl_env) while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step6_file.py ================================================ import sys import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Map, Nil, String, Symbol, TCOEnv, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. @core.built_in('eval') def _(args: Sequence[Form]) -> Form: match args: case [form]: return eval_(form, repl_env) case _: raise Error('bad arguments') rep('(def! not (fn* (a) (if a false true)))', repl_env) rep("""(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) match sys.argv: case _, file_name, *args: repl_env['*ARGV*'] = List(String(a) for a in args) rep(f'(load-file "{file_name}")', repl_env) case _: repl_env['*ARGV*'] = List() while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step7_quote.py ================================================ import functools import sys import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Map, Nil, String, Symbol, TCOEnv, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: match args: case [form]: return form, None case _: raise Error('quote: bad arguments: ' + pr_seq(args)) def qq_loop(acc: List, elt: Form) -> List: match elt: case List([Symbol('splice-unquote'), form]): return List((Symbol('concat'), form, acc)) case List([Symbol('splice-unquote'), *args]): raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) case _: return List((Symbol('cons'), quasiquote(elt), acc)) def qq_foldr(forms: Sequence[Form]) -> List: return functools.reduce(qq_loop, reversed(forms), List()) def quasiquote(ast: Form) -> Form: match ast: case Map() | Symbol(): return List((Symbol('quote'), ast)) case Vector(): return List((Symbol('vec'), qq_foldr(ast))) case List([Symbol('unquote'), form]): return form case List([Symbol('unquote'), *args]): raise Error('unquote: bad arguments: ' + pr_seq(args)) case List(): return qq_foldr(ast) case _: return ast def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [form]: return quasiquote(form), env case _: raise Error('quasiquote: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, 'quote': eval_quote, 'quasiquote': eval_quasiquote, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. @core.built_in('eval') def _(args: Sequence[Form]) -> Form: match args: case [form]: return eval_(form, repl_env) case _: raise Error('bad arguments') rep('(def! not (fn* (a) (if a false true)))', repl_env) rep("""(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) match sys.argv: case _, file_name, *args: repl_env['*ARGV*'] = List(String(a) for a in args) rep(f'(load-file "{file_name}")', repl_env) case _: repl_env['*ARGV*'] = List() while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step8_macros.py ================================================ import functools import sys import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, Map, Nil, String, Symbol, TCOEnv, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: match args: case [form]: return form, None case _: raise Error('quote: bad arguments: ' + pr_seq(args)) def qq_loop(acc: List, elt: Form) -> List: match elt: case List([Symbol('splice-unquote'), form]): return List((Symbol('concat'), form, acc)) case List([Symbol('splice-unquote'), *args]): raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) case _: return List((Symbol('cons'), quasiquote(elt), acc)) def qq_foldr(forms: Sequence[Form]) -> List: return functools.reduce(qq_loop, reversed(forms), List()) def quasiquote(ast: Form) -> Form: match ast: case Map() | Symbol(): return List((Symbol('quote'), ast)) case Vector(): return List((Symbol('vec'), qq_foldr(ast))) case List([Symbol('unquote'), form]): return form case List([Symbol('unquote'), *args]): raise Error('unquote: bad arguments: ' + pr_seq(args)) case List(): return qq_foldr(ast) case _: return ast def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [form]: return quasiquote(form), env case _: raise Error('quasiquote: bad arguments: ' + pr_seq(args)) def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: fun = eval_(form, env) if not isinstance(fun, Fn): raise Error(f'defmacro!: {fun} is not a function') macro = Macro(fun.call) env[key] = macro return macro, None case _: raise Error('defmacro!: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, 'quote': eval_quote, 'quasiquote': eval_quasiquote, 'defmacro!': eval_defmacro, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Macro(call): ast = call(args) case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. @core.built_in('eval') def _(args: Sequence[Form]) -> Form: match args: case [form]: return eval_(form, repl_env) case _: raise Error('bad arguments') rep('(def! not (fn* (a) (if a false true)))', repl_env) rep("""(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) 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)))))))""", repl_env) match sys.argv: case _, file_name, *args: repl_env['*ARGV*'] = List(String(a) for a in args) rep(f'(load-file "{file_name}")', repl_env) case _: repl_env['*ARGV*'] = List() while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/step9_try.py ================================================ import functools import sys import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, Map, Nil, String, Symbol, TCOEnv, ThrownException, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: match args: case [form]: return form, None case _: raise Error('quote: bad arguments: ' + pr_seq(args)) def qq_loop(acc: List, elt: Form) -> List: match elt: case List([Symbol('splice-unquote'), form]): return List((Symbol('concat'), form, acc)) case List([Symbol('splice-unquote'), *args]): raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) case _: return List((Symbol('cons'), quasiquote(elt), acc)) def qq_foldr(forms: Sequence[Form]) -> List: return functools.reduce(qq_loop, reversed(forms), List()) def quasiquote(ast: Form) -> Form: match ast: case Map() | Symbol(): return List((Symbol('quote'), ast)) case Vector(): return List((Symbol('vec'), qq_foldr(ast))) case List([Symbol('unquote'), form]): return form case List([Symbol('unquote'), *args]): raise Error('unquote: bad arguments: ' + pr_seq(args)) case List(): return qq_foldr(ast) case _: return ast def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [form]: return quasiquote(form), env case _: raise Error('quasiquote: bad arguments: ' + pr_seq(args)) def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: fun = eval_(form, env) if not isinstance(fun, Fn): raise Error(f'defmacro!: {fun} is not a function') macro = Macro(fun.call) env[key] = macro return macro, None case _: raise Error('defmacro!: bad arguments: ' + pr_seq(args)) def eval_try(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [test]: return test, env case [test, List([Symbol('catch*'), Symbol() as key, handler])]: try: return eval_(test, env), None except ThrownException as exc: return handler, env.new_child({key: exc.form}) except Error as exc: return handler, env.new_child({key: String(str(exc))}) case _: raise Error('try*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, 'quote': eval_quote, 'quasiquote': eval_quasiquote, 'defmacro!': eval_defmacro, 'try*': eval_try, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Macro(call): ast = call(args) case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. @core.built_in('eval') def _(args: Sequence[Form]) -> Form: match args: case [form]: return eval_(form, repl_env) case _: raise Error('bad arguments') rep('(def! not (fn* (a) (if a false true)))', repl_env) rep("""(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) 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)))))))""", repl_env) match sys.argv: case _, file_name, *args: repl_env['*ARGV*'] = List(String(a) for a in args) rep(f'(load-file "{file_name}")', repl_env) case _: repl_env['*ARGV*'] = List() while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/stepA_mal.py ================================================ # pylint: disable=invalid-name # Disabled because the file name contains a capital letter. Ideally, # we would check the rest of the module, but this does not matter much # as step9 is almost identical. import functools import sys import traceback from collections.abc import Sequence import core from env import call_env import mal_readline from mal_types import (Boolean, Env, Error, Fn, Form, List, Macro, Map, Nil, String, Symbol, TCOEnv, ThrownException, Vector, pr_seq) import reader # Special forms return either a final result or a new TCO context. SpecialResult = tuple[Form, Env | None] def eval_def(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: value = eval_(form, env) env[key] = value return value, None case _: raise Error('def!: bad arguments: ' + pr_seq(args)) def eval_let(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as binds, form]: if len(binds) % 2: raise Error('let*: odd bind count: ' + pr_seq(binds)) let_env = env.new_child() for i in range(0, len(binds), 2): key = binds[i] if not isinstance(key, Symbol): raise Error(f'let*: {key} is not a symbol') let_env[key] = eval_(binds[i + 1], let_env) return form, let_env case _: raise Error('let*: bad arguments: ' + pr_seq(args)) def eval_do(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [*forms, last]: for form in forms: eval_(form, env) return last, env case _: raise Error('do: no argument') def eval_if(args: Sequence[Form], env: Env) -> SpecialResult: if 2 <= len(args) <= 3: if eval_(args[0], env) in (Nil.NIL, Boolean.FALSE): if len(args) == 3: return args[2], env return Nil.NIL, None return args[1], env raise Error('if: bad argument count: ' + pr_seq(args)) def eval_fn(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [List() | Vector() as forms, body]: # The new structure convinces mypy. parms = [] for parm in forms: if not isinstance(parm, Symbol): raise Error(f'fn*: {parm} is not a symbol') parms.append(parm) def fenv(f_args: Sequence[Form]) -> Env: return call_env(env, parms, f_args) def call(f_args: Sequence[Form]) -> Form: return eval_(body, fenv(f_args)) return Fn(call, TCOEnv(body, fenv)), None case _: raise Error('fn*: bad arguments: ' + pr_seq(args)) def eval_quote(args: Sequence[Form], _env: Env) -> SpecialResult: match args: case [form]: return form, None case _: raise Error('quote: bad arguments: ' + pr_seq(args)) def qq_loop(acc: List, elt: Form) -> List: match elt: case List([Symbol('splice-unquote'), form]): return List((Symbol('concat'), form, acc)) case List([Symbol('splice-unquote'), *args]): raise Error('splice-unquote: bad arguments: ' + pr_seq(args)) case _: return List((Symbol('cons'), quasiquote(elt), acc)) def qq_foldr(forms: Sequence[Form]) -> List: return functools.reduce(qq_loop, reversed(forms), List()) def quasiquote(ast: Form) -> Form: match ast: case Map() | Symbol(): return List((Symbol('quote'), ast)) case Vector(): return List((Symbol('vec'), qq_foldr(ast))) case List([Symbol('unquote'), form]): return form case List([Symbol('unquote'), *args]): raise Error('unquote: bad arguments: ' + pr_seq(args)) case List(): return qq_foldr(ast) case _: return ast def eval_quasiquote(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [form]: return quasiquote(form), env case _: raise Error('quasiquote: bad arguments: ' + pr_seq(args)) def eval_defmacro(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [Symbol() as key, form]: fun = eval_(form, env) if not isinstance(fun, Fn): raise Error(f'defmacro!: {fun} is not a function') macro = Macro(fun.call) env[key] = macro return macro, None case _: raise Error('defmacro!: bad arguments: ' + pr_seq(args)) def eval_try(args: Sequence[Form], env: Env) -> SpecialResult: match args: case [test]: return test, env case [test, List([Symbol('catch*'), Symbol() as key, handler])]: try: return eval_(test, env), None except ThrownException as exc: return handler, env.new_child({key: exc.form}) except Error as exc: return handler, env.new_child({key: String(str(exc))}) case _: raise Error('try*: bad arguments: ' + pr_seq(args)) specials = { 'def!': eval_def, 'let*': eval_let, 'do': eval_do, 'if': eval_if, 'fn*': eval_fn, 'quote': eval_quote, 'quasiquote': eval_quasiquote, 'defmacro!': eval_defmacro, 'try*': eval_try, } def eval_(ast: Form, env: Env) -> Form: while True: if env.get('DEBUG-EVAL') not in (None, Nil.NIL, Boolean.FALSE): print(f'EVAL: {ast}') # , repr(ast)) for outer in env.maps: print(' ENV:', ' '.join(f'{k}: {v}' for k, v in reversed(outer.items()))[:75]) match ast: case Symbol(): if (value := env.get(ast)) is not None: return value raise Error(f"'{ast}' not found") case Map(): return Map((k, eval_(v, env)) for k, v in ast.items()) case Vector(): return Vector(eval_(x, env) for x in ast) case List([first, *args]): if isinstance(first, Symbol) and (spec := specials.get(first)): ast, maybe_env = spec(args, env) if maybe_env is None: return ast env = maybe_env else: match eval_(first, env): case Macro(call): ast = call(args) case Fn(tco_env=TCOEnv(body, fenv)): ast = body env = fenv(tuple(eval_(x, env) for x in args)) case Fn(call): return call(tuple(eval_(x, env) for x in args)) case not_fun: raise Error(f'cannot apply {not_fun}') case _: return ast def rep(source: str, env: Env) -> str: return str(eval_(reader.read(source), env)) def main() -> None: repl_env = Env(core.ns) # Modifying ns is OK. @core.built_in('eval') def _(args: Sequence[Form]) -> Form: match args: case [form]: return eval_(form, repl_env) case _: raise Error('bad arguments') rep('(def! not (fn* (a) (if a false true)))', repl_env) rep("""(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))""", repl_env) 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)))))))""", repl_env) rep('(def! *host-language* "python3")', repl_env) match sys.argv: case _, file_name, *args: repl_env['*ARGV*'] = List(String(a) for a in args) rep(f'(load-file "{file_name}")', repl_env) case _: repl_env['*ARGV*'] = List() rep('(println (str "Mal [" *host-language* "]"))', repl_env) while True: try: print(rep(mal_readline.input_('user> '), repl_env)) except EOFError: break # pylint: disable-next=broad-exception-caught except Exception as exc: traceback.print_exception(exc, limit=10) if __name__ == '__main__': main() ================================================ FILE: impls/python3/tests/__init__.py ================================================ ================================================ FILE: impls/python3/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/python3/tests/stepA_mal.mal ================================================ *host-language* ;=>"python3" ;; Testing Python interop ;; Testing Python expressions (py* "7") ;=>7 (py* "'7'") ;=>"7" (py* "[7,8,9]") ;=>(7 8 9) (py* "' '.join(f'X{c}Y' for c in 'abc')") ;=>"XaY XbY XcY" (py* "list(1 + x for x in range(1, 4))") ;=>(2 3 4) ;; Testing Python statements (py!* "print('hello')") ;/hello ;=>nil (py!* "foo = 19 % 4") ;=>nil (py* "foo") ;=>3 ================================================ FILE: impls/python3/tests/test_step2.py ================================================ import unittest import step2_eval class TestStep3(unittest.TestCase): def test_step3_let_multiple(self): self.assertEqual('{"a" 15}', step2_eval.rep('{"a" (+ 7 8)} ')) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step3.py ================================================ import unittest import mal_types import step3_env from env import Env from mal_types import MalList, MalInt from mal_types import MalSymbol from mal_types import MalUnknownSymbolException, MalInvalidArgumentException class TestStep3(unittest.TestCase): def test_env_find(self): e = Env(None) e.set("key", MalInt(1)) result = e.find("key") self.assertTrue(e is result) def test_env_find_outer(self): outer = Env(None) e = Env(outer) outer.set("key", MalInt(1)) result = e.find("key") self.assertTrue(result is outer) def test_env_find_no_key(self): e = Env(None) self.assertEqual(None, e.find("key")) def test_env_get(self): env = Env(None) expression = MalInt(1) env.set("key", expression) self.assertTrue(env.get("key") is expression) def test_env_get_error(self): env = Env(None) try: env.get("key") self.fail("Expected an exeception") except MalUnknownSymbolException: pass def test_MalFunctionCompiled(self): self.assertEqual( "3", str( mal_types.MalFunctionCompiled( lambda a: MalInt(a[0].native() + a[1].native()) ).call([mal_types.MalInt(1), mal_types.MalInt(2)]) ), ) def test_eval_invalid(self): with self.assertRaises(MalInvalidArgumentException): step3_env.EVAL(MalList([MalInt(1), MalInt(2)]), Env(None)) def test_eval_1_plus_1(self): env = Env(None) env.set( "+", mal_types.MalFunctionCompiled( lambda a: MalInt(a[0].native() + a[1].native()) ), ) self.assertEqual( 2, step3_env.EVAL( MalList([MalSymbol("+"), MalInt(1), MalInt(1)]), env ).native(), ) def test_def(self): env = Env(None) self.assertEqual( 1, step3_env.EVAL( MalList([MalSymbol("def!"), MalSymbol("a"), MalInt(1)]), env ).native(), ) self.assertEqual(1, env.get("a").native()) def test_mallist_native(self): x = MalInt(1) self.assertEqual([x], MalList([x]).native()) def test_let_basic(self): env = Env(None) self.assertEqual( 2, step3_env.EVAL( MalList( [ MalSymbol("let*"), MalList([MalSymbol("c"), MalInt(2)]), MalSymbol("c"), ] ), env, ).native(), ) def test_let_advanced(self): env = Env(None) env.set( "+", mal_types.MalFunctionCompiled( lambda a: MalInt(a[0].native() + a[1].native()) ), ) self.assertEqual( 4, step3_env.EVAL( MalList( [ MalSymbol("let*"), MalList([MalSymbol("c"), MalInt(2)]), MalList([MalSymbol("+"), MalSymbol("c"), MalInt(2)]), ] ), env, ).native(), ) def test_let_multiple(self): env = Env(None) env.set( "+", mal_types.MalFunctionCompiled( lambda a: MalInt(a[0].native() + a[1].native()) ), ) self.assertEqual( 5, step3_env.EVAL( MalList( [ MalSymbol("let*"), MalList([MalSymbol("c"), MalInt(2), MalSymbol("d"), MalInt(3)]), MalList([MalSymbol("+"), MalSymbol("c"), MalSymbol("d")]), ] ), env, ).native(), ) def test_step3_let_multiple(self): self.assertEqual("5", step3_env.rep("(let* (c 2 d 3) (+ c d))")) def test_step3_let_nested_backref(self): self.assertEqual("6", step3_env.rep("(let* (c 2 d c) (+ c (+ d 2)))")) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step4.py ================================================ import unittest import step4_if_fn_do from env import Env from mal_types import MalInvalidArgumentException from mal_types import MalList, MalInt, MalFunctionCompiled, MalBoolean from mal_types import MalSymbol class TestStep4(unittest.TestCase): def test_step4_nil(self): self.assertEqual("nil", step4_if_fn_do.rep("nil")) def test_step4_boolean(self): self.assertEqual("true", step4_if_fn_do.rep("true")) self.assertEqual("false", step4_if_fn_do.rep("false")) def test_print_function(self): self.assertEqual("#", str(MalFunctionCompiled(lambda x: MalInt(0)))) def test_if_basic_true(self): env = Env(None) self.assertEqual( 4321, step4_if_fn_do.EVAL( MalList( [MalSymbol("if"), MalBoolean(True), MalInt(4321), MalInt(1234)] ), env, ).native(), ) def test_if_basic_false(self): env = Env(None) self.assertEqual( 1234, step4_if_fn_do.EVAL( MalList( [MalSymbol("if"), MalBoolean(False), MalInt(4321), MalInt(1234)] ), env, ).native(), ) def test_if_basic_false_no_fourth_arg(self): env = Env(None) self.assertEqual( "nil", str( step4_if_fn_do.EVAL( MalList([MalSymbol("if"), MalBoolean(False), MalInt(4321)]), env ) ), ) def test_env_constructor_binds(self): env = Env(outer=None, binds=[MalSymbol("a")], exprs=[MalInt(3)]) self.assertEqual(3, env.get("a").native()) def test_env_constructor_binds_multiple(self): env = Env( outer=None, binds=[MalSymbol("a"), MalSymbol("b")], exprs=[MalInt(44), MalInt(32)], ) self.assertEqual(44, env.get("a").native()) self.assertEqual(32, env.get("b").native()) def test_step4_do(self): self.assertEqual("44", step4_if_fn_do.rep("(do 1 2 3 44)")) self.assertEqual("21", step4_if_fn_do.rep("(do 21)")) def test_step4_fn(self): self.assertEqual("#", step4_if_fn_do.rep("(fn* (a) 0)")) def test_step4_use_fn(self): self.assertEqual("7", step4_if_fn_do.rep("((fn* (a) a) 7)")) def test_step4_use_fn_multiple(self): self.assertEqual("8", step4_if_fn_do.rep("((fn* (a b) a) 8 9)")) def test_step4_use_fn_multiple_nested(self): self.assertEqual("10", step4_if_fn_do.rep("((fn* (a b) (+ a (+ b 1))) 4 5)")) def test_step4_use_fn_func_param(self): self.assertEqual( "8", step4_if_fn_do.rep("((fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7)") ) def test_step4_prn(self): self.assertEqual("nil", step4_if_fn_do.rep("(prn 4)")) def test_step4_list(self): self.assertEqual("(1 2 (3 4) 5)", step4_if_fn_do.rep("(list 1 2 (list 3 4) 5)")) def test_step4_listP(self): self.assertEqual("true", step4_if_fn_do.rep("(list? (list 1 2))")) self.assertEqual("false", step4_if_fn_do.rep("(list? 4)")) def test_step4_empty(self): self.assertEqual("true", step4_if_fn_do.rep("(empty? (list))")) def test_step4_count(self): self.assertEqual("0", step4_if_fn_do.rep("(count (list))")) self.assertEqual("2", step4_if_fn_do.rep("(count (list 1 2))")) self.assertEqual("0", step4_if_fn_do.rep("(count nil)")) def test_step4_equal(self): self.assertEqual("true", step4_if_fn_do.rep("(= 0 0)")) self.assertEqual("true", step4_if_fn_do.rep("(= (list 1) (list 1))")) self.assertEqual("false", step4_if_fn_do.rep("(= (list 1) (list 1 2))")) self.assertEqual( "true", step4_if_fn_do.rep("(= (list (list 1) (list 2)) (list (list 1) (list 2)))"), ) self.assertEqual("true", step4_if_fn_do.rep("(= nil nil)")) def test_step4_less(self): self.assertEqual("true", step4_if_fn_do.rep("(< 1 2)")) self.assertEqual("false", step4_if_fn_do.rep("(< 2 1)")) self.assertEqual("false", step4_if_fn_do.rep("(< 1 1)")) try: step4_if_fn_do.rep("(< 1 nil)") self.fail("Expected exception") except MalInvalidArgumentException: pass try: step4_if_fn_do.rep("(< nil 1)") self.fail("Expected exception") except MalInvalidArgumentException: pass def test_step4_less_equal(self): self.assertEqual("true", step4_if_fn_do.rep("(<= 1 2)")) self.assertEqual("false", step4_if_fn_do.rep("(<= 2 1)")) self.assertEqual("true", step4_if_fn_do.rep("(<= 1 1)")) try: step4_if_fn_do.rep("(<= 1 nil)") self.fail("Expected exception") except MalInvalidArgumentException: pass try: step4_if_fn_do.rep("(<= nil 1)") self.fail("Expected exception") except MalInvalidArgumentException: pass def test_step4_more(self): self.assertEqual("false", step4_if_fn_do.rep("(> 1 2)")) self.assertEqual("true", step4_if_fn_do.rep("(> 2 1)")) self.assertEqual("false", step4_if_fn_do.rep("(> 1 1)")) try: step4_if_fn_do.rep("(> 1 nil)") self.fail("Expected exception") except MalInvalidArgumentException: pass try: step4_if_fn_do.rep("(> nil 1)") self.fail("Expected exception") except MalInvalidArgumentException: pass def test_step4_more_equal(self): self.assertEqual("false", step4_if_fn_do.rep("(>= 1 2)")) self.assertEqual("true", step4_if_fn_do.rep("(>= 2 1)")) self.assertEqual("true", step4_if_fn_do.rep("(>= 1 1)")) try: step4_if_fn_do.rep("(>= 1 nil)") self.fail("Expected exception") except MalInvalidArgumentException: pass try: step4_if_fn_do.rep("(>= nil 1)") self.fail("Expected exception") except MalInvalidArgumentException: pass def test_step4_closures(self): self.assertEqual( "12", step4_if_fn_do.rep("(( (fn* (a) (fn* (b) (+ a b))) 5) 7)") ) self.assertEqual( "#", step4_if_fn_do.rep("(def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))"), ) self.assertEqual( "#", step4_if_fn_do.rep("(def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))"), ) self.assertEqual("#", step4_if_fn_do.rep("(def! plus5 (gen-plus5))")) self.assertEqual("12", step4_if_fn_do.rep("(plus5 7)")) def test_step4_variadic_a(self): self.assertEqual( "3", step4_if_fn_do.rep("( (fn* (& more) (count more)) 1 2 3)") ) def test_step4_variadic_b(self): self.assertEqual("0", step4_if_fn_do.rep("((fn* (& more) (count more)))")) def test_step4_quoted_string(self): self.assertEqual('"\\""', step4_if_fn_do.rep('"\\""')) def test_step4_str(self): self.assertEqual('"(1 a 2 3)"', step4_if_fn_do.rep('(str (list 1 "a" 2 3))')) def test_step4_equal_vector_list(self): self.assertEqual("true", step4_if_fn_do.rep("(=[] (list))")) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step5.py ================================================ import unittest import step5_tco class TestStep5(unittest.TestCase): def test_step5_tco(self): self.assertEqual( "#", step5_tco.rep( "(def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc)))))" ), ) self.assertEqual("55", step5_tco.rep("(sum2 10 0)")) self.assertEqual("nil", step5_tco.rep("(def! res2 nil)")) self.assertEqual("500500", step5_tco.rep("(def! res2 (sum2 1000 0))")) self.assertEqual("500500", step5_tco.rep("res2")) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step6.py ================================================ import unittest import reader import step6_file from env import Env from mal_types import MalList, MalAtom, MalInt from mal_types import MalSyntaxException, MalString class TestStep6(unittest.TestCase): def test_step6_string_unbalanced(self): with self.assertRaises(MalSyntaxException): step6_file.rep('"foo') def test_step6_standard_string(self): self.assertEqual( '"foo"', step6_file.EVAL(MalString('"foo"'), Env(None)).native() ) self.assertEqual('"foo"', step6_file.rep('"foo"').__str__()) self.assertEqual('"foo"', MalString('"foo"').native()) self.assertEqual('"\\"foo\\""', MalString('"foo"').__str__()) def test_step6_reader_read_string(self): read = reader.read('(read-string "(1 2 (3 4) nil)")') self.assertTrue(isinstance(read, MalList)) arg = read.native()[1] self.assertTrue(isinstance(arg, MalString)) native_str = arg.native() self.assertEqual("(1 2 (3 4) nil)", native_str) def test_step6_read_string_no_escapes(self): self.assertEqual( "(1 2 (3 4) nil)", step6_file.rep('(read-string "(1 2 (3 4) nil)")') ) def test_step6_slurp(self): self.assertEqual( '"A line of text\\n"', step6_file.rep('(slurp "../../tests/test.txt")') ) def test_step6_eval(self): self.assertEqual("2", step6_file.rep('(eval (read-string "(+ 1 1)"))')) def test_step6_str(self): self.assertEqual('"abc2def ghi"', step6_file.rep('(str "abc" 2 "def" " ghi")')) def test_step6_atom_type(self): atom = step6_file.EVAL(MalAtom(MalInt(1)), Env(None)) self.assertEqual(1, atom.native().native()) def test_step6_read_atom(self): atom = step6_file.EVAL(step6_file.READ("(atom 1)"), step6_file.repl_env) self.assertEqual(1, atom.native().native()) def test_step6_atom_deref(self): self.assertEqual("1", step6_file.rep("(deref (atom 1))")) def test_step6_atom_p(self): self.assertEqual("true", step6_file.rep("(atom? (atom 1))")) self.assertEqual("false", step6_file.rep("(atom? (+ 1 2))")) def test_step6_reset(self): self.assertEqual("3", step6_file.rep("(do (def! a (atom 2)) (reset! a 3))")) def test_step6_swap(self): self.assertEqual("#", step6_file.rep("(def! inc3 (fn* (a) (+ 3 a)))")) self.assertEqual("(atom 2)", step6_file.rep("(def! a (atom 2))")) self.assertEqual("3", step6_file.rep("(swap! a + 1)")) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step7.py ================================================ import unittest import step7_quote class TestStep7(unittest.TestCase): def test_step7_cons(self): self.assertEqual("(1)", step7_quote.rep("(cons 1 (list))")) def test_step7_concat(self): self.assertEqual("()", step7_quote.rep("(concat)")) def test_step7_quote(self): self.assertEqual("(+ 1 2)", step7_quote.rep("(quote (+ 1 2))")) def test_step7_quasiquote(self): self.assertEqual( "(+ 1 3)", step7_quote.rep("(quasiquote (+ 1 (unquote (+ 1 2))))") ) def test_step7_quasiquote_advanced(self): self.assertEqual("(2)", step7_quote.rep("(def! c '(2))")) self.assertEqual("(1 2 3)", step7_quote.rep("`[1 ~@c 3]")) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step8.py ================================================ import unittest import core import step8_macros from env import Env from mal_types import MalFunctionCompiled, MalInt, MalFunctionRaw, MalList from mal_types import MalInvalidArgumentException, MalIndexError class TestStep8(unittest.TestCase): def setUp(self) -> None: self._repl_env = step8_macros.init_repl_env() def rep(self, input: str) -> str: return step8_macros.rep(input, self._repl_env) def test_step8_is_macro(self): self.assertEqual(False, MalFunctionCompiled(lambda a: MalInt(1)).is_macro()) self.assertEqual( False, MalFunctionRaw(core.ns["+"], MalInt(1), MalList([]), Env(None)).is_macro(), ) def test_step8_defmacro(self): self.assertEqual("#", self.rep("(defmacro! one (fn* () 1))")) def test_step8_quote_reader_macro(self): self.assertEqual("(+ 1 2)", self.rep("'(+ 1 2)")) def test_step8_quasiquote_unquote_reader_macros(self): self.assertEqual("(+ 1 3)", self.rep("`(+ 1 ~(+ 1 2))")) def test_step8_repl_env_isolation(self): env1 = step8_macros.init_repl_env() step8_macros.rep("(def! a 2)", env1) env2 = step8_macros.init_repl_env() step8_macros.rep("(def! a 3)", env2) self.assertEqual("2", step8_macros.rep("a", env1)) self.assertEqual("3", step8_macros.rep("a", env2)) self.assertEqual("6", step8_macros.rep("(eval (list + a 3))", env2)) def test_step8_is_macro_call(self): self.rep("(defmacro! macro (fn* () 1))") self.rep("(def! func (fn* () 1))") self.rep("(def! q 4)") macro = step8_macros.READ("(macro)") func = step8_macros.READ("(func)") other1 = step8_macros.READ("(x)") other2 = step8_macros.READ("(1)") other3 = step8_macros.READ("(2)") other4 = step8_macros.READ("(q)") self.assertTrue(step8_macros.is_macro_call(macro, self._repl_env)) self.assertFalse(step8_macros.is_macro_call(func, self._repl_env)) self.assertFalse(step8_macros.is_macro_call(other1, self._repl_env)) self.assertFalse(step8_macros.is_macro_call(other2, self._repl_env)) self.assertFalse(step8_macros.is_macro_call(other3, self._repl_env)) self.assertFalse(step8_macros.is_macro_call(other4, self._repl_env)) def test_step8_macroexpand(self): self.rep("(def! func (fn* () 1))") func = step8_macros.READ("(func)") self.assertEqual("(func)", str(step8_macros.macroexpand(func, self._repl_env))) self.rep("(defmacro! macro (fn* () 1))") macro = step8_macros.READ("(macro)") self.assertEqual("1", str(step8_macros.macroexpand(macro, self._repl_env))) self.rep("(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a)))") self.assertEqual("(if true 7 8)", self.rep("(macroexpand (unless true 8 7))")) def test_step8_not(self): self.assertEqual("true", self.rep("(not (not true))")) self.assertEqual("true", self.rep("(not nil)")) self.assertEqual("false", self.rep("(not 1)")) self.assertEqual("true", self.rep("(not false)")) def test_step8_let(self): self.assertEqual("2", self.rep("(let* (a 1 b 2) b)")) def test_step8_first(self): self.assertEqual("2", self.rep("(first (list 2 3 4))")) self.assertEqual("nil", self.rep("(first (list))")) self.assertEqual("nil", self.rep("(first nil)")) with self.assertRaises(MalInvalidArgumentException): self.rep("(first 1)") def test_step8_rest(self): self.assertEqual("(2 3)", self.rep("(rest (list 1 2 3))")) self.assertEqual("()", self.rep("(rest (list))")) self.assertEqual("()", self.rep("(rest nil)")) with self.assertRaises(MalInvalidArgumentException): self.rep("(rest 1)") def test_step8_nth(self): self.assertEqual("3", self.rep("(nth '(1 2 3) 2)")) with self.assertRaises(MalIndexError): self.rep("(nth () 1)") if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_step9.py ================================================ import unittest import step9_try from mal_types import MalException, MalIndexError, MalInvalidArgumentException class TestStep9(unittest.TestCase): def setUp(self) -> None: self._repl_env = step9_try.init_repl_env() def rep(self, input: str) -> str: return step9_try.rep(input, self._repl_env) def test_step9_throw(self): with self.assertRaises(MalException): self.assertEqual("foo", self.rep('(throw "err1")')) def test_step9_try_catch(self): self.assertEqual("123", self.rep("(try* 123 (catch* e 456))")) self.assertEqual( "nil", self.rep('(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))') ) def test_step9_nth(self): self.assertEqual("3", self.rep("(nth '(1 2 3) 2)")) with self.assertRaises(MalIndexError): self.rep("(nth () 1)") def test_step9_apply(self): self.assertEqual("(1 1)", self.rep("(apply list '(1 1))")) self.assertEqual("(1 2 1 2)", self.rep("(apply list 1 2 '(1 2))")) def test_step9_map(self): self.assertEqual("((1) (2))", self.rep("(map list '(1 2))")) def test_step9_symbol_q(self): self.assertEqual("true", self.rep("(symbol? 'x)")) self.assertEqual("false", self.rep("(symbol? nil)")) def test_step9_nil(self): self.assertEqual("true", self.rep("(nil? nil)")) self.assertEqual("false", self.rep("(nil? 1)")) def test_step9_true(self): self.assertEqual("true", self.rep("(true? true)")) self.assertEqual("false", self.rep("(true? false)")) self.assertEqual("false", self.rep("(true? nil)")) self.assertEqual("false", self.rep("(true? 1)")) def test_step9_false(self): self.assertEqual("true", self.rep("(false? false)")) self.assertEqual("false", self.rep("(false? true)")) self.assertEqual("false", self.rep("(false? nil)")) self.assertEqual("false", self.rep("(false? 1)")) def test_step9_throw_hash_map(self): with self.assertRaises(MalException): self.rep('(throw {:msg "err2"})') def test_step9_symbol(self): self.assertEqual("abc", self.rep('(symbol "abc")')) def test_step9_complex_apply(self): self.assertEqual("9", self.rep("(apply + 4 [5])")) def test_step9_get(self): self.assertEqual("nil", self.rep('(get nil "a")')) self.assertEqual("nil", self.rep('(get (hash-map) "a")')) def test_step9_complex_str(self): self.assertEqual('"A{:abc val}Z"', self.rep('(str "A" {:abc "val"} "Z")')) def test_step9_sequential_q(self): self.assertEqual("true", self.rep("(sequential? (list 1 2 3))")) self.assertEqual("true", self.rep("(sequential? ())")) self.assertEqual("false", self.rep("(sequential? nil)")) self.assertEqual("false", self.rep("(sequential? 1)")) self.assertEqual("true", self.rep("(sequential? [1 2 3])")) self.assertEqual("true", self.rep("(sequential? [])")) self.assertEqual("false", self.rep("(sequential? {})")) def test_step9_vector(self): self.assertEqual("[1 2 3]", self.rep("(vector 1 2 3)")) self.assertEqual("[]", self.rep("(vector)")) self.assertEqual("[[1 2]]", self.rep("(vector [1 2])")) self.assertEqual("[nil]", self.rep("(vector nil)")) def test_step9_hash_map(self): self.assertEqual("{}", self.rep("(hash-map)")) self.assertEqual('{"a" 1}', self.rep('(hash-map "a" 1)')) self.assertEqual('{"a" 1 "b" 2}', self.rep('(hash-map "a" 1 "b" 2)')) def test_step9_assoc(self): with self.assertRaises(MalInvalidArgumentException): self.rep("(assoc)") self.assertEqual("1", self.rep("(assoc 1)")) self.assertEqual("nil", self.rep("(assoc nil)")) self.assertEqual("{}", self.rep("(assoc {})")) self.assertEqual('{"a" 1}', self.rep('(assoc {} "a" 1)')) self.assertEqual('{"b" 2 "a" 1}', self.rep('(assoc {"b" 2} "a" 1)')) self.assertEqual('{"b" 2 "a" 1 "c" 3}', self.rep('(assoc {"b" 2} "a" 1 "c" 3)')) self.assertEqual('{"b" 3}', self.rep('(assoc {"b" 2} "b" 3)')) self.assertEqual("{:bcd 234}", self.rep("(assoc {} :bcd 234)")) def test_step9_contains_q(self): with self.assertRaises(MalInvalidArgumentException): self.rep("(contains?)") with self.assertRaises(MalInvalidArgumentException): self.rep("(contains? 1)") with self.assertRaises(MalInvalidArgumentException): self.rep("(contains? nil)") with self.assertRaises(MalInvalidArgumentException): self.rep("(contains? nil nil)") self.assertEqual("false", self.rep("(contains? {} nil)")) self.assertEqual("true", self.rep('(contains? {"a" 1} "a")')) self.assertEqual("true", self.rep('(contains? {"a" 1 :b 2} :b)')) def test_step9_keys(self): with self.assertRaises(MalInvalidArgumentException): self.rep("(keys)") with self.assertRaises(MalInvalidArgumentException): self.rep("(keys 1)") self.assertEqual('("a")', self.rep('(keys {"a" 1})')) self.assertEqual('("a" :b)', self.rep('(keys {"a" 1 :b 2})')) def test_step9_vals(self): with self.assertRaises(MalInvalidArgumentException): self.rep("(vals)") with self.assertRaises(MalInvalidArgumentException): self.rep("(vals 1)") self.assertEqual("(1)", self.rep('(vals {"a" 1})')) self.assertEqual("(1 2)", self.rep('(vals {"a" 1 :b 2})')) def test_step9_dissoc(self): self.assertEqual('{"c" 3}', self.rep('(dissoc {"a" 1 "b" 2 "c" 3} "a" "b")')) self.assertEqual( '{"c" 3}', self.rep('(dissoc {"a" 1 "b" 2 "c" 3} "a" "b" "d")') ) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/python3/tests/test_stepA.py ================================================ import unittest import stepA_mal class TestStepA(unittest.TestCase): def setUp(self) -> None: self._repl_env = stepA_mal.init_repl_env() def rep(self, input: str) -> str: return stepA_mal.rep(input, self._repl_env) def test_stepA_host_language(self): self.assertEqual('"python.2"', self.rep("*host-language*")) def test_stepA_eval_vector(self): self.assertEqual("[1 2 3]", self.rep("[1 2 (+ 1 2)]")) def test_reader_multiple_lines(self): self.assertEqual("3", self.rep("(do\n1\n2\n3\n)")) def test_read_string_multiple_lines(self): self.assertEqual( "(do 2 nil)", self.rep('(read-string (str "(do \n" ";; read\n" "2\n" "\n nil)"))'), ) def test_read_hash_map(self): self.assertEqual("{}", self.rep("{}")) self.assertEqual('{"a" 1}', self.rep('{"a" 1}')) self.assertEqual('{"1" 2 "3" 4}', self.rep('{"1" 2 "3" 4}')) def test_get(self): self.assertEqual("1", self.rep('(get {"+" 1} "+")')) def test_keyword(self): self.assertEqual(":keyword", self.rep(":keyword")) def test_deref_reader_macro(self): self.assertEqual("1", self.rep("@(atom 1)")) def test_splice_unquote_reader_macro(self): self.assertEqual("(splice-unquote (1 2 3))", str(stepA_mal.READ("~@(1 2 3)"))) def test_swap_assoc_get(self): self.assertEqual( '(atom {"+" #})', self.rep('(def! e (atom {"+" +}))') ) self.assertEqual( '{"+" # "-" #}', self.rep('(swap! e assoc "-" -)') ) self.assertEqual("15", self.rep('( (get @e "+") 7 8)')) self.assertEqual("3", self.rep('( (get @e "-") 11 8)')) self.assertEqual( '{"+" # "-" # "foo" ()}', self.rep('(swap! e assoc "foo" (list))'), ) self.assertEqual("()", self.rep('(get @e "foo")')) self.assertEqual( '{"+" # "-" # "foo" () "bar" (1 2 3)}', self.rep('(swap! e assoc "bar" \'(1 2 3))'), ) self.assertEqual("(1 2 3)", self.rep('(get @e "bar")')) if __name__ == "__main__": unittest.main() ================================================ FILE: impls/r/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install curl gcc libc-dev libreadline-dev r-base-core ================================================ FILE: impls/r/Makefile ================================================ SOURCES_BASE = readline.r types.r reader.r printer.r SOURCES_LISP = env.r core.r stepA_mal.r SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) STEPS = step0_repl.r step1_read_print.r step2_eval.r step3_env.r \ step4_if_fn_do.r step5_tco.r step6_file.r \ step7_quote.r step8_macros.r step9_try.r stepA_mal.r all: libs dist: mal.r mal mal.r: $(SOURCES) cat $+ | grep -v " source(" > $@ mal: mal.r echo "#!/usr/bin/env Rscript" > $@ cat $< >> $@ chmod +x $@ $(STEPS): libs .PHONY: libs: lib/rdyncall lib/rdyncall: curl -O http://cran.r-project.org/src/contrib/Archive/rdyncall/rdyncall_0.7.5.tar.gz mkdir -p lib R CMD INSTALL rdyncall_0.7.5.tar.gz -l lib/ rm rdyncall_0.7.5.tar.gz clean: rm -f mal.r mal ================================================ FILE: impls/r/core.r ================================================ ..core.. <- TRUE if(!exists("..types..")) source("types.r") if(!exists("..printer..")) source("printer.r") # String functions pr_str <- function(...) .pr_list(list(...), print_readably=TRUE, join=" ") str <- function(...) .pr_list(list(...), print_readably=FALSE, join="") prn <- function(...) { cat(.pr_list(list(...), print_readably=TRUE, join=" ")) cat("\n") nil } println <- function(...) { cat(.pr_list(list(...), print_readably=FALSE, join=" ")) cat("\n") nil } do_readline <- function(prompt) { l <- readline(prompt) if (is.null(l)) nil else l } # Hash Map functions do_get <- function(hm,k) { if (class(hm) == "nil") return(nil) v <- hm[[k]] if (is.null(v)) nil else v } contains_q <-function(hm,k) { if (class(hm) == "nil") return(FALSE) if (is.null(hm[[k]])) FALSE else TRUE } # Sequence functions cons <- function(a,b) { new_lst <- append(list(a), b) new.listl(new_lst) } nth <- function(a,b) { if (b < length(a)) a[[b+1]] else throw("nth: index out of range") } do_concat <- function(...) { new_lst <- list() for(l in list(...)) { new_lst <- append(new_lst, l) } new.listl(new_lst) } do_apply <- function(f, ...) { p <- list(...) args <- list() if (length(p) > 1) { for(l in slice(p, 1, length(p)-1)) { args[[length(args)+1]] <- l } } args <- append(args, p[[length(p)]]) fapply(f, args) } map <- function(f, seq) { new.listl(lapply(seq, function(el) fapply(f, list(el)))) } conj <- function(obj, ...) { p <- list(...) new_obj <- .clone(obj) if (.list_q(obj)) { if (length(p) > 0) { for(l in p) new_obj <- append(list(l), new_obj) } new.listl(new_obj) } else if (.vector_q(obj)) { if (length(p) > 0) { for(l in p) new_obj <- append(new_obj, list(l)) } new.vectorl(new_obj) } else { throw("conj called on non-sequence") } } do_seq <- function(obj) { if (.list_q(obj)) { if (length(obj) == 0) nil else obj } else if (.vector_q(obj)) { if (length(obj) == 0) nil else new.listl(.clone(obj)) } else if (.string_q(obj)) { if (nchar(obj) == 0) nil else new.listl(strsplit(obj, "")[[1]]) } else if (class(obj) == "nil") { nil } else { throw("seq: called on non-sequence") } } # Metadata functions with_meta <- function(obj, m) { new_obj <- .clone(obj) attr(new_obj, "meta") <- m new_obj } meta <- function(obj) { m <- attr(obj, "meta") if (is.null(m)) nil else m } # Atom functions deref <- function(atm) atm$val reset_bang <- function (atm, val) { atm$val <- val; val } swap_bang <- function (atm, f, ...) { p <- list(...) args <- list(atm$val) if (length(p) > 0) { for(l in p) args[[length(args)+1]] <- l } atm$val <- fapply(f, args) } core_ns <- list( "="=function(a,b) .equal_q(a,b), "throw"=function(err) throw(err), "nil?"=.nil_q, "true?"=.true_q, "false?"=.false_q, "string?"=.string_q, "symbol"=new.symbol, "symbol?"=.symbol_q, "keyword"=new.keyword, "keyword?"=.keyword_q, "number?"=.number_q, "fn?"=.fn_q, "macro?"=.macro_q, "pr-str"=pr_str, "str"=str, "prn"=prn, "println"=println, "readline"=do_readline, "read-string"=function(str) read_str(str), "slurp"=function(path) readChar(path, file.info(path)$size), "<"=function(a,b) a"=function(a,b) a>b, ">="=function(a,b) a>=b, "+"=function(a,b) a+b, "-"=function(a,b) a-b, "*"=function(a,b) a*b, "/"=function(a,b) a/b, "time-ms"=function() round(as.numeric(Sys.time())*1000), "list"=new.list, "list?"=function(a) .list_q(a), "vector"=new.vector, "vector?"=function(a) .vector_q(a), "hash-map"=new.hash_map, "map?"=function(a) .hash_map_q(a), "assoc"=function(hm,...) .assoc(hm,list(...)), "dissoc"=function(hm,...) .dissoc(hm,list(...)), "get"=do_get, "contains?"=contains_q, "keys"=function(hm) new.listl(ls(hm)), "vals"=function(hm) new.listl(lapply(ls(hm), function(x) hm[[x]])), "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)), "empty?"=function(a) .sequential_q(a) && length(a) == 0, "count"=function(a) if (.nil_q(a)) 0 else length(a), "apply"=do_apply, "map"=map, "conj"=conj, "seq"=do_seq, "with-meta"=with_meta, "meta"=meta, "atom"=new.atom, "atom?"=.atom_q, "deref"=deref, "reset!"=reset_bang, "swap!"=swap_bang ) ================================================ FILE: impls/r/env.r ================================================ ..env.. <- TRUE if(!exists("..types..")) source("types.r") new.Env <- function(outer=emptyenv(), binds=list(), exprs=list()) { e <- structure(new.env(parent=outer), class="Env") if (length(binds) > 0) { for(i in seq(length(binds))) { b <- binds[[i]] if (b == "&") { e[[binds[[i+1]]]] <- slice(exprs, i, length(exprs)) break } else { e[[b]] <- exprs[[i]] } } } e } Env.find <- function(e, key) { if (exists(key, envir=e, inherits=FALSE)) { e } else if (!identical(parent.env(e), emptyenv())) { Env.find(parent.env(e), key) } else { nil } } Env.set <- function(e, key, val) { e[[key]] <- val invisible(val) } Env.get <- function(e, key) { e <- Env.find(e, key) if (.nil_q(e)) throw(concat("'", key, "' not found")) e[[key]] } ================================================ FILE: impls/r/printer.r ================================================ ..printer.. <- TRUE if(!exists("..types..")) source("types.r") .pr_list <- function(lst, print_readably=TRUE, join="") { concatl(lapply(lst, function(e) .pr_str(e, print_readably)), sep=join) } .pr_str <- function(exp, print_readably=TRUE) { pr <- print_readably switch(class(exp), "List"={ paste("(", .pr_list(exp, pr, " "), ")", sep="", collapse="") }, "Vector"={ paste("[", .pr_list(exp, pr, " "), "]", sep="", collapse="") }, "HashMap"={ hlst <- list() if (length(exp) > 0) { for(k in ls(exp)) { hlst[[length(hlst)+1]] <- k hlst[[length(hlst)+1]] <- exp[[k]] } } paste("{", .pr_list(hlst, pr, " "), "}", sep="", collapse="") }, "character"={ if (substring(exp,1,1) == "\u029e") { concat(":", substring(exp,2)) } else if (substring(exp,1,8) == "") { # terrible hack, appears in 3.1.1 on Utopic concat(":", substring(exp,9)) } else if (print_readably) { paste("\"", gsub("\\n", "\\\\n", gsub("\\\"", "\\\\\"", gsub("\\\\", "\\\\\\\\", exp))), "\"", sep="", collapse="") } else { exp } }, "Symbol"={ exp }, "nil"={ "nil" }, "logical"={ tolower(exp) }, "MalFunc"={ paste("(fn* ", .pr_str(exp$params,TRUE), " ", .pr_str(exp$ast, TRUE), ")", sep="") }, "function"={ "<#function>" }, "Atom"={ paste("(atom ", .pr_str(exp$val,TRUE), ")", sep="") }, { toString(exp) }) } ================================================ FILE: impls/r/reader.r ================================================ ..reader.. <- TRUE if(!exists("..types..")) source("types.r") new.Reader <- function(tokens) { e <- structure(new.env(), class="Reader") e$tokens <- tokens e$position <- 1 e } Reader.peek <- function(rdr) { if (rdr$position > length(rdr$tokens)) return(NULL) rdr$tokens[[rdr$position]] } Reader.next <- function(rdr) { if (rdr$position > length(rdr$tokens)) return(NULL) rdr$position <- rdr$position + 1 rdr$tokens[[rdr$position-1]] } tokenize <- function(str) { re <- "[\\s,]*(~@|[\\[\\]\\{\\}\\(\\)'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]\\{\\}\\('\"`,;\\)]*)" m <- lapply(regmatches(str, gregexpr(re, str, perl=TRUE)), function(e) sub("^[\\s,]+", "", e, perl=TRUE)) res <- list() i <- 1 for(v in m[[1]]) { if (v == "" || substr(v,1,1) == ";") next res[[i]] <- v i <- i+1 } res } re_match <- function(re, str) { length(grep(re, c(str))) > 0 } read_atom <- function(rdr) { token <- Reader.next(rdr) if (re_match("^-?[0-9]+$", token)) { as.integer(token) } else if (re_match("^-?[0-9][0-9.]*$", token)) { as.double(token) } else if (re_match("^\"(?:\\\\.|[^\\\\\"])*\"$", token)) { gsub("\x7f", "\\\\", gsub("\\\\n", "\n", gsub("\\\\\"", "\"", gsub("\\\\\\\\", "\x7f", substr(token, 2, nchar(token)-1))))) } else if (substr(token,1,1) == "\"") { throw("expected '\"', got EOF") } else if (substr(token,1,1) == ":") { new.keyword(substring(token,2)) } else if (token == "nil") { nil } else if (token == "true") { TRUE } else if (token == "false") { FALSE } else { new.symbol(token) } } read_seq <- function(rdr, start="(", end=")") { lst <- list() token <- Reader.next(rdr) if (token != start) { throw(concat("expected '", start, "'")) } repeat { token <- Reader.peek(rdr) if (is.null(token)) { throw(concat("expected '", end, "', got EOF")) } if (token == end) break lst[[length(lst)+1]] <- read_form(rdr) } Reader.next(rdr) new.listl(lst) } read_form <- function(rdr) { token <- Reader.peek(rdr) if (token == "'") { . <- Reader.next(rdr); new.list(new.symbol("quote"), read_form(rdr)) } else if (token == "`") { . <- Reader.next(rdr); new.list(new.symbol("quasiquote"), read_form(rdr)) } else if (token == "~") { . <- Reader.next(rdr); new.list(new.symbol("unquote"), read_form(rdr)) } else if (token == "~@") { . <- Reader.next(rdr); new.list(new.symbol("splice-unquote"), read_form(rdr)) } else if (token == "^") { . <- Reader.next(rdr) m <- read_form(rdr) new.list(new.symbol("with-meta"), read_form(rdr), m) } else if (token == "@") { . <- Reader.next(rdr); new.list(new.symbol("deref"), read_form(rdr)) } else if (token == ")") { throw("unexpected ')'") } else if (token == "(") { new.listl(read_seq(rdr)) } else if (token == "]") { throw("unexpected ']'") } else if (token == "[") { new.vectorl(read_seq(rdr, "[", "]")) } else if (token == "}") { throw("unexpected '}'") } else if (token == "{") { new.hash_mapl(read_seq(rdr, "{", "}")) } else { read_atom(rdr) } } read_str <- function(str) { tokens <- tokenize(str) if (length(tokens) == 0) return(nil) return(read_form(new.Reader(tokens))) } #cat("---\n") #print(tokenize("123")) #cat("---\n") #print(tokenize(" ( 123 456 abc \"def\" ) ")) #rdr <- new.reader(tokenize(" ( 123 456 abc \"def\" ) ")) #Reader.peek(rdr) #Reader.next(rdr) #Reader.next(rdr) #Reader.next(rdr) #Reader.next(rdr) #Reader.next(rdr) #Reader.next(rdr) #Reader.next(rdr) ================================================ FILE: impls/r/readline.r ================================================ ..readline.. <- TRUE HISTORY_FILE = paste(path.expand("~"), "/.mal-history", sep="") library(rdyncall, lib.loc="lib/") #.rllib <- dynfind(c("edit")) .rllib <- dynfind(c("readline")) .call_readline <- .dynsym(.rllib,"readline") .call_add_history <- .dynsym(.rllib,"add_history") .state <- new.env() .state$rl_history_loaded = FALSE .readline <- function(prompt) { res <- .dyncall(.call_readline, "Z)p", prompt) if (is.nullptr(res)) { return(NULL) } else { return(ptr2str(res)) } } readline <- function(prompt) { if (!.state$rl_history_loaded) { .state$rl_history_loaded <- TRUE if (file.access(HISTORY_FILE, 4) == 0) { lines <- scan(HISTORY_FILE, what="", sep="\n", quiet=TRUE) for(add_line in lines) { .dyncall(.call_add_history, "Z)v", add_line) } } } line <- .readline(prompt) if (is.null(line)) return(NULL) .dyncall(.call_add_history, "Z)v", line) if (file.access(HISTORY_FILE, 2) == 0) { write(line, file=HISTORY_FILE, append=TRUE) } line } ================================================ FILE: impls/r/run ================================================ #!/usr/bin/env bash exec Rscript $(dirname $0)/${STEP:-stepA_mal}.r "${@}" ================================================ FILE: impls/r/step0_repl.r ================================================ source("readline.r") READ <- function(str) { return(str) } EVAL <- function(ast, env) { return(ast) } PRINT <- function(exp) { return(exp) } rep <- function(str) { return(PRINT(EVAL(READ(str), ""))) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", err$message,"\n", sep="") }) } ================================================ FILE: impls/r/step1_read_print.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { return(ast) } PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } rep <- function(str) { return(PRINT(EVAL(READ(str), ""))) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step2_eval.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { # cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } # apply list if (length(ast) == 0) { return(ast) } f <- EVAL(ast[[1]], env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) return(do.call(f, args)) } PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } repl_env <- new.env() repl_env[["+"]] <- function(a,b) a+b repl_env[["-"]] <- function(a,b) a-b repl_env[["*"]] <- function(a,b) a*b repl_env[["/"]] <- function(a,b) a/b rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step3_env.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(ast[[3]], env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } return(EVAL(a2, let_env)) } else { f <- EVAL(a0, env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) return(do.call(f, args)) } } PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } repl_env <- new.Env() Env.set(repl_env, "+", function(a,b) a+b) Env.set(repl_env, "-", function(a,b) a-b) Env.set(repl_env, "*", function(a,b) a*b) Env.set(repl_env, "/", function(a,b) a/b) rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step4_if_fn_do.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(ast[[3]], env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } return(EVAL(a2, let_env)) } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) return(EVAL(ast[[length(ast)]], env)) } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) return(EVAL(ast[[4]], env)) } else { return(EVAL(a2, env)) } } else if (a0sym == "fn*") { return(function(...) { EVAL(a2, new.Env(env, a1, list(...))) }) } else { f <- EVAL(a0, env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) return(do.call(f, args)) } } PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step5_tco.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step6_file.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") # read READ <- function(str) { return(read_str(str)) } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } # print PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } # repl loop repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") . <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) . <- rep(concat("(load-file \"", args[[1]], "\")")) quit(save="no", status=0) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step7_quote.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") # read READ <- function(str) { return(read_str(str)) } # eval 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 (.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 { ast } } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "quote") { return(a1) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } # print PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } # repl loop repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") . <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) . <- rep(concat("(load-file \"", args[[1]], "\")")) quit(save="no", status=0) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step8_macros.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") # read READ <- function(str) { return(read_str(str)) } # eval 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 (.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 { ast } } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "quote") { return(a1) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { func <- EVAL(a2, env) func$ismacro = TRUE return(Env.set(env, a1, func)) } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) if (.macro_q(f)) { ast <- fapply(f, slice(ast, 2)) next } args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } # print PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } # repl loop repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") . <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") . <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) . <- rep(concat("(load-file \"", args[[1]], "\")")) quit(save="no", status=0) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/step9_try.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") # read READ <- function(str) { return(read_str(str)) } # eval 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 (.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 { ast } } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "quote") { return(a1) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { func <- EVAL(a2, env) func$ismacro = TRUE return(Env.set(env, a1, func)) } else if (a0sym == "try*") { edata <- new.env() tryCatch({ return(EVAL(a1, env)) }, error=function(err) { edata$exc <- get_error(err) }) if ((!is.null(a2)) && a2[[1]] == "catch*") { return(EVAL(a2[[3]], new.Env(env, new.list(a2[[2]]), new.list(edata$exc)))) } else { throw(edata$exc) } } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) if (.macro_q(f)) { ast <- fapply(f, slice(ast, 2)) next } args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } # print PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } # repl loop repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! not (fn* (a) (if a false true)))") . <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") . <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) tryCatch({ . <- rep(concat("(load-file \"", args[[1]], "\")")) }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) quit(save="no", status=0) } repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", .pr_str(get_error(err),TRUE),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/stepA_mal.r ================================================ if(!exists("..readline..")) source("readline.r") if(!exists("..types..")) source("types.r") if(!exists("..reader..")) source("reader.r") if(!exists("..printer..")) source("printer.r") if(!exists("..env..")) source("env.r") if(!exists("..core..")) source("core.r") # read READ <- function(str) { return(read_str(str)) } # eval 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 (.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 { ast } } EVAL <- function(ast, env) { repeat { dbgevalenv <- Env.find(env, "DEBUG-EVAL") if (!.nil_q(dbgevalenv)) { dbgeval <- Env.get(dbgevalenv, "DEBUG-EVAL") if (!.nil_q(dbgeval) && !identical(dbgeval, FALSE)) cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") } if (.symbol_q(ast)) { return(Env.get(env, ast)) } else if (.list_q(ast)) { # exit this switch } else if (.vector_q(ast)) { return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } return(new.hash_mapl(lst)) } else { return(ast) } if (length(ast) == 0) { return(ast) } # apply list switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) if (length(a0) > 1) a0sym <- "__<*fn*>__" else a0sym <- as.character(a0) if (a0sym == "def!") { res <- EVAL(a2, env) return(Env.set(env, a1, res)) } else if (a0sym == "let*") { let_env <- new.Env(env) for(i in seq(1,length(a1),2)) { Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) } ast <- a2 env <- let_env } else if (a0sym == "quote") { return(a1) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { func <- EVAL(a2, env) func$ismacro = TRUE return(Env.set(env, a1, func)) } else if (a0sym == "try*") { edata <- new.env() tryCatch({ return(EVAL(a1, env)) }, error=function(err) { edata$exc <- get_error(err) }) if ((!is.null(a2)) && a2[[1]] == "catch*") { return(EVAL(a2[[3]], new.Env(env, new.list(a2[[2]]), new.list(edata$exc)))) } else { throw(edata$exc) } } else if (a0sym == "do") { if (2 < length(ast)) for(i in seq(2, length(ast) - 1)) EVAL(ast[[i]], env) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) if (.nil_q(cond) || identical(cond, FALSE)) { if (length(ast) < 4) return(nil) ast <- ast[[4]] } else { ast <- a2 } } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { f <- EVAL(a0, env) if (.macro_q(f)) { ast <- fapply(f, slice(ast, 2)) next } args <- new.listl(lapply(slice(ast, 2), function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast env <- f$gen_env(args) } else { return(do.call(f, args)) } } } } # print PRINT <- function(exp) { return(.pr_str(exp, TRUE)) } # repl loop repl_env <- new.Env() rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) # core.r: defined using R for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } Env.set(repl_env, "eval", function(ast) EVAL(ast, repl_env)) Env.set(repl_env, "*ARGV*", new.list()) # core.mal: defined using the language itself . <- rep("(def! *host-language* \"R\")") . <- rep("(def! not (fn* (a) (if a false true)))") . <- rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") . <- rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") args <- commandArgs(trailingOnly = TRUE) if (length(args) > 0) { Env.set(repl_env, "*ARGV*", new.listl(slice(as.list(args),2))) tryCatch({ . <- rep(concat("(load-file \"", args[[1]], "\")")) }, error=function(err) { cat("Error: ", get_error(err),"\n", sep="") }) quit(save="no", status=0) } . <- rep("(println (str \"Mal [\" *host-language* \"]\"))") repeat { line <- readline("user> ") if (is.null(line)) { cat("\n"); break } tryCatch({ cat(rep(line),"\n", sep="") }, error=function(err) { cat("Error: ", .pr_str(get_error(err),TRUE),"\n", sep="") }) # R debug/fatal with tracebacks: #cat(rep(line),"\n", sep="") } ================================================ FILE: impls/r/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/r/types.r ================================================ ..types.. <- TRUE if(!exists("..env..")) source("env.r") # General type related functions concat <- function(..., sep="") paste(..., collapse="", sep=sep) concatl <- function(lst, sep="") paste(lst, collapse=sep, sep=sep) slice <- function(seq, start=1, end=-1) { if (end == -1) end <- length(seq) if (start > end) lst <- list() else lst <- seq[start:end] switch(class(seq), list={ new.listl(lst) }, List={ new.listl(lst) }, Vector={ new.vectorl(lst) }, { throw("slice called on non-sequence") }) } .sequential_q <- function(obj) .list_q(obj) || .vector_q(obj) .equal_q <- function(a,b) { ota <- class(a); otb <- class(b) if (!((ota == otb) || (.sequential_q(a) && .sequential_q(b)))) { return(FALSE) } switch(ota, "List"={ if (length(a) != length(b)) return(FALSE) if (length(a) == 0) return(TRUE) for(i in seq(length(a))) { if (!.equal_q(a[[i]],b[[i]])) return(FALSE) } TRUE }, "Vector"={ if (length(a) != length(b)) return(FALSE) if (length(a) == 0) return(TRUE) for(i in seq(length(a))) { if (!.equal_q(a[[i]],b[[i]])) return(FALSE) } TRUE }, "HashMap"={ ks1 <- ls(a) ks2 <- ls(b) if (length(ks1) != length(ks2)) return(FALSE) for(k in ks1) { if (!.equal_q(a[[k]],b[[k]])) return(FALSE) } TRUE }, { a == b }) } .clone <- function(obj) { if (.hash_map_q(obj)) { new_obj <- new.env() for(k in ls(obj, all.names=TRUE)) new_obj[[k]] = obj[[k]] class(new_obj) <- "HashMap" } else { new_obj <- obj } new_obj } # Errors/exceptions thrown_error = new.env() thrown_error$val = NULL throw <- function(obj) { thrown_error$val = obj stop("") } get_error <- function(e) { estr <- e$message if (estr == "") { err <- thrown_error$val thrown_error$val <- NULL err } else { estr } } # Scalars nil <- structure("malnil", class="nil") .nil_q <- function(obj) "nil" == class(obj) .true_q <- function(obj) "logical" == class(obj) && obj == TRUE .false_q <- function(obj) "logical" == class(obj) && obj == FALSE .string_q <- function(obj) { "character" == class(obj) && !("\u029e" == substr(obj,1,1) || "" == substring(obj,1,8)) } new.symbol <- function(name) structure(name, class="Symbol") .symbol_q <- function(obj) "Symbol" == class(obj) new.keyword <- function(name) { if (.keyword_q(name)) return (name) concat("\u029e", name) } .keyword_q <- function(obj) { "character" == class(obj) && ("\u029e" == substr(obj,1,1) || "" == substring(obj,1,8)) } .number_q <- function(obj) "numeric" == class(obj) || "integer" == class(obj) # Functions malfunc <- function(eval, ast, env, params) { gen_env <- function(args) new.Env(env, params, args) structure(list(eval=eval, ast=ast, env=env, params=params, gen_env=gen_env, ismacro=FALSE), class="MalFunc") } .malfunc_q <- function(obj) "MalFunc" == class(obj) fapply <- function(mf, args) { if (class(mf) == "MalFunc") { ast <- mf$ast env <- mf$gen_env(args) mf$eval(ast, env) } else { #print(args) do.call(mf,args) } } .fn_q <- function(obj) "function" == class(obj) || (.malfunc_q(obj) && !obj$ismacro) .macro_q <- function(obj) .malfunc_q(obj) && obj$ismacro # Lists new.list <- function(...) new.listl(list(...)) new.listl <- function(lst) { class(lst) <- "List"; lst } .list_q <- function(obj) "List" == class(obj) # Vectors new.vector <- function(...) new.vectorl(list(...)) new.vectorl <- function(lst) { class(lst) <- "Vector"; lst } .vector_q <- function(obj) "Vector" == class(obj) # Hash Maps new.hash_map <- function(...) new.hash_mapl(list(...)) new.hash_mapl <- function(lst) { .assoc(new.env(), lst) } .assoc <- function(src_hm, lst) { hm <- .clone(src_hm) if (length(lst) > 0) { for(i in seq(1,length(lst),2)) { hm[[lst[[i]]]] <- lst[[i+1]] } } class(hm) <- "HashMap" hm } .dissoc <- function(src_hm, lst) { hm <- .clone(src_hm) if (length(lst) > 0) { for(k in lst) { remove(list=c(k), envir=hm) } } ls(hm) class(hm) <- "HashMap" hm } .hash_map_q <- function(obj) "HashMap" == class(obj) # Atoms new.atom <- function(val) { atm <- new.env() class(atm) <- "Atom" atm$val <- .clone(val) atm } .atom_q <- function(obj) "Atom" == class(obj) ================================================ FILE: impls/racket/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Racket RUN apt-get -y install libedit-dev racket ================================================ FILE: impls/racket/Makefile ================================================ SOURCES_BASE = types.rkt reader.rkt printer.rkt SOURCES_LISP = env.rkt core.rkt stepA_mal.rkt SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: dist: mal mal: $(SOURCES) raco exe stepA_mal.rkt mv stepA_mal $@ clean: rm -f mal ================================================ FILE: impls/racket/core.rkt ================================================ #lang racket (provide core_ns) (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt") (define (throw exc) (raise (make-mal-exn "mal exception" (current-continuation-marks) exc))) ;; Sequence functions (define do_apply (lambda a (let* ([f (first a)] [lst (_to_list (last a))] [args (append (take (drop a 1) (- (length a) 2)) lst)]) (apply f args)))) (define conj (lambda a (if (vector? (first a)) (vector-append (first a) (list->vector (rest a))) (append (reverse (rest a)) (first a))))) (define (seq obj) (cond [(_nil? obj) nil] [(_string? obj) (if (eq? 0 (string-length obj)) nil (map string (string->list obj)))] [(_empty? obj) nil] [else (_to_list obj)])) ;; Meta functions (define (meta obj) (cond [(malfunc? obj) (malfunc-meta obj)] [else nil])) (define (with-meta obj m) (cond [(malfunc? obj) (struct-copy malfunc obj [meta m])] [else (raise "metadata not supported on type")])) ;; Atom functions (define swap! (lambda a (let* ([atm (first a)] [f (second a)] [args (cons (atom-val atm) (rest (rest a)))] [val (apply f args)]) (set-atom-val! atm val) val))) (define core_ns (hash '= _equal? 'throw throw 'nil? _nil? 'true? (lambda (x) (eq? x #t)) 'false? (lambda (x) (eq? x #f)) 'number? number? 'symbol (lambda (s) (if (symbol? s) s (string->symbol s))) 'symbol? symbol? 'string? _string? 'keyword (lambda (s) (if (_keyword? s) s (_keyword s))) 'keyword? _keyword? 'fn? (lambda (s) (if (malfunc? s) (not (malfunc-macro? s)) (procedure? s))) 'macro? (lambda (s) (and (malfunc? s) (malfunc-macro? s))) 'pr-str (lambda a (pr_lst a #t " ")) 'str (lambda a (pr_lst a #f "")) 'prn (lambda a (printf "~a~n" (pr_lst a #t " ")) nil) 'println (lambda a (printf "~a~n" (pr_lst a #f " ")) nil) 'read-string (lambda (s) (read_str s)) 'readline readline 'slurp (lambda (f) (port->string (open-input-file f))) '< < '<= <= '> > '>= >= '+ + '- - '* * '/ / 'time-ms (lambda () (round (current-inexact-milliseconds))) 'list list 'list? list? 'vector vector 'vector? vector? 'hash-map hash 'map? hash? 'assoc _assoc 'dissoc _dissoc 'get _get 'contains? dict-has-key? 'keys hash-keys 'vals hash-values '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 'empty? _empty? 'count _count 'apply do_apply 'map (lambda (f s) (_to_list (_map f s))) 'conj conj 'seq seq 'meta meta 'with-meta with-meta 'atom atom 'atom? atom? 'deref (lambda (a) (atom-val a)) 'reset! (lambda (a v) (set-atom-val! a v) v) 'swap! swap!)) ================================================ FILE: impls/racket/env.rkt ================================================ #lang racket (provide Env%) (require "types.rkt") (define Env% (class object% (init outer binds exprs) (super-new) (define _outer outer) (define _binds (_to_list binds)) (define _exprs (_to_list exprs)) (define data (make-hash)) (let ([vargs (member '& _binds)]) (if vargs (begin (map (lambda (b e) (hash-set! data b e)) (drop-right _binds 2) (take _exprs (- (length _binds) 2))) (hash-set! data (last _binds) (drop _exprs (- (length _binds) 2)))) (map (lambda (b e) (hash-set! data b e)) _binds _exprs))) (define/public (set k v) (hash-set! data k v) v) (define/public (get k) (hash-ref data k (lambda () (unless (null? _outer) (send _outer get k))))))) ================================================ FILE: impls/racket/printer.rkt ================================================ #lang racket (provide pr_str pr_lst) (require "types.rkt") (define (pr_str obj print_readably) (let ([_r print_readably]) (cond [(list? obj) (string-join (map (lambda (o) (pr_str o _r)) obj) " " #:before-first "(" #:after-last ")")] [(vector? obj) (string-join (map (lambda (o) (pr_str o _r)) (vector->list obj)) " " #:before-first "[" #:after-last "]")] [(hash? obj) (string-join (dict-map obj (lambda (k v) (format "~a ~a" (pr_str k _r) (pr_str v _r)))) " " #:before-first "{" #:after-last "}")] [(string? obj) (if (regexp-match #px"^\u029e" obj) (format ":~a" (substring obj 1)) (if _r (format "\"~a\"" (string-replace (string-replace (string-replace obj "\\" "\\\\") "\"" "\\\"") "\n" "\\n")) obj))] [(number? obj) (number->string obj)] [(symbol? obj) (symbol->string obj)] [(atom? obj) (format "(atom ~a)" (atom-val obj))] [(_nil? obj) "nil"] [(eq? #t obj) "true"] [(eq? #f obj) "false"] [else (format "~a" obj)]))) (define (pr_lst lst print_readably sep) (string-join (map (lambda (s) (pr_str s print_readably)) lst) sep)) ================================================ FILE: impls/racket/reader.rkt ================================================ #lang racket (provide read_str) (require "types.rkt") (define Reader% (class object% (init tokens) (super-new) (define toks tokens) (define position 0) (define/public (next) (cond [(>= position (length toks)) null] [else (begin (set! position (+ 1 position)) (list-ref toks (- position 1)))])) (define/public (peek) (cond [(>= position (length toks)) null] [else (list-ref toks position )])))) (define (tokenize str) (filter-not (lambda (s) (or (equal? s "") (equal? (substring s 0 1) ";"))) (regexp-match* #px"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)" str #:match-select cadr))) (define (read_atom rdr) (let ([token (send rdr next)]) (cond [(regexp-match #px"^-?[0-9]+$" token) (string->number token)] [(regexp-match #px"^-?[0-9][0-9.]*$" token) (string->number token)] [(regexp-match #px"^\"(?:\\\\.|[^\\\\\"])*\"$" token) (with-input-from-string token read)] [(regexp-match #px"^\".*$" token) (raise "expected '\"', got EOF")] [(regexp-match #px"^:" token) (_keyword (substring token 1))] [(equal? "nil" token) nil] [(equal? "true" token) #t] [(equal? "false" token) #f] [else (string->symbol token)]))) (define (read_list_entries rdr end) (let ([tok (send rdr peek)]) (cond [(eq? tok '()) (raise (string-append "expected '" end "', got EOF"))] [(equal? end tok) '()] [else (cons (read_form rdr) (read_list_entries rdr end))]))) (define (read_list rdr start end) (let ([token (send rdr next)]) (if (equal? start token) (let ([lst (read_list_entries rdr end)]) (send rdr next) lst) (raise (string-append "expected '" start "', got EOF"))))) (define (read_form rdr) (let ([token (send rdr peek)]) (if (null? token) (raise (make-blank-exn "blank line" (current-continuation-marks))) (cond [(equal? "'" token) (send rdr next) (list 'quote (read_form rdr))] [(equal? "`" token) (send rdr next) (list 'quasiquote (read_form rdr))] [(equal? "~" token) (send rdr next) (list 'unquote (read_form rdr))] [(equal? "~@" token) (send rdr next) (list 'splice-unquote (read_form rdr))] [(equal? "^" token) (send rdr next) (let ([meta (read_form rdr)]) (list 'with-meta (read_form rdr) meta))] [(equal? "@" token) (send rdr next) (list 'deref (read_form rdr))] [(equal? ")" token) (raise "unexpected ')'")] [(equal? "(" token) (read_list rdr "(" ")")] [(equal? "]" token) (raise "unexpected ']'")] [(equal? "[" token) (list->vector (read_list rdr "[" "]"))] [(equal? "}" token) (raise "unexpected '}'")] [(equal? "{" token) (apply hash (read_list rdr "{" "}"))] [else (read_atom rdr)])))) (define (read_str str) (read_form (new Reader% [tokens (tokenize str)]))) ================================================ FILE: impls/racket/readline.rkt ================================================ #lang racket (provide readline) (require (prefix-in readline: readline/readline)) (require "types.rkt") (define history-loaded #f) (define HISTORY-FILE (format "~a/.mal-history" (find-system-path 'home-dir))) (define (load-history path) (with-handlers ([exn:fail? (lambda (e) #t)]) (map (lambda (line) (readline:add-history line)) (string-split (port->string (open-input-file path)) #px"\n")))) (define (readline prompt) (when (not history-loaded) (set! history-loaded #t) (load-history HISTORY-FILE)) (let ([line (readline:readline prompt)]) (if (eq? eof line) nil (begin (readline:add-history line) (with-handlers ([exn:fail? (lambda (e) #t)]) (with-output-to-file HISTORY-FILE (lambda () (printf "~a~n" line)) #:exists 'append)) line)))) ================================================ FILE: impls/racket/run ================================================ #!/usr/bin/env bash exec racket $(dirname $0)/${STEP:-stepA_mal}.rkt "${@}" ================================================ FILE: impls/racket/step0_repl.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt") ;; read (define (READ str) str) ;; eval (define (EVAL ast env) ast) ;; print (define (PRINT exp) exp) ;; repl (define (rep str) (PRINT (EVAL (READ str) ""))) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (printf "~a~n" (rep line)) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step1_read_print.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) ast) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define (rep str) (PRINT (EVAL (READ str) ""))) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step2_eval.rkt ================================================ #!/usr/bin/env racket #lang racket (require "types.rkt" "readline.rkt" "reader.rkt" "printer.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) ; (printf "EVAL: ~a~n" (pr_str ast true)) (cond [(symbol? ast) (or (hash-ref env ast (lambda () (raise (string-append "'" (symbol->string ast) "' not found")))))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([f (EVAL (first ast) env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (apply f args)))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (hash '+ + '- - '* * '/ /)) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step3_env.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [else (let ([f (EVAL a0 env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (apply f args))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds '(+ - * /)] [exprs (list + - * /)])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step4_if_fn_do.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) (last (map (lambda (x) (EVAL x env)) (drop ast 1)))] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args])))] [else (let ([f (EVAL a0 env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (apply f args))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step5_tco.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (repl-loop) ================================================ FILE: impls/racket/step6_file.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) (send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (let ([args (current-command-line-arguments)]) (if (> (vector-length args) 0) (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) (repl-loop))) ================================================ FILE: impls/racket/step7_quote.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (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 [(or (symbol? ast) (hash? ast)) (list 'quote ast)] [(vector? ast) (list 'vec (foldr qq-loop null (_to_list ast)))] [(not (list? ast)) ast] [(and (= (length ast) 2) (equal? (car ast) 'unquote)) (cadr ast)] [else (foldr qq-loop null ast)])) (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)] [args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) (send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (let ([args (current-command-line-arguments)]) (if (> (vector-length args) 0) (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) (repl-loop))) ================================================ FILE: impls/racket/step8_macros.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (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 [(or (symbol? ast) (hash? ast)) (list 'quote ast)] [(vector? ast) (list 'vec (foldr qq-loop null (_to_list ast)))] [(not (list? ast)) ast] [(and (= (length ast) 2) (equal? (car ast) 'unquote)) (cadr ast)] [else (foldr qq-loop null ast)])) (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) (let* ([func (EVAL (_nth ast 2) env)] [mac (struct-copy malfunc func [macro? #t])]) (send env set (_nth ast 1) mac))] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)]) (if (and (malfunc? f) (malfunc-macro? f)) (EVAL (apply f (rest ast)) env) (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) (send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (let ([args (current-command-line-arguments)]) (if (> (vector-length args) 0) (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) (repl-loop))) ================================================ FILE: impls/racket/step9_try.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (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 [(or (symbol? ast) (hash? ast)) (list 'quote ast)] [(vector? ast) (list 'vec (foldr qq-loop null (_to_list ast)))] [(not (list? ast)) ast] [(and (= (length ast) 2) (equal? (car ast) 'unquote)) (cadr ast)] [else (foldr qq-loop null ast)])) (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) (let* ([func (EVAL (_nth ast 2) env)] [mac (struct-copy malfunc func [macro? #t])]) (send env set (_nth ast 1) mac))] [(eq? 'try* a0) (if (or (< (length ast) 3) (not (eq? 'catch* (_nth (_nth ast 2) 0)))) (EVAL (_nth ast 1) env) (let ([efn (lambda (exc) (EVAL (_nth (_nth ast 2) 2) (new Env% [outer env] [binds (list (_nth (_nth ast 2) 1))] [exprs (list exc)])))]) (with-handlers ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] [string? (lambda (exc) (efn exc))] [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) (EVAL (_nth ast 1) env))))] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)]) (if (and (malfunc? f) (malfunc-macro? f)) (EVAL (apply f (rest ast)) env) (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) (send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [mal-exn? (lambda (exc) (printf "Error: ~a~n" (pr_str (mal-exn-val exc) true)))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (let ([args (current-command-line-arguments)]) (if (> (vector-length args) 0) (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")"))) (repl-loop))) ================================================ FILE: impls/racket/stepA_mal.rkt ================================================ #!/usr/bin/env racket #lang racket (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" "env.rkt" "core.rkt") ;; read (define (READ str) (read_str str)) ;; eval (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 [(or (symbol? ast) (hash? ast)) (list 'quote ast)] [(vector? ast) (list 'vec (foldr qq-loop null (_to_list ast)))] [(not (list? ast)) ast] [(and (= (length ast) 2) (equal? (car ast) 'unquote)) (cadr ast)] [else (foldr qq-loop null ast)])) (define (EVAL ast env) (let ([dbgeval (send env get 'DEBUG-EVAL)]) (unless (or (void? dbgeval) (eq? dbgeval nil) (eq? dbgeval #f)) (printf "EVAL: ~a~n" (pr_str ast true)))) (cond [(symbol? ast) (let ([val (send env get ast)]) (if (void? val) (raise (string-append "'" (symbol->string ast) "' not found")) val))] [(vector? ast) (vector-map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] [(list? ast) (if (empty? ast) ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] [(eq? 'let* a0) (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) (_map (lambda (b_e) (send let-env set (_first b_e) (EVAL (_nth b_e 1) let-env))) (_partition 2 (_to_list (_nth ast 1)))) (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) (let* ([func (EVAL (_nth ast 2) env)] [mac (struct-copy malfunc func [macro? #t])]) (send env set (_nth ast 1) mac))] [(eq? 'try* a0) (if (or (< (length ast) 3) (not (eq? 'catch* (_nth (_nth ast 2) 0)))) (EVAL (_nth ast 1) env) (let ([efn (lambda (exc) (EVAL (_nth (_nth ast 2) 2) (new Env% [outer env] [binds (list (_nth (_nth ast 2) 1))] [exprs (list exc)])))]) (with-handlers ([mal-exn? (lambda (exc) (efn (mal-exn-val exc)))] [string? (lambda (exc) (efn exc))] [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) (EVAL (_nth ast 1) env))))] [(eq? 'do a0) (map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) (if (or (eq? cnd nil) (eq? cnd #f)) (if (> (length ast) 3) (EVAL (_nth ast 3) env) nil) (EVAL (_nth ast 2) env)))] [(eq? 'fn* a0) (malfunc (lambda args (EVAL (_nth ast 2) (new Env% [outer env] [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] [else (let ([f (EVAL a0 env)]) (if (and (malfunc? f) (malfunc-macro? f)) (EVAL (apply f (rest ast)) env) (let ([args (map (lambda (x) (EVAL x env)) (rest ast))]) (if (malfunc? f) (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] [exprs args])) (apply f args)))))])))] [else ast])) ;; print (define (PRINT exp) (pr_str exp true)) ;; repl (define repl-env (new Env% [outer null] [binds null] [exprs null])) (define (rep str) (PRINT (EVAL (READ str) repl-env))) (for () ;; ignore return values ;; core.rkt: defined using Racket (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) (send repl-env set 'eval (lambda [ast] (EVAL ast repl-env))) (send repl-env set '*ARGV* (_rest (current-command-line-arguments))) ;; core.mal: defined using the language itself (rep "(def! *host-language* \"racket\")") (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") ) (define (repl-loop) (let ([line (readline "user> ")]) (when (not (eq? nil line)) (with-handlers ([string? (lambda (exc) (printf "Error: ~a~n" exc))] [mal-exn? (lambda (exc) (printf "Error: ~a~n" (pr_str (mal-exn-val exc) true)))] [blank-exn? (lambda (exc) null)]) (printf "~a~n" (rep line))) (repl-loop)))) (let ([args (current-command-line-arguments)]) (if (> (vector-length args) 0) (begin (send repl-env set '*ARGV* (vector->list (vector-drop args 1))) (for () (rep (string-append "(load-file \"" (vector-ref args 0) "\")")))) (begin (rep "(println (str \"Mal [\" *host-language* \"]\"))") (repl-loop)))) ================================================ FILE: impls/racket/tests/step5_tco.mal ================================================ ;; Racket: skipping non-TCO recursion ;; Reason: completes up to 1,000,000 ================================================ FILE: impls/racket/types.rkt ================================================ #lang racket (provide blank-exn? make-blank-exn mal-exn? make-mal-exn mal-exn-val malfunc malfunc? malfunc-fn malfunc-ast malfunc-env malfunc-params malfunc-macro? malfunc-meta _partition _equal? _printf nil _nil? _keyword _keyword? _string? _to_list _sequential? _count _empty? _nth _first _rest _map _assoc _dissoc _get atom atom? atom-val set-atom-val!) (define-struct (blank-exn exn:fail:user) ()) (define-struct (mal-exn exn:fail:user) [val]) (define nil% (class object% (super-new))) (define nil (new nil%)) (define (_nil? obj) (eq? nil obj)) (struct malfunc [fn ast env params macro? meta] #:property prop:procedure (struct-field-index fn)) ;; General functions ;; From: http://stackoverflow.com/questions/8725832/how-to-split-list-into-evenly-sized-chunks-in-racket-scheme/8731622#8731622 (define (_partition n xs) (if (null? xs) '() (let ((first-chunk (take xs n)) (rest (drop xs n))) (cons first-chunk (_partition n rest))))) (define (_equal_seqs? seq_a seq_b) (let ([a (_to_list seq_a)] [b (_to_list seq_b)]) (and (= (length a) (length b)) (andmap (lambda (va vb) (_equal? va vb)) a b)))) (define (_equal_hashes? a b) (if (= (hash-count a) (hash-count b)) (let ([keys (hash-keys a)]) (andmap (lambda (k) (_equal? (_get a k) (_get b k))) keys)) #f)) (define (_equal? a b) (cond [(and (_sequential? a) (_sequential? b)) (_equal_seqs? a b)] [(and (hash? a) (hash? b)) (_equal_hashes? a b)] [else (equal? a b)])) ;; printf with flush (define _printf (lambda a (apply printf a) (flush-output))) ;; Keywords (define (_keyword str) (string-append "\u029e" str)) (define (_keyword? k) (and (string? k) (regexp-match? #px"^\u029e" k))) ;; Strings (define (_string? s) (and (string? s) (not (_keyword? s)))) ;; Lists and vectors (define (_to_list a) (if (vector? a) (vector->list a) a)) (define (_sequential? seq) (or (vector? seq) (list? seq))) (define (_count seq) (cond [(_nil? seq) 0] [(vector? seq) (vector-length seq)] [else (length seq)])) (define (_empty? seq) (eq? 0 (_count seq))) (define (_nth seq idx) (cond [(>= idx (_count seq)) (raise "nth: index out of range")] [(vector? seq) (vector-ref seq idx)] [else (list-ref seq idx)])) (define (_first seq) (cond [(vector? seq) (if (_empty? seq) nil (vector-ref seq 0))] [else (if (_empty? seq) nil (list-ref seq 0))])) (define (_rest seq) (cond [(vector? seq) (if (_empty? seq) '() (rest (vector->list seq)))] [else (if (_empty? seq) '() (rest seq))])) (define (_map f seq) (cond [(vector? seq) (vector-map f seq)] [else (map f seq)])) ;; Hash maps (define _assoc (lambda args (let ([new-hm (hash-copy (first args))] [pairs (_partition 2 (rest args))]) (map (lambda (k_v) (hash-set! new-hm (first k_v) (second k_v))) pairs) new-hm))) (define _dissoc (lambda args (let ([new-hm (hash-copy (first args))]) (map (lambda (k) (hash-remove! new-hm k)) (rest args)) new-hm))) (define (_get hm k) (cond [(_nil? hm) nil] [(dict-has-key? hm k) (hash-ref hm k)] [else nil])) ;; Atoms (struct atom [val] #:mutable) ================================================ FILE: impls/rexx/.gitignore ================================================ *.rexxpp ================================================ FILE: impls/rexx/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install cpp regina-rexx ENV HOME /mal ================================================ FILE: impls/rexx/Makefile ================================================ SRCS = step0_repl.rexx step1_read_print.rexx step2_eval.rexx step3_env.rexx \ step4_if_fn_do.rexx step5_tco.rexx step6_file.rexx step7_quote.rexx \ step8_macros.rexx step9_try.rexx stepA_mal.rexx PREPROCESSED = $(SRCS:%.rexx=%.rexxpp) all: $(PREPROCESSED) dist dist: mal mal: mal.rexxpp echo "#!/usr/bin/rexx -a" > $@ cat $< >> $@ chmod +x $@ mal.rexxpp: stepA_mal.rexxpp cp -a $+ $@ $(PREPROCESSED): %.rexxpp: %.rexx readline.rexx types.rexx reader.rexx printer.rexx env.rexx core.rexx cpp -CC -P -nostdinc $< > $@ clean: rm -f mal.rexx mal *.rexxpp .PHONY: all dist clean ================================================ FILE: impls/rexx/core.rexx ================================================ #ifndef __core__ #define __core__ #include "types.rexx" mal_equal?: procedure expose values. /* mal_equal?(a, b) */ return new_boolean(equal?(arg(1), arg(2))) mal_throw: procedure expose values. err /* mal_throw(a) */ err = "__MAL_EXCEPTION__" arg(1) return "ERR" mal_nil?: procedure expose values. /* mal_nil?(a) */ return new_boolean(nil?(arg(1))) mal_true?: procedure expose values. /* mal_true?(a) */ return new_boolean(true?(arg(1))) mal_false?: procedure expose values. /* mal_false?(a) */ return new_boolean(false?(arg(1))) mal_string?: procedure expose values. /* mal_string?(a) */ return new_boolean(string?(arg(1))) mal_symbol: procedure expose values. /* mal_symbol(a) */ return new_symbol(obj_val(arg(1))) mal_symbol?: procedure expose values. /* mal_symbol?(a) */ return new_boolean(symbol?(arg(1))) mal_keyword: procedure expose values. /* mal_keyword(a) */ return new_keyword(obj_val(arg(1))) mal_keyword?: procedure expose values. /* mal_keyword?(a) */ return new_boolean(keyword?(arg(1))) mal_number?: procedure expose values. /* mal_number?(a) */ return new_boolean(number?(arg(1))) mal_fn?: procedure expose values. /* mal_fn?(a) */ return new_boolean(nativefn?(arg(1)) | (func?(arg(1)) & (func_is_macro(arg(1)) \= 1))) mal_macro?: procedure expose values. /* mal_macro?(a) */ return new_boolean(func_macro?(arg(1))) mal_pr_str: procedure expose values. /* mal_pr_str(...) */ res = "" do i=1 to arg() element = pr_str(arg(i), 1) if i == 1 then res = element else res = res || " " || element end return new_string(res) mal_str: procedure expose values. /* mal_str(...) */ res = "" do i=1 to arg() element = pr_str(arg(i), 0) if i == 1 then res = element else res = res || element end return new_string(res) mal_prn: procedure expose values. /* mal_prn(...) */ res = "" do i=1 to arg() element = pr_str(arg(i), 1) if i == 1 then res = element else res = res || " " || element end say res return new_nil() mal_println: procedure expose values. /* mal_println(...) */ res = "" do i=1 to arg() element = pr_str(arg(i), 0) if i == 1 then res = element else res = res || " " || element end say res return new_nil() mal_read_string: procedure expose values. err /* mal_read_string(str) */ return read_str(obj_val(arg(1))) mal_readline: procedure expose values. /* mal_readline(prompt) */ line = readline(obj_val(arg(1))) if length(line) > 0 then return new_string(line) if lines() > 0 then return new_string("") return new_nil() mal_slurp: procedure expose values. /* mal_read_string(filename) */ file_content = charin(obj_val(arg(1)), 1, 100000) return new_string(file_content) mal_lt: procedure expose values. /* mal_lt(a, b) */ return new_boolean(obj_val(arg(1)) < obj_val(arg(2))) mal_lte: procedure expose values. /* mal_lte(a, b) */ return new_boolean(obj_val(arg(1)) <= obj_val(arg(2))) mal_gt: procedure expose values. /* mal_gt(a, b) */ return new_boolean(obj_val(arg(1)) > obj_val(arg(2))) mal_gte: procedure expose values. /* mal_gte(a, b) */ return new_boolean(obj_val(arg(1)) >= obj_val(arg(2))) mal_add: procedure expose values. /* mal_add(a, b) */ return new_number(obj_val(arg(1)) + obj_val(arg(2))) mal_sub: procedure expose values. /* mal_sub(a, b) */ return new_number(obj_val(arg(1)) - obj_val(arg(2))) mal_mul: procedure expose values. /* mal_mul(a, b) */ return new_number(obj_val(arg(1)) * obj_val(arg(2))) mal_div: procedure expose values. /* mal_div(a, b) */ return new_number(obj_val(arg(1)) / obj_val(arg(2))) mal_time_ms: procedure expose values. /* mal_time_ms() */ return new_number(trunc(time('E') * 1000)) mal_list: procedure expose values. /* mal_list(...) */ res = "" do i=1 to arg() if i == 1 then res = arg(i) else res = res || " " || arg(i) end return new_list(res) mal_list?: procedure expose values. /* mal_list?(a) */ return new_boolean(list?(arg(1))) mal_vector: procedure expose values. /* mal_vector(...) */ res = "" do i=1 to arg() if i == 1 then res = arg(i) else res = res || " " || arg(i) end return new_vector(res) mal_vector?: procedure expose values. /* mal_vector?(a) */ return new_boolean(vector?(arg(1))) mal_hash_map: procedure expose values. /* mal_hash_map(...) */ res = "" do i=1 to arg() if i == 1 then res = arg(i) else res = res || " " || arg(i) end return new_hashmap(res) mal_map?: procedure expose values. /* mal_map?(a) */ return new_boolean(hashmap?(arg(1))) mal_assoc: procedure expose values. /* mal_assoc(a, ...) */ hm = arg(1) res = "" do i=2 to arg() by 2 key_val = arg(i) || " " || arg(i + 1) if res == 2 then res = key_val else res = res || " " || key_val end hm_val = obj_val(hm) do i=1 to words(hm_val) by 2 if \contains?(res, word(hm_val, i)) then res = res || " " || word(hm_val, i) || " " || word(hm_val, i + 1) end return new_hashmap(res) mal_dissoc: procedure expose values. /* mal_dissoc(a, ...) */ hm = arg(1) res = "" hm_val = obj_val(hm) do i=1 to words(hm_val) by 2 key = word(hm_val, i) found = 0 do j=2 to arg() if equal?(key, arg(j)) then do found = 1 leave end end if \found then do if length(res) > 0 then res = res || " " res = res || key || " " || word(hm_val, i + 1) end end return new_hashmap(res) mal_get: procedure expose values. /* mal_get(a, b) */ res = hashmap_get(obj_val(arg(1)), arg(2)) if res == "" then return new_nil() else return res mal_contains?: procedure expose values. /* mal_contains?(a, b) */ return new_boolean(contains?(obj_val(arg(1)), arg(2))) mal_keys: procedure expose values. /* mal_keys(a) */ hm_val = obj_val(arg(1)) seq = "" do i=1 to words(hm_val) by 2 if i == 1 then seq = word(hm_val, i) else seq = seq || " " || word(hm_val, i) end return new_list(seq) mal_vals: procedure expose values. /* mal_vals(a) */ hm_val = obj_val(arg(1)) seq = "" do i=2 to words(hm_val) by 2 if i == 1 then seq = word(hm_val, i) else seq = seq || " " || word(hm_val, i) end return new_list(seq) mal_sequential?: procedure expose values. /* mal_sequential?(a) */ return new_boolean(sequential?(arg(1))) mal_cons: procedure expose values. /* mal_cons(a, b) */ return new_list(arg(1) || " " || obj_val(arg(2))) mal_concat: procedure expose values. /* mal_concat(...) */ seq = "" do i=1 to arg() if i == 1 then seq = obj_val(arg(i)) else seq = seq || " " || obj_val(arg(i)) 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)) if i >= words(list_val) then do err = "nth: index out of range" return "ERR" end return word(list_val, i + 1) mal_first: procedure expose values. /* mal_first(a) */ if nil?(arg(1)) then return new_nil() list_val = obj_val(arg(1)) if words(list_val) == 0 then return new_nil() return word(list_val, 1) mal_rest: procedure expose values. /* mal_rest(a) */ return new_list(subword(obj_val(arg(1)), 2)) mal_empty?: procedure expose values. /* mal_empty?(a) */ if nil?(arg(1)) then return new_true() return new_boolean(count_elements(arg(1)) == 0) mal_count: procedure expose values. /* mal_count(a) */ if nil?(arg(1)) then return new_number(0) return new_number(count_elements(arg(1))) apply_function: procedure expose values. env. err /* apply_function(fn, lst) */ f = arg(1) call_args = arg(2) select when nativefn?(f) then do call_args_val = obj_val(call_args) call_list = "" do i=1 to words(call_args_val) element = '"' || word(call_args_val, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do apply_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) return eval(func_body_ast(f), apply_env_idx) end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end mal_apply: procedure expose values. env. err /* mal_apply(fn, ..., lst) */ fn = arg(1) seq = "" do i=2 to (arg() - 1) if i == 2 then seq = arg(i) else seq = seq || " " || arg(i) end if arg() > 1 then do seq = seq || " " || obj_val(arg(arg())) end return apply_function(fn, new_list(seq)) mal_map: procedure expose values. env. err /* mal_map(f, lst) */ fn = arg(1) lst_val = obj_val(arg(2)) res = "" do i=1 to words(lst_val) element = word(lst_val, i) mapped_element = apply_function(fn, new_list(element)) if mapped_element == "ERR" then return "ERR" if i == 1 then res = mapped_element else res = res || " " || mapped_element end return new_list(res) mal_conj: procedure expose values. env. err /* mal_conj(a, ...) */ a = arg(1) select when list?(a) then do do i=2 to arg() a = mal_cons(arg(i), a) end return a end when vector?(a) then do seq = obj_val(a) do i=2 to arg() if length(seq) > 0 then seq = seq || " " seq = seq || arg(i) end return new_vector(seq) end otherwise err = "conj requires list or vector" return "ERR" end mal_seq: procedure expose values. env. err /* mal_conj(a) */ a = arg(1) select when string?(a) then do str = obj_val(a) if length(str) == 0 then return new_nil() seq = "" do i=1 to length(str) element = new_string(substr(str, i, 1)) if i == 1 then seq = element else seq = seq || " " || element end return new_list(seq) end when list?(a) then do if count_elements(a) == 0 then return new_nil() return a end when vector?(a) then do if count_elements(a) == 0 then return new_nil() return new_list(obj_val(a)) end when nil?(a) then return new_nil() otherwise err = "seq requires string or list or vector or nil" return "ERR" end mal_with_meta: procedure expose values. /* mal_with_meta(a, b) */ new_obj = obj_clone_and_set_meta(arg(1), arg(2)) if new_obj == "" then return arg(1) return new_obj mal_meta: procedure expose values. /* mal_meta(a) */ meta = obj_meta(arg(1)) if meta == "" then return new_nil() return meta mal_atom: procedure expose values. /* mal_atom(a) */ return new_atom(arg(1)) mal_atom?: procedure expose values. /* mal_atom?(a) */ return new_boolean(atom?(arg(1))) mal_deref: procedure expose values. /* mal_deref(a) */ return obj_val(arg(1)) mal_reset!: procedure expose values. /* mal_reset!(a, new_val) */ return atom_set(arg(1), arg(2)) mal_swap!: procedure expose values. env. err /* mal_swap!(a, fn, ...) */ atom = arg(1) fn = arg(2) atom_val = obj_val(atom) seq = atom_val do i=3 to arg() seq = seq || " " || arg(i) end new_val = apply_function(fn, new_list(seq)) if new_val == "ERR" then return "ERR" return atom_set(atom, new_val) mal_rexx_eval: procedure expose values. /* mal_rexx_eval(..., a) */ do i=1 to (arg() - 1) interpret obj_val(arg(i)) end last_arg = arg(arg()) if nil?(last_arg) then return new_nil() last_arg_str = obj_val(last_arg) if length(last_arg_str) == 0 then return new_nil() rexx_eval_res = "" interpret "rexx_eval_res = " || last_arg_str if datatype(rexx_eval_res) == "NUM" then return new_number(rexx_eval_res) else return new_string(rexx_eval_res) get_core_ns: procedure /* get_core_ns() */ return "= mal_equal?" , "throw mal_throw" , , "nil? mal_nil?" , "true? mal_true?" , "false? mal_false?" , "string? mal_string?" , "symbol mal_symbol" , "symbol? mal_symbol?" , "keyword mal_keyword" , "keyword? mal_keyword?" , "number? mal_number?" , "fn? mal_fn?" , "macro? mal_macro?" , , "pr-str mal_pr_str" , "str mal_str" , "prn mal_prn" , "println mal_println" , "read-string mal_read_string" , "readline mal_readline" , "slurp mal_slurp" , , "< mal_lt" , "<= mal_lte" , "> mal_gt" , ">= mal_gte" , "+ mal_add" , "- mal_sub" , "* mal_mul" , "/ mal_div" , "time-ms mal_time_ms" , , "list mal_list" , "list? mal_list?" , "vector mal_vector" , "vector? mal_vector?" , "hash-map mal_hash_map" , "map? mal_map?" , "assoc mal_assoc" , "dissoc mal_dissoc" , "get mal_get" , "contains? mal_contains?" , "keys mal_keys" , "vals mal_vals" , , "sequential? mal_sequential?" , "cons mal_cons" , "concat mal_concat" , "vec mal_vec" , "nth mal_nth" , "first mal_first" , "rest mal_rest" , "empty? mal_empty?" , "count mal_count" , "apply mal_apply" , "map mal_map" , , "conj mal_conj" , "seq mal_seq" , , "meta mal_meta" , "with-meta mal_with_meta" , "atom mal_atom" , "atom? mal_atom?" , "deref mal_deref" , "reset! mal_reset!" , "swap! mal_swap!" , , "rexx-eval mal_rexx_eval" #endif ================================================ FILE: impls/rexx/env.rexx ================================================ #ifndef __env__ #define __env__ env. = "" env.0 = 0 new_env_index: procedure expose env. /* new_env_index() */ env.0 = env.0 + 1 return env.0 new_env: procedure expose env. values. /* new_env(outer_env_idx [, binds, exprs]) */ outer_env_idx = arg(1) binds = arg(2) exprs = arg(3) idx = new_env_index() env.idx.outer = outer_env_idx env.idx.data. = "" if binds \= "" then do binds_val = obj_val(binds) exprs_val = obj_val(exprs) do i=1 to words(binds_val) varname = obj_val(word(binds_val, i)) if varname == "&" then do rest_args_list = new_list(subword(exprs_val, i)) varname = obj_val(word(binds_val, i + 1)) x = env_set(idx, varname, rest_args_list) leave end else x = env_set(idx, varname, word(exprs_val, i)) end end return idx env_set: procedure expose env. /* env_set(env_idx, key, val) */ env_idx = arg(1) key = arg(2) val = arg(3) env.env_idx.data.key = val return val env_find: procedure expose env. /* env_find(env_idx, key) */ env_idx = arg(1) key = arg(2) if env.env_idx.data.key \= "" then return env_idx if env.env_idx.outer > 0 then return env_find(env.env_idx.outer, key) return 0 env_get: procedure expose env. err /* env_get(env_idx, key) */ env_idx = arg(1) key = arg(2) found_env_idx = env_find(env_idx, key) if found_env_idx == 0 then do err = "'" || key || "' not found" return "ERR" end return env.found_env_idx.data.key #endif ================================================ FILE: impls/rexx/printer.rexx ================================================ #ifndef __printer__ #define __printer__ #include "types.rexx" format_string: procedure /* format_string(str, readable) */ str = arg(1) readable = arg(2) if readable then do res = changestr('5C'x, str, "\\") res = changestr('"', res, '\"') res = changestr('0A'x, res, "\n") return '"' || res || '"' end else return str format_sequence: procedure expose values. /* format_sequence(val, open_char, close_char, readable) */ val = arg(1) open_char = arg(2) close_char = arg(3) readable = arg(4) res = "" do i=1 to words(val) element = word(val, i) if i > 1 then res = res || " " res = res || pr_str(element, readable) end return open_char || res || close_char pr_str: procedure expose values. /* pr_str(ast, readable) */ ast = arg(1) readable = arg(2) type = obj_type(ast) val = obj_val(ast) select when type == "nill" then return "nil" when type == "true" then return "true" when type == "fals" then return "false" when type == "numb" then return val when type == "symb" then return val when type == "stri" then return format_string(val, readable) when type == "keyw" then return ":" || val when type == "list" then return format_sequence(val, "(", ")", readable) when type == "vect" then return format_sequence(val, "[", "]", readable) when type == "hash" then return format_sequence(val, "{", "}", readable) when type == "nafn" then return "#" when type == "func" then return "#" when type == "atom" then return "(atom " || pr_str(val, readable) || ")" otherwise return "#" end #endif ================================================ FILE: impls/rexx/reader.rexx ================================================ #ifndef __reader__ #define __reader__ #include "types.rexx" next_token: procedure expose pos /* next_token(str) */ TAB = '09'x LF = '0A'x CR = '0D'x SEPARATOR_CHARS = TAB || LF || CR || " []{}()'`,;" || '"' WHITESPACE_CHARS = TAB || LF || CR || " ," str = arg(1) token = "" ch = substr(str, pos, 1) select when pos(ch, WHITESPACE_CHARS) > 0 then pos = pos + 1 when pos(ch, "[]{}()'`^@") > 0 then do pos = pos + 1 token = ch end when ch == '~' then do if substr(str, pos + 1, 1) == '@' then do pos = pos + 2 token = "~@" end else do pos = pos + 1 token = "~" end end when ch == ";" then do do while pos <= length(str) ch = substr(str, pos, 1) if (ch == LF) | (ch == CR) then leave else pos = pos + 1 end end when ch == '"' then do tmppos = pos + 1 do while tmppos < length(str) ch = substr(str, tmppos, 1) select when ch == '"' then leave when ch == '5C'x then /* backslash */ tmppos = tmppos + 2 otherwise tmppos = tmppos + 1 end end token = substr(str, pos, tmppos - pos + 1) pos = tmppos + 1 end otherwise tmppos = pos do while tmppos <= length(str) ch = substr(str, tmppos, 1) if pos(ch, SEPARATOR_CHARS) > 0 then leave else token = token || ch tmppos = tmppos + 1 end pos = tmppos end return token tokenize: procedure expose tokens. /* tokenize(str) */ str = arg(1) tokens. = "" num_of_tokens = 0 str_to_tokenize = str pos = 1 do while pos <= length(str) token = next_token(str_to_tokenize) if length(token) > 0 then do num_of_tokens = num_of_tokens + 1 tokens.num_of_tokens = token end end tokens.0 = num_of_tokens return num_of_tokens is_number: procedure /* is_number(token) */ token = arg(1) ch = substr(token, 1, 1) DIGITS = "0123456789" if pos(ch, DIGITS) > 0 then return 1 if (ch == '-') & (pos(substr(token, 2, 1), DIGITS) > 0) then return 1 return 0 parse_string: procedure /* parse_string(token) */ token = arg(1) res = substr(token, 2, length(token) - 2) /* Remove quotes */ res = changestr("\\", res, '01'x) res = changestr("\n", res, '0A'x) res = changestr('\"', res, '"') res = changestr('01'x, res, '5C'x) return res parse_keyword: procedure /* parse_keyword(token) */ token = arg(1) return substr(token, 2) /* Remove initial ":" */ read_atom: procedure expose values. tokens. pos err /* read_atom() */ token = tokens.pos pos = pos + 1 select when is_number(token) then return new_number(token) when token == "nil" then return new_nil() when token == "true" then return new_true() when token == "false" then return new_false() when substr(token, 1, 1) == ':' then return new_keyword(parse_keyword(token)) when substr(token, 1, 1) == '"' then do if substr(token, length(token), 1) \== '"' then do end_char = '"' err = "expected '" || end_char || "', got EOF" return "ERR" end return new_string(parse_string(token)) end otherwise return new_symbol(token) end read_sequence: procedure expose values. tokens. pos err /* read_sequence(type, end_char) */ type = arg(1) end_char = arg(2) pos = pos + 1 /* Consume the open paren */ token = tokens.pos seq = "" do while (pos <= tokens.0) & (token \== end_char) element = read_form() if element == "ERR" then return "ERR" if seq == "" then seq = element else seq = seq || " " || element token = tokens.pos if token == "" then do err = "expected '" || end_char || "', got EOF" return "ERR" end end pos = pos + 1 /* Consume the close paren */ return new_seq(type, seq) reader_macro: procedure expose values. tokens. pos /* reader_macro(symbol) */ symbol = arg(1) pos = pos + 1 /* Consume the macro token */ element = read_form() if element == "ERR" then return "ERR" seq = new_symbol(symbol) || " " || element return new_list(seq) reader_with_meta_macro: procedure expose values. tokens. pos /* reader_with_meta_macro() */ pos = pos + 1 /* Consume the macro token */ meta = read_form() if meta == "ERR" then return "ERR" element = read_form() if element == "ERR" then return "ERR" seq = new_symbol("with-meta") || " " || element || " " || meta return new_list(seq) read_form: procedure expose values. tokens. pos err /* read_form() */ token = tokens.pos select when token == "'" then return reader_macro("quote") when token == '`' then return reader_macro("quasiquote") when token == '~' then return reader_macro("unquote") when token == '~@' then return reader_macro("splice-unquote") when token == '@' then return reader_macro("deref") when token == '^' then return reader_with_meta_macro() when token == '(' then return read_sequence("list", ")") when token == ')' then do err = "unexpected ')'" return "ERR" end when token == '[' then return read_sequence("vect", "]") when token == ']' then do err = "unexpected ']'" return "ERR" end when token == '{' then return read_sequence("hash", "}") when token == '}' then do err = "unexpected '}'" return "ERR" end otherwise return read_atom() end read_str: procedure expose values. err /* read_str(line) */ line = arg(1) tokens. = "" num_of_tokens = tokenize(line) if num_of_tokens == 0 then return "" ast. = "" pos = 1 return read_form() #endif ================================================ FILE: impls/rexx/readline.rexx ================================================ #ifndef __readline__ #define __readline__ readline: procedure /* readline(prompt) */ call charout , arg(1) return linein() #endif ================================================ FILE: impls/rexx/run ================================================ #!/bin/sh exec rexx -a $(dirname $0)/${STEP:-stepA_mal}.rexxpp "${@}" ================================================ FILE: impls/rexx/step0_repl.rexx ================================================ call main exit #include "readline.rexx" read: procedure /* read(str) */ return arg(1) eval: procedure /* eval(exp, env) */ return arg(1) print: procedure /* print(exp) */ return arg(1) rep: procedure /* rep(str) */ return print(eval(read(arg(1), ""))) main: do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then call lineout , rep(input_line) end ================================================ FILE: impls/rexx/step1_read_print.rexx ================================================ call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. /* eval(exp, env) */ return arg(1) print: procedure expose values. /* print(exp) */ return pr_str(arg(1), 1) rep: procedure expose values. env. err /* rep(str) */ ast = read(arg(1)) if ast == "ERR" then return "ERR" exp = eval(ast) return print(exp) main: values. = "" values.0 = 0 do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step2_eval.rexx ================================================ call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. env. err /* eval(ast) */ ast = arg(1) -- call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then do varname = astval if env.varname == "" then do err = "'" || varname || "' not found" return "ERR" end return env.varname end when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || f || "(" || call_list || ")" return res print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) rep: procedure expose values. env. err /* rep(str) */ ast = read(arg(1)) if ast == "ERR" then return "ERR" exp = eval(ast) if exp == "ERR" then return "ERR" return print(exp) mal_add: procedure expose values. /* mal_add(a, b) */ return new_number(obj_val(arg(1)) + obj_val(arg(2))) mal_sub: procedure expose values. /* mal_sub(a, b) */ return new_number(obj_val(arg(1)) - obj_val(arg(2))) mal_mul: procedure expose values. /* mal_mul(a, b) */ return new_number(obj_val(arg(1)) * obj_val(arg(2))) mal_div: procedure expose values. /* mal_div(a, b) */ return new_number(obj_val(arg(1)) / obj_val(arg(2))) main: values. = "" values.0 = 0 env. = "" key = "+" ; env.key = "mal_add" key = "-" ; env.key = "mal_sub" key = "*" ; env.key = "mal_mul" key = "/" ; env.key = "mal_div" err = "" do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step3_env.rexx ================================================ call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end return eval(word(astval, 3), letenv_idx) end otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || f || "(" || call_list || ")" return res end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_add: procedure expose values. /* mal_add(a, b) */ return new_number(obj_val(arg(1)) + obj_val(arg(2))) mal_sub: procedure expose values. /* mal_sub(a, b) */ return new_number(obj_val(arg(1)) - obj_val(arg(2))) mal_mul: procedure expose values. /* mal_mul(a, b) */ return new_number(obj_val(arg(1)) * obj_val(arg(2))) mal_div: procedure expose values. /* mal_div(a, b) */ return new_number(obj_val(arg(1)) / obj_val(arg(2))) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) x = env_set(repl_env_idx, "+", "mal_add") x = env_set(repl_env_idx, "-", "mal_sub") x = env_set(repl_env_idx, "*", "mal_mul") x = env_set(repl_env_idx, "/", "mal_div") err = "" do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step4_if_fn_do.rexx ================================================ call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end return eval(word(astval, 3), letenv_idx) end when a0sym == "do" then do res = "ERR" do i=2 to words(astval) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end return res end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then return eval(word(astval, 4), env_idx) else return new_nil() else return eval(word(astval, 3), env_idx) end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) return eval(func_body_ast(f), new_env(func_env_idx(f), func_binds(f), call_args)) end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") err = "" do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step5_tco.rexx ================================================ call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") err = "" do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step6_file.rexx ================================================ /* Save command-line arguments from the top-level program before entering a procedure */ command_line_args. = "" command_line_args.0 = arg() do i=1 to command_line_args.0 command_line_args.i = arg(i) end call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) eval: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_eval: procedure expose values. env. err /* mal_eval(ast) */ ast = arg(1) if ast == "ERR" then return "ERR" return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ build_args_list: procedure expose values. command_line_args. /* build_args_list() */ seq = "" do i=2 to command_line_args.0 s = new_string(command_line_args.i) if i == 1 then seq = s else seq = seq || " " || s end return new_list(seq) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) x = env_set(repl_env_idx, "*ARGV*", build_args_list()) /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') err = "" if command_line_args.0 > 0 then do x = re('(load-file "' || command_line_args.1 || '")') return end do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step7_quote.rexx ================================================ /* Save command-line arguments from the top-level program before entering a procedure */ command_line_args. = "" command_line_args.0 = arg() do i=1 to command_line_args.0 command_line_args.i = arg(i) end call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) 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) 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: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "quote" then return word(astval, 2) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_eval: procedure expose values. env. err /* mal_eval(ast) */ ast = arg(1) if ast == "ERR" then return "ERR" return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ build_args_list: procedure expose values. command_line_args. /* build_args_list() */ seq = "" do i=2 to command_line_args.0 s = new_string(command_line_args.i) if i == 1 then seq = s else seq = seq || " " || s end return new_list(seq) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) x = env_set(repl_env_idx, "*ARGV*", build_args_list()) /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') err = "" if command_line_args.0 > 0 then do x = re('(load-file "' || command_line_args.1 || '")') return end do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step8_macros.rexx ================================================ /* Save command-line arguments from the top-level program before entering a procedure */ command_line_args. = "" command_line_args.0 = arg() do i=1 to command_line_args.0 command_line_args.i = arg(i) end call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) 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) 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: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "quote" then return word(astval, 2) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ end when a0sym == "defmacro!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, func_mark_as_macro(a2)) end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" if func_macro?(f) then do call_args = mal_rest(ast) mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = eval(func_body_ast(f), mac_env_idx) /* TCO */ end else do -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_eval: procedure expose values. env. err /* mal_eval(ast) */ ast = arg(1) if ast == "ERR" then return "ERR" return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ build_args_list: procedure expose values. command_line_args. /* build_args_list() */ seq = "" do i=2 to command_line_args.0 s = new_string(command_line_args.i) if i == 1 then seq = s else seq = seq || " " || s end return new_list(seq) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) x = env_set(repl_env_idx, "*ARGV*", build_args_list()) /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); err = "" if command_line_args.0 > 0 then do x = re('(load-file "' || command_line_args.1 || '")') return end do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then call lineout , "Error: " || err else call lineout , res end end ================================================ FILE: impls/rexx/step9_try.rexx ================================================ /* Save command-line arguments from the top-level program before entering a procedure */ command_line_args. = "" command_line_args.0 = arg() do i=1 to command_line_args.0 command_line_args.i = arg(i) end call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) 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) 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: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "quote" then return word(astval, 2) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ end when a0sym == "defmacro!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, func_mark_as_macro(a2)) end when a0sym == "try*" then do res = eval(word(astval, 2), env_idx) if words(astval) < 3 then return res if res == "ERR" then do if word(err, 1) == "__MAL_EXCEPTION__" then errobj = word(err, 2) else errobj = new_string(err) catchlst = obj_val(word(astval, 3)) catch_env_idx = new_env(env_idx, new_list(word(catchlst, 2)), new_list(errobj)) err = "" return eval(word(catchlst, 3), catch_env_idx) end else return res end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" if func_macro?(f) then do call_args = mal_rest(ast) mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = eval(func_body_ast(f), mac_env_idx) /* TCO */ end else do -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_eval: procedure expose values. env. err /* mal_eval(ast) */ ast = arg(1) if ast == "ERR" then return "ERR" return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ build_args_list: procedure expose values. command_line_args. /* build_args_list() */ seq = "" do i=2 to command_line_args.0 s = new_string(command_line_args.i) if i == 1 then seq = s else seq = seq || " " || s end return new_list(seq) main: values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) x = env_set(repl_env_idx, "*ARGV*", build_args_list()) /* core.mal: defined using the language itself */ x = re("(def! not (fn* (a) (if a false true)))") x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); err = "" if command_line_args.0 > 0 then do x = re('(load-file "' || command_line_args.1 || '")') return end do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then do if word(err, 1) == "__MAL_EXCEPTION__" then errstr = pr_str(word(err, 2), 0) else errstr = err call lineout , "Error: " || errstr err = "" end else call lineout , res end end ================================================ FILE: impls/rexx/stepA_mal.rexx ================================================ /* Save command-line arguments from the top-level program before entering a procedure */ command_line_args. = "" command_line_args.0 = arg() do i=1 to command_line_args.0 command_line_args.i = arg(i) end call main exit #include "readline.rexx" #include "reader.rexx" #include "printer.rexx" #include "types.rexx" #include "env.rexx" #include "core.rexx" read: procedure expose values. err /* read(str) */ return read_str(arg(1)) 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) 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: procedure expose values. env. err /* eval(ast) */ ast = arg(1) env_idx = arg(2) do forever debug_eval = obj_type(env_get(env_idx, "DEBUG-EVAL")) if debug_eval <> "ERR" & debug_eval <> "nill" & debug_eval <> "fals" then, call lineout , ("EVAL: " || print(ast)) type = obj_type(ast) astval = obj_val(ast) select when type == "symb" then return env_get(env_idx, astval) when type == "list" & words(astval) > 0 then do -- proceed after this select statement end when type == "vect" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_vector(res) end when type == "hash" then do res = "" do i=1 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 1 then res = res || " " || element else res = element end return new_hashmap(res) end otherwise return ast end -- ast is a non-empty list a0 = word(astval, 1) a0sym = obj_val(a0) select when a0sym == "def!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, a2) end when a0sym == "let*" then do a1lst = obj_val(word(astval, 2)) letenv_idx = new_env(env_idx) do i=1 to words(a1lst) by 2 k = obj_val(word(a1lst, i)) v = eval(word(a1lst, i + 1), letenv_idx) if v == "ERR" then return "ERR" unused = env_set(letenv_idx, k, v) end env_idx = letenv_idx ast = word(astval, 3) /* TCO */ end when a0sym == "quote" then return word(astval, 2) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ end when a0sym == "defmacro!" then do a1sym = obj_val(word(astval, 2)) a2 = eval(word(astval, 3), env_idx) if a2 == "ERR" then return "ERR" return env_set(env_idx, a1sym, func_mark_as_macro(a2)) end when a0sym == "try*" then do res = eval(word(astval, 2), env_idx) if words(astval) < 3 then return res if res == "ERR" then do if word(err, 1) == "__MAL_EXCEPTION__" then errobj = word(err, 2) else errobj = new_string(err) catchlst = obj_val(word(astval, 3)) catch_env_idx = new_env(env_idx, new_list(word(catchlst, 2)), new_list(errobj)) err = "" return eval(word(catchlst, 3), catch_env_idx) end else return res end when a0sym == "do" then do do i=2 to (words(astval) - 1) res = eval(word(astval, i), env_idx) if res == "ERR" then return "ERR" end ast = word(astval, words(astval)) /* TCO */ end when a0sym == "if" then do condval = eval(word(astval, 2), env_idx) if false?(condval) | nil?(condval) then if words(astval) >= 4 then ast = word(astval, 4) else return new_nil() else ast = word(astval, 3) /* TCO */ end when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) otherwise f = eval(a0, env_idx) if f == "ERR" then return "ERR" if func_macro?(f) then do call_args = mal_rest(ast) mac_env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = eval(func_body_ast(f), mac_env_idx) /* TCO */ end else do -- Evaluate the arguments and store them to lst. lst = "" do i=2 to words(astval) element = eval(word(astval, i), env_idx) if element == "ERR" then return "ERR" if i > 2 then lst = lst || " " || element else lst = element end select when nativefn?(f) then do call_args = lst call_list = "" do i=1 to words(call_args) element = '"' || word(call_args, i) || '"' if i > 1 then call_list = call_list || ', ' || element else call_list = element end res = "" interpret "res = " || obj_val(f) || "(" || call_list || ")" return res end when func?(f) then do call_args = new_list(lst) env_idx = new_env(func_env_idx(f), func_binds(f), call_args) ast = func_body_ast(f) /* TCO */ end otherwise err = "Unsupported function object type: " || obj_type(f) return "ERR" end end end end print: procedure expose values. /* print(ast) */ return pr_str(arg(1), 1) re: procedure expose values. env. err repl_env_idx /* re(str) */ str = arg(1) ast = read(str) if ast == "ERR" then return "ERR" return eval(ast, repl_env_idx) rep: procedure expose values. env. err repl_env_idx /* rep(str) */ str = arg(1) exp = re(str) if exp == "ERR" then return "ERR" return print(exp) mal_eval: procedure expose values. env. err /* mal_eval(ast) */ ast = arg(1) if ast == "ERR" then return "ERR" return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ build_args_list: procedure expose values. command_line_args. /* build_args_list() */ seq = "" do i=2 to command_line_args.0 s = new_string(command_line_args.i) if i == 1 then seq = s else seq = seq || " " || s end return new_list(seq) main: x = time('R') /* Reset the internal stopwatch; used by `time-ms` */ values. = "" values.0 = 0 env. = "" env.0 = 0 repl_env_idx = new_env(0) /* core.rexx: defined using Rexx */ core_ns = get_core_ns() do i=1 to words(core_ns) by 2 x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) end x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) x = env_set(repl_env_idx, "*ARGV*", build_args_list()) /* core.mal: defined using the language itself */ x = re('(def! *host-language* "rexx")') x = re("(def! not (fn* (a) (if a false true)))") x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') x = re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " || '"' || "odd number of forms to cond" || '"' || ")) (cons 'cond (rest (rest xs)))))))"); err = "" if command_line_args.0 > 0 then do x = re('(load-file "' || command_line_args.1 || '")') return end x = re('(println (str "Mal [" *host-language* "]"))') do while lines() > 0 /* 1 == 1 */ input_line = readline('user> ') if length(input_line) > 0 then do res = rep(input_line) if res == "ERR" then do if word(err, 1) == "__MAL_EXCEPTION__" then errstr = pr_str(word(err, 2), 0) else errstr = err call lineout , "Error: " || errstr err = "" end else call lineout , res end end ================================================ FILE: impls/rexx/tests/step5_tco.mal ================================================ ;; REXX: skipping non-TCO recursion ;; Reason: regina rexx interpreter segfaults (unrecoverable) ================================================ FILE: impls/rexx/tests/stepA_mal.mal ================================================ ;; Testing basic Rexx interop ;; ;; Note that in Rexx "everything is a string". Numeric outputs are converted to ;; Mal numbers. (rexx-eval "3 ** 4") ;=>81 (rexx-eval "words('a bb ' || 'ccc dddd')") ;=>4 (rexx-eval "d2x(254)") ;=>"FE" (rexx-eval "say 'hello' 12.34 upper('rexx')" nil) ;/hello 12.34 REXX ;=>nil (rexx-eval "foo = 8" "foo + 3") ;=>11 (rexx-eval "parse version s1 s2 s3 s4 s5" "'rexx_version=' || s2") ;=>"rexx_version=5.00" ================================================ FILE: impls/rexx/types.rexx ================================================ #ifndef __types__ #define __types__ values. = "" values.0 = 0 new_value_index: procedure expose values. /* new_value_index() */ values.0 = values.0 + 1 return values.0 obj_type: procedure /* obj_type(obj) */ obj = arg(1) return left(obj, 4) obj_val: procedure expose values. /* obj_val(obj) */ obj = arg(1) type = obj_type(obj) val = substr(obj, 6) select when type == "numb" | type == "nill" | type == "true" | type == "fals" then return val otherwise return values.val end obj_meta: procedure expose values. /* obj_meta(obj) */ obj = arg(1) type = obj_type(obj) if type == "numb" | type == "nill" | type == "true" | type == "fals" then return "" ind = substr(obj, 6) return values.meta.ind obj_clone_and_set_meta: procedure expose values. /* obj_clone_and_set_meta(obj, new_meta) */ obj = arg(1) new_meta = arg(2) type = obj_type(obj) if type == "numb" | type == "nill" | type == "true" | type == "fals" then return "" orig_ind = substr(obj, 6) new_idx = new_value_index() values.new_idx = values.orig_ind values.meta.new_idx = new_meta return type || "_" || new_idx new_number: procedure /* new_number(n) */ n = arg(1) return "numb_" || n number?: procedure /* number?(obj) */ return obj_type(arg(1)) == "numb" new_nil: procedure /* new_nil() */ return "nill_0" nil?: procedure /* nil?(obj) */ return obj_type(arg(1)) == "nill" new_true: procedure /* new_true() */ return "true_0" true?: procedure /* true?(obj) */ return obj_type(arg(1)) == "true" new_false: procedure /* new_false() */ return "fals_0" false?: procedure /* false?(obj) */ return obj_type(arg(1)) == "fals" new_boolean: procedure /* new_boolean(cond) */ if arg(1) then return new_true() else return new_false() new_symbol: procedure expose values. /* new_symbol(str) */ str = arg(1) idx = new_value_index() values.idx = str return "symb_" || idx symbol?: procedure /* symbol?(obj) */ return obj_type(arg(1)) == "symb" new_string: procedure expose values. /* new_string(str) */ str = arg(1) idx = new_value_index() values.idx = str return "stri_" || idx string?: procedure /* string?(obj) */ return obj_type(arg(1)) == "stri" new_keyword: procedure expose values. /* new_keyword(str) */ str = arg(1) idx = new_value_index() values.idx = str return "keyw_" || idx keyword?: procedure /* keyword?(obj) */ return obj_type(arg(1)) == "keyw" new_seq: procedure expose values. /* new_seq(type, seq) */ type = arg(1) seq = arg(2) idx = new_value_index() values.idx = seq return type || "_" || idx new_list: procedure expose values. /* new_list(seq) */ seq = arg(1) return new_seq("list", seq) list?: procedure /* list?(obj) */ return obj_type(arg(1)) == "list" new_vector: procedure expose values. /* new_vector(seq) */ seq = arg(1) return new_seq("vect", seq) vector?: procedure /* vector?(obj) */ return obj_type(arg(1)) == "vect" sequential?: procedure /* sequential?(obj) */ return (list?(arg(1)) | vector?(arg(1))) count_elements: procedure expose values. /* count_elements(lst) */ return words(obj_val(arg(1))) new_hashmap: procedure expose values. /* new_hashmap(seq) */ seq = arg(1) return new_seq("hash", seq) hashmap?: procedure /* hashmap?(obj) */ return obj_type(arg(1)) == "hash" contains?: procedure expose values. /* contains?(hm_val, key) */ hm_val = arg(1) key = arg(2) do i=1 to words(hm_val) by 2 if equal?(key, word(hm_val, i)) then return 1 end return 0 hashmap_get: procedure expose values. /* hashmap_get(hm_val, key) */ hm_val = arg(1) key = arg(2) do i=1 to words(hm_val) by 2 if equal?(key, word(hm_val, i)) then return word(hm_val, i + 1) end return "" new_nativefn: procedure expose values. /* new_hashmap(native_func_name) */ native_func_name = arg(1) idx = new_value_index() values.idx = native_func_name return "nafn_" || idx nativefn?: procedure /* nativefn?(obj) */ return obj_type(arg(1)) == "nafn" new_func: procedure expose values. /* new_func(body_ast, env_idx, binds) */ body_ast = arg(1) env_idx = arg(2) binds = arg(3) is_macro = 0 idx = new_value_index() values.idx = body_ast env_idx binds is_macro return "func_" || idx func?: procedure /* func?(obj) */ return obj_type(arg(1)) == "func" func_macro?: procedure expose values. /* func_macro?(obj) */ return func?(arg(1)) & (func_is_macro(arg(1)) == 1) func_body_ast: procedure expose values. /* func_body_ast(func_obj) */ return word(obj_val(arg(1)), 1) func_env_idx: procedure expose values. /* func_env_idx(func_obj) */ return word(obj_val(arg(1)), 2) func_binds: procedure expose values. /* func_binds(func_obj) */ return word(obj_val(arg(1)), 3) func_is_macro: procedure expose values. /* func_is_macro(func_obj) */ return word(obj_val(arg(1)), 4) func_mark_as_macro: procedure expose values. /* func_mark_as_macro(func_obj) */ body_ast = func_body_ast(arg(1)) env_idx = func_env_idx(arg(1)) binds = func_binds(arg(1)) is_macro = 1 idx = new_value_index() values.idx = body_ast env_idx binds is_macro return "func_" || idx new_atom: procedure expose values. /* new_atom(obj) */ obj = arg(1) idx = new_value_index() values.idx = obj return "atom_" || idx atom?: procedure /* atom?(obj) */ return obj_type(arg(1)) == "atom" atom_set: procedure expose values. /* atom_set(atom, new_value) */ atom = arg(1) new_value = arg(2) idx = substr(atom, 6) values.idx = new_value return new_value equal_hashmap?: procedure expose values. /* equal_hashmap?(a, b) */ hma_val = obj_val(arg(1)) hmb_val = obj_val(arg(2)) if words(hma_val) \= words(hmb_val) then return 0 do i=1 to words(hma_val) by 2 a_key = word(hma_val, i) a_val = word(hma_val, i + 1) b_val = hashmap_get(hmb_val, a_key) if b_val == "" then return 0 if \equal?(a_val, b_val) then return 0 end return 1 equal_sequential?: procedure expose values. /* equal_sequential?(a, b) */ a_val = obj_val(arg(1)) b_val = obj_val(arg(2)) if words(a_val) \= words(b_val) then return 0 do i=1 to words(a_val) if \equal?(word(a_val, i), word(b_val, i)) then return 0 end return 1 equal?: procedure expose values. /* equal?(a, b) */ a = arg(1) b = arg(2) a_type = obj_type(a) b_type = obj_type(b) a_val = obj_val(a) b_val = obj_val(b) select when nil?(a) then return nil?(b) when true?(a) then return true?(b) when false?(a) then return false?(b) when (a_type == "numb" & b_type = "numb") | , (a_type == "symb" & b_type = "symb") | , (a_type == "stri" & b_type = "stri") | , (a_type == "keyw" & b_type = "keyw") then return (obj_val(a) == obj_val(b)) when (sequential?(a) & sequential?(b)) then return equal_sequential?(a, b) when (hashmap?(a) & hashmap?(b)) then return equal_hashmap?(a, b) otherwise return 0 end #endif ================================================ FILE: impls/rpython/Dockerfile ================================================ FROM ubuntu:vivid MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # For building rpython RUN apt-get -y install g++ # pypy RUN apt-get -y install software-properties-common RUN add-apt-repository ppa:pypy RUN apt-get -y update RUN apt-get -y install pypy # rpython RUN apt-get -y install mercurial libffi-dev pkg-config libz-dev libbz2-dev \ libsqlite3-dev libncurses-dev libexpat1-dev libssl-dev libgdbm-dev tcl-dev RUN mkdir -p /opt/pypy && \ curl -L https://bitbucket.org/pypy/pypy/downloads/pypy2-v5.6.0-src.tar.bz2 | tar -xjf - -C /opt/pypy/ --strip-components=1 #curl https://bitbucket.org/pypy/pypy/get/tip.tar.gz | tar -xzf - -C /opt/pypy/ --strip-components=1 RUN cd /opt/pypy && make && rm -rf /tmp/usession* RUN ln -sf /opt/pypy/rpython/bin/rpython /usr/local/bin/rpython RUN ln -sf /opt/pypy/pypy-c /usr/local/bin/pypy RUN chmod -R ugo+rw /opt/pypy/rpython/_cache RUN apt-get -y autoremove pypy ================================================ FILE: impls/rpython/Makefile ================================================ RPYTHON = rpython UPPER_STEPS = step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal STEPS = step0_repl step1_read_print step2_eval step3_env $(UPPER_STEPS) all: $(STEPS) dist: mal mal: stepA_mal cp $< $@ %: %.py $(RPYTHON) --output=$@ $< STEP0_DEPS = mal_readline.py STEP1_DEPS = $(STEP0_DEPS) mal_types.py reader.py printer.py STEP3_DEPS = $(STEP1_DEPS) env.py STEP4_DEPS = $(STEP3_DEPS) core.py step0_repl: $(STEP0_DEPS) step1_read_print step2_eval: $(STEP1_DEPS) step3_env: $(STEP3_DEPS) $(UPPER_STEPS): $(STEP4_DEPS) .PHONY: clean clean: rm -f mal $(STEPS) *.pyc rm -rf __pycache__ ================================================ FILE: impls/rpython/core.py ================================================ #import copy, time import time import mal_types as types from mal_types import (throw_str, MalType, MalMeta, nil, true, false, MalInt, MalSym, MalStr, MalList, MalVector, MalHashMap, MalAtom, MalFunc) import mal_readline import reader import printer # General functions def wrap_tf(tf): if tf: return true else: return false def do_equal(args): return wrap_tf(types._equal_Q(args[0], args[1])) # Errors/Exceptions def throw(args): raise types.MalException(args[0]) # Scalar functions def nil_Q(args): return wrap_tf(types._nil_Q(args[0])) def true_Q(args): return wrap_tf(types._true_Q(args[0])) def false_Q(args): return wrap_tf(types._false_Q(args[0])) def string_Q(args): return wrap_tf(types._string_Q(args[0])) def symbol(args): a0 = args[0] if isinstance(a0, MalStr): return types._symbol(a0.value) elif isinstance(a0, MalSym): return a0 else: throw_str("symbol called on non-string/non-symbol") def symbol_Q(args): return wrap_tf(types._symbol_Q(args[0])) def keyword(args): return types._keyword(args[0]) def keyword_Q(args): return wrap_tf(types._keyword_Q(args[0])) def number_Q(args): return wrap_tf(types._int_Q(args[0])) def function_Q(args): return wrap_tf(types._function_Q(args[0]) and not args[0].ismacro) def macro_Q(args): return wrap_tf(types._function_Q(args[0]) and args[0].ismacro) # String functions def pr_str(args): parts = [] for exp in args.values: parts.append(printer._pr_str(exp, True)) return MalStr(u" ".join(parts)) def do_str(args): parts = [] for exp in args.values: parts.append(printer._pr_str(exp, False)) return MalStr(u"".join(parts)) def prn(args): parts = [] for exp in args.values: parts.append(printer._pr_str(exp, True)) print(u" ".join(parts)) return nil def println(args): parts = [] for exp in args.values: parts.append(printer._pr_str(exp, False)) print(u" ".join(parts)) return nil def do_readline(args): prompt = args[0] if not isinstance(prompt, MalStr): throw_str("readline prompt is not a string") try: return MalStr(unicode(mal_readline.readline(str(prompt.value)))) except EOFError: return nil def read_str(args): a0 = args[0] if not isinstance(a0, MalStr): throw_str("read-string of non-string") return reader.read_str(str(a0.value)) def slurp(args): a0 = args[0] if not isinstance(a0, MalStr): throw_str("slurp with non-string filename") return MalStr(unicode(open(str(a0.value)).read())) # Number functions def lt(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("< called on non-integer") return wrap_tf(a.value < b.value) def lte(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("<= called on non-integer") return wrap_tf(a.value <= b.value) def gt(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("> called on non-integer") return wrap_tf(a.value > b.value) def gte(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str(">= called on non-integer") return wrap_tf(a.value >= b.value) def plus(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("+ called on non-integer") return MalInt(a.value+b.value) def minus(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("- called on non-integer") return MalInt(a.value-b.value) def multiply(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("* called on non-integer") return MalInt(a.value*b.value) def divide(args): a, b = args[0], args[1] if not isinstance(a, MalInt) or not isinstance(b, MalInt): throw_str("/ called on non-integer") if b.value == 0: throw_str("divide by zero") return MalInt(int(a.value/b.value)) def time_ms(args): return MalInt(int(time.time() * 1000)) # Hash map functions def do_hash_map(ml): return types._hash_mapl(ml.values) def hash_map_Q(args): return wrap_tf(types._hash_map_Q(args[0])) def assoc(args): src_hm, key_vals = args[0], args.rest() new_dct = src_hm.dct.copy() for i in range(0,len(key_vals),2): k = key_vals[i] if not isinstance(k, MalStr): throw_str("assoc called with non-string/non-keyword key") new_dct[k.value] = key_vals[i+1] return MalHashMap(new_dct) def dissoc(args): src_hm, keys = args[0], args.rest() new_dct = src_hm.dct.copy() for k in keys.values: if not isinstance(k, MalStr): throw_str("dissoc called with non-string/non-keyword key") if k.value in new_dct: del new_dct[k.value] return MalHashMap(new_dct) def get(args): obj, key = args[0], args[1] if obj is nil: return nil elif isinstance(obj, MalHashMap): if not isinstance(key, MalStr): throw_str("get called on hash-map with non-string/non-keyword key") if obj and key.value in obj.dct: return obj.dct[key.value] else: return nil elif isinstance(obj, MalList): if not isinstance(key, MalInt): throw_str("get called on list/vector with non-string/non-keyword key") return obj.values[key.value] else: throw_str("get called on invalid type") def contains_Q(args): hm, key = args[0], args[1] if not isinstance(key, MalStr): throw_str("contains? called on hash-map with non-string/non-keyword key") return wrap_tf(key.value in hm.dct) def keys(args): hm = args[0] keys = [] for k in hm.dct.keys(): keys.append(MalStr(k)) return MalList(keys) def vals(args): hm = args[0] return MalList(hm.dct.values()) # Sequence functions def do_list(ml): return ml def list_Q(args): return wrap_tf(types._list_Q(args[0])) def do_vector(ml): return MalVector(ml.values) def vector_Q(args): return wrap_tf(types._vector_Q(args[0])) def empty_Q(args): seq = args[0] if isinstance(seq, MalList): return wrap_tf(len(seq) == 0) elif seq is nil: return true else: throw_str("empty? called on non-sequence") def count(args): seq = args[0] if isinstance(seq, MalList): return MalInt(len(seq)) elif seq is nil: return MalInt(0) else: throw_str("count called on non-sequence") 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): throw_str("cons called with non-list/non-vector") return MalList([x] + seq.values) def concat(args): new_lst = [] for l in args.values: if not isinstance(l, MalList): throw_str("concat called with non-list/non-vector") new_lst = new_lst + l.values return MalList(new_lst) def nth(args): lst, idx = args[0], args[1] if not isinstance(lst, MalList): throw_str("nth called with non-list/non-vector") if not isinstance(idx, MalInt): throw_str("nth called with non-int index") if idx.value < len(lst): return lst[idx.value] else: throw_str("nth: index out of range") def first(args): a0 = args[0] if a0 is nil: return nil elif not isinstance(a0, MalList): throw_str("first called with non-list/non-vector") if len(a0) == 0: return nil else: return a0[0] def rest(args): a0 = args[0] if a0 is nil: return MalList([]) elif not isinstance(a0, MalList): throw_str("rest called with non-list/non-vector") if len(a0) == 0: return MalList([]) else: return a0.rest() def apply(args): f, fargs = args[0], args.rest() last_arg = fargs.values[-1] if not isinstance(last_arg, MalList): throw_str("map called with non-list") all_args = fargs.values[0:-1] + last_arg.values return f.apply(MalList(all_args)) def mapf(args): f, lst = args[0], args[1] if not isinstance(lst, MalList): throw_str("map called with non-list") res = [] for a in lst.values: res.append(f.apply(MalList([a]))) return MalList(res) # retains metadata def conj(args): lst, args = args[0], args.rest() new_lst = None if types._list_Q(lst): vals = args.values[:] vals.reverse() new_lst = MalList(vals + lst.values) elif types._vector_Q(lst): new_lst = MalVector(lst.values + list(args.values)) else: throw_str("conj on non-list/non-vector") new_lst.meta = lst.meta return new_lst def seq(args): a0 = args[0] if isinstance(a0, MalVector): if len(a0) == 0: return nil return MalList(a0.values) elif isinstance(a0, MalList): if len(a0) == 0: return nil return a0 elif types._string_Q(a0): assert isinstance(a0, MalStr) if len(a0) == 0: return nil return MalList([MalStr(unicode(c)) for c in a0.value]) elif a0 is nil: return nil else: throw_str("seq: called on non-sequence") # Metadata functions def with_meta(args): obj, meta = args[0], args[1] if isinstance(obj, MalMeta): new_obj = types._clone(obj) new_obj.meta = meta return new_obj else: throw_str("with-meta not supported on type") def meta(args): obj = args[0] if isinstance(obj, MalMeta): return obj.meta else: throw_str("meta not supported on type") # Atoms functions def do_atom(args): return MalAtom(args[0]) def atom_Q(args): return wrap_tf(types._atom_Q(args[0])) def deref(args): atm = args[0] if not isinstance(atm, MalAtom): throw_str("deref called on non-atom") return atm.value def reset_BANG(args): atm, val = args[0], args[1] if not isinstance(atm, MalAtom): throw_str("reset! called on non-atom") atm.value = val return atm.value def swap_BANG(args): atm, f, fargs = args[0], args[1], args.slice(2) if not isinstance(atm, MalAtom): throw_str("swap! called on non-atom") if not isinstance(f, MalFunc): throw_str("swap! called with non-function") all_args = [atm.value] + fargs.values atm.value = f.apply(MalList(all_args)) return atm.value ns = { '=': do_equal, 'throw': throw, 'nil?': nil_Q, 'true?': true_Q, 'false?': false_Q, 'string?': string_Q, 'symbol': symbol, 'symbol?': symbol_Q, 'keyword': keyword, 'keyword?': keyword_Q, 'number?': number_Q, 'fn?': function_Q, 'macro?': macro_Q, 'pr-str': pr_str, 'str': do_str, 'prn': prn, 'println': println, 'readline': do_readline, 'read-string': read_str, 'slurp': slurp, '<': lt, '<=': lte, '>': gt, '>=': gte, '+': plus, '-': minus, '*': multiply, '/': divide, 'time-ms': time_ms, 'list': do_list, 'list?': list_Q, 'vector': do_vector, 'vector?': vector_Q, 'hash-map': do_hash_map, 'map?': hash_map_Q, 'assoc': assoc, 'dissoc': dissoc, 'get': get, 'contains?': contains_Q, 'keys': keys, 'vals': vals, 'sequential?': sequential_Q, 'vec': vec, 'cons': cons, 'concat': concat, 'nth': nth, 'first': first, 'rest': rest, 'empty?': empty_Q, 'count': count, 'apply': apply, 'map': mapf, 'conj': conj, 'seq': seq, 'with-meta': with_meta, 'meta': meta, 'atom': do_atom, 'atom?': atom_Q, 'deref': deref, 'reset!': reset_BANG, 'swap!': swap_BANG } ================================================ FILE: impls/rpython/env.py ================================================ from mal_types import MalType, MalSym, MalList, throw_str # Environment class Env(): def __init__(self, outer=None, binds=None, exprs=None): self.data = {} self.outer = outer or None if binds: assert isinstance(binds, MalList) and isinstance(exprs, MalList) for i in range(len(binds)): bind = binds[i] if not isinstance(bind, MalSym): throw_str("env bind value is not a symbol") if bind.value == u"&": bind = binds[i+1] if not isinstance(bind, MalSym): throw_str("env bind value is not a symbol") self.data[bind.value] = exprs.slice(i) break else: self.data[bind.value] = exprs[i] def set(self, key, value): assert isinstance(key, MalSym) assert isinstance(value, MalType) self.data[key.value] = value return value def get(self, key): assert isinstance(key, unicode) env = self while True: value = env.data.get(key, None) if value is not None: return value env = env.outer if env is None: return None ================================================ FILE: impls/rpython/mal_readline.py ================================================ #import os, readline as pyreadline # #histfile = os.path.expanduser("~/.mal-history") # #def init(): # try: # with open(histfile, "r") as hf: # for line in hf.readlines(): # pyreadline.add_history(line.rstrip("\r\n")) # pass # except IOError: # #print("Could not open %s" % histfile) # pass # #def readline(prompt="user> "): # try: # line = raw_input(prompt) # pyreadline.add_history(line) # with open(histfile, "a") as hf: # hf.write(line + "\n") # except IOError: # pass # except EOFError: # return None # return line import os def readline(prompt): res = '' os.write(1, prompt) while True: buf = os.read(0, 255) if not buf: raise EOFError() res += buf if res[-1] == '\n': return res[:-1] ================================================ FILE: impls/rpython/mal_types.py ================================================ import sys, copy, types as pytypes IS_RPYTHON = sys.argv[0].endswith('rpython') if IS_RPYTHON: from rpython.rlib.listsort import TimSort else: import re # General functions class StringSort(TimSort): def lt(self, a, b): assert isinstance(a, unicode) assert isinstance(b, unicode) return a < b def _equal_Q(a, b): assert isinstance(a, MalType) and isinstance(b, MalType) ota, otb = a.__class__, b.__class__ if not (ota is otb or (_sequential_Q(a) and _sequential_Q(b))): return False if isinstance(a, MalSym) and isinstance(b, MalSym): return a.value == b.value elif isinstance(a, MalStr) and isinstance(b, MalStr): return a.value == b.value elif isinstance(a, MalInt) and isinstance(b, MalInt): return a.value == b.value elif _list_Q(a) or _vector_Q(a): if len(a) != len(b): return False for i in range(len(a)): if not _equal_Q(a[i], b[i]): return False return True elif _hash_map_Q(a): assert isinstance(a, MalHashMap) assert isinstance(b, MalHashMap) akeys = a.dct.keys() bkeys = b.dct.keys() if len(akeys) != len(bkeys): return False StringSort(akeys).sort() StringSort(bkeys).sort() for i in range(len(akeys)): ak, bk = akeys[i], bkeys[i] assert isinstance(ak, unicode) assert isinstance(bk, unicode) if ak != bk: return False av, bv = a.dct[ak], b.dct[bk] if not _equal_Q(av, bv): return False return True elif a is b: return True else: throw_str("no = op defined for %s" % a.__class__.__name__) def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) def _clone(obj): if isinstance(obj, MalFunc): return MalFunc(obj.fn, obj.ast, obj.env, obj.params, obj.EvalFunc, obj.ismacro) elif isinstance(obj, MalList): return obj.__class__(obj.values) elif isinstance(obj, MalHashMap): return MalHashMap(obj.dct) elif isinstance(obj, MalAtom): return MalAtom(obj.value) else: raise Exception("_clone on invalid type") def _replace(match, sub, old_str): new_str = u"" idx = 0 while idx < len(old_str): midx = old_str.find(match, idx) if midx < 0: break assert midx >= 0 and midx < len(old_str) new_str = new_str + old_str[idx:midx] new_str = new_str + sub idx = midx + len(match) new_str = new_str + old_str[idx:] return new_str # # Mal Types # class MalException(Exception): def __init__(self, object): self.object = object def throw_str(s): raise MalException(MalStr(unicode(s))) ### Parent types class MalType(): pass class MalMeta(MalType): pass ### Scalars class MalNil(MalType): pass nil = MalNil() def _nil_Q(exp): assert isinstance(exp, MalType) return exp is nil class MalTrue(MalType): pass true = MalTrue() def _true_Q(exp): assert isinstance(exp, MalType) return exp is true class MalFalse(MalType): pass false = MalFalse() def _false_Q(exp): assert isinstance(exp, MalType) return exp is false # Numbers class MalInt(MalType): def __init__(self, value): assert isinstance(value, int) self.value = value def _int_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalInt # String class MalStr(MalType): def __init__(self, value): assert isinstance(value, unicode) self.value = value def __len__(self): return len(self.value) def _string_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalStr and not _keyword_Q(exp) # Keywords # A specially prefixed string def _keyword(mstr): assert isinstance(mstr, MalType) if isinstance(mstr, MalStr): val = mstr.value if val[0] == u"\u029e": return mstr else: return MalStr(u"\u029e" + val) else: throw_str("_keyword called on non-string") # Create keyword from unicode string def _keywordu(strn): assert isinstance(strn, unicode) return MalStr(u"\u029e" + strn) def _keyword_Q(exp): if isinstance(exp, MalStr) and len(exp.value) > 0: return exp.value[0] == u"\u029e" else: return False # Symbols class MalSym(MalMeta): def __init__(self, value): assert isinstance(value, unicode) self.value = value self.meta = nil def _symbol(strn): assert isinstance(strn, unicode) return MalSym(strn) def _symbol_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalSym # lists class MalList(MalMeta): def __init__(self, vals): assert isinstance(vals, list) self.values = vals self.meta = nil def append(self, val): self.values.append(val) def rest(self): return MalList(self.values[1:]) def __len__(self): return len(self.values) def __getitem__(self, i): assert isinstance(i, int) return self.values[i] def slice(self, start): return MalList(self.values[start:len(self.values)]) def slice2(self, start, end): assert end >= 0 return MalList(self.values[start:end]) def _list(*vals): return MalList(list(vals)) def _listl(lst): return MalList(lst) def _list_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalList ### vectors class MalVector(MalList): pass def _vector(*vals): return MalVector(list(vals)) def _vectorl(lst): return MalVector(lst) def _vector_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalVector ### hash maps class MalHashMap(MalMeta): def __init__(self, dct): self.dct = dct self.meta = nil def append(self, val): self.dct.append(val) def __getitem__(self, k): assert isinstance(k, unicode) if not isinstance(k, unicode): throw_str("hash-map lookup by non-string/non-keyword") return self.dct[k] def __setitem__(self, k, v): if not isinstance(k, unicode): throw_str("hash-map key must be string or keyword") assert isinstance(v, MalType) self.dct[k] = v return v def _hash_mapl(kvs): dct = {} for i in range(0, len(kvs), 2): k = kvs[i] if not isinstance(k, MalStr): throw_str("hash-map key must be string or keyword") v = kvs[i+1] dct[k.value] = v return MalHashMap(dct) def _hash_map_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalHashMap # Functions # env import must happen after MalSym and MalList definitions to allow # circular dependency from env import Env class MalFunc(MalMeta): def __init__(self, fn, ast=None, env=None, params=None, EvalFunc=None, ismacro=False): if fn is None and EvalFunc is None: throw_str("MalFunc requires either fn or EvalFunc") self.fn = fn self.ast = ast self.env = env self.params = params self.EvalFunc = EvalFunc self.ismacro = ismacro self.meta = nil def apply(self, args): if self.EvalFunc: return self.EvalFunc(self.ast, self.gen_env(args)) else: return self.fn(args) def gen_env(self, args): return Env(self.env, self.params, args) def _function_Q(exp): assert isinstance(exp, MalType) return exp.__class__ is MalFunc # atoms class MalAtom(MalMeta): def __init__(self, value): self.value = value self.meta = nil def get_value(self): return self.value def _atom(val): return MalAtom(val) def _atom_Q(exp): return exp.__class__ is MalAtom ================================================ FILE: impls/rpython/printer.py ================================================ import sys IS_RPYTHON = sys.argv[0].endswith('rpython') if IS_RPYTHON: from rpython.rlib.rsre import rsre_re as re else: import re import mal_types as types from mal_types import (MalType, MalStr, MalSym, MalInt, nil, true, false, MalAtom, MalFunc) def _pr_a_str(s, print_readably=True): if len(s) > 0 and s[0] == u'\u029e': return u':' + s[1:] elif print_readably: return u'"' + types._replace(u'\n', u'\\n', types._replace(u'\"', u'\\"', types._replace(u'\\', u'\\\\', s))) + u'"' else: return s def _pr_str(obj, print_readably=True): assert isinstance(obj, MalType) _r = print_readably if types._list_Q(obj): res = [] for e in obj.values: res.append(_pr_str(e,_r)) return u"(" + u" ".join(res) + u")" elif types._vector_Q(obj): res = [] for e in obj.values: res.append(_pr_str(e,_r)) return u"[" + u" ".join(res) + u"]" elif types._hash_map_Q(obj): ret = [] for k in obj.dct.keys(): ret.append(_pr_a_str(k,_r)) ret.append(_pr_str(obj.dct[k],_r)) return u"{" + u" ".join(ret) + u"}" elif isinstance(obj, MalStr): return _pr_a_str(obj.value,_r) elif obj is nil: return u"nil" elif obj is true: return u"true" elif obj is false: return u"false" elif types._atom_Q(obj): return u"(atom " + _pr_str(obj.get_value(),_r) + u")" elif isinstance(obj, MalSym): return obj.value elif isinstance(obj, MalInt): return unicode(str(obj.value)) elif isinstance(obj, MalFunc): return u"#" else: return u"unknown" ================================================ FILE: impls/rpython/reader.py ================================================ import sys IS_RPYTHON = sys.argv[0].endswith('rpython') if IS_RPYTHON: from rpython.rlib.rsre import rsre_re as re else: import re import mal_types as types from mal_types import (MalSym, MalInt, MalStr, _keywordu, _list, _listl, _vectorl, _hash_mapl) class Blank(Exception): pass class Reader(): def __init__(self, tokens, position=0): self.tokens = tokens self.position = position def next(self): self.position += 1 return self.tokens[self.position-1] def peek(self): if len(self.tokens) > self.position: return self.tokens[self.position] else: return None def tokenize(str): re_str = "[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\s\[\]{}()'\"`@,;]+)" if IS_RPYTHON: tok_re = re_str else: tok_re = re.compile(re_str) return [t for t in re.findall(tok_re, str) if t[0] != ';'] def read_atom(reader): if IS_RPYTHON: int_re = '-?[0-9]+$' float_re = '-?[0-9][0-9.]*$' str_re = '"(?:[\\\\].|[^\\\\"])*"' else: int_re = re.compile('-?[0-9]+$') float_re = re.compile('-?[0-9][0-9.]*$') str_re = re.compile('"(?:[\\\\].|[^\\\\"])*"') token = reader.next() if re.match(int_re, token): return MalInt(int(token)) ## elif re.match(float_re, token): return int(token) elif re.match(str_re, token): end = len(token)-1 if end <= 1: return MalStr(u"") else: s = unicode(token[1:end]) s = types._replace(u'\\\\', u"\u029e", s) s = types._replace(u'\\"', u'"', s) s = types._replace(u'\\n', u"\n", s) s = types._replace(u"\u029e", u"\\", s) return MalStr(s) elif token[0] == '"': types.throw_str("expected '\"', got EOF") elif token[0] == ':': return _keywordu(unicode(token[1:])) elif token == "nil": return types.nil elif token == "true": return types.true elif token == "false": return types.false else: return MalSym(unicode(token)) def read_sequence(reader, start='(', end=')'): ast = [] token = reader.next() if token != start: types.throw_str("expected '" + start + "'") token = reader.peek() while token != end: if not token: types.throw_str("expected '" + end + "', got EOF") ast.append(read_form(reader)) token = reader.peek() reader.next() return ast def read_list(reader): lst = read_sequence(reader, '(', ')') return _listl(lst) def read_vector(reader): lst = read_sequence(reader, '[', ']') return _vectorl(lst) def read_hash_map(reader): lst = read_sequence(reader, '{', '}') return _hash_mapl(lst) def read_form(reader): token = reader.peek() # reader macros/transforms if token[0] == ';': reader.next() return None elif token == '\'': reader.next() return _list(MalSym(u'quote'), read_form(reader)) elif token == '`': reader.next() return _list(MalSym(u'quasiquote'), read_form(reader)) elif token == '~': reader.next() return _list(MalSym(u'unquote'), read_form(reader)) elif token == '~@': reader.next() return _list(MalSym(u'splice-unquote'), read_form(reader)) elif token == '^': reader.next() meta = read_form(reader) return _list(MalSym(u'with-meta'), read_form(reader), meta) elif token == '@': reader.next() return _list(MalSym(u'deref'), read_form(reader)) # list elif token == ')': types.throw_str("unexpected ')'") elif token == '(': return read_list(reader) # vector elif token == ']': types.throw_str("unexpected ']'"); elif token == '[': return read_vector(reader); # hash-map elif token == '}': types.throw_str("unexpected '}'"); elif token == '{': return read_hash_map(reader); # atom else: return read_atom(reader); def read_str(str): tokens = tokenize(str) if len(tokens) == 0: raise Blank("Blank Line") return read_form(Reader(tokens)) ================================================ FILE: impls/rpython/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/rpython/step0_repl.py ================================================ #import sys, traceback import mal_readline # read def READ(str): return str # eval def EVAL(ast, env): #print("EVAL %s" % printer._pr_str(ast)) return ast # print def PRINT(exp): return exp # repl def REP(str): return PRINT(EVAL(READ(str), {})) def entry_point(argv): #mal_readline.init() while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line)) except EOFError as e: break except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step1_read_print.py ================================================ #import sys, traceback import mal_readline import mal_types as types import reader, printer # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): #print("EVAL %s" % printer._pr_str(ast)) return ast # print def PRINT(exp): return printer._pr_str(exp) # repl def REP(str): return PRINT(EVAL(READ(str), {})) def entry_point(argv): #mal_readline.init() while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step2_eval.py ================================================ #import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, _keywordu, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): # print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) if ast.value in env: return env[ast.value] else: raise Exception(u"'" + ast.value + u"' not found") elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast f = EVAL(ast[0], env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl repl_env = {} def REP(str, env): return PRINT(EVAL(READ(str), env)) def plus(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value+b.value) def minus(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value-b.value) def multiply(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value*b.value) def divide(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(int(a.value/b.value)) repl_env[u'+'] = MalFunc(plus) repl_env[u'-'] = MalFunc(minus) repl_env[u'*'] = MalFunc(multiply) repl_env[u'/'] = MalFunc(divide) def entry_point(argv): while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step3_env.py ================================================ #import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, _symbol, _keywordu, nil, false, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if not isinstance(a0, MalSym): raise Exception("attempt to apply on non-symbol") if u"def!" == a0.value: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0.value: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) else: f = EVAL(a0, env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) def plus(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value+b.value) def minus(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value-b.value) def multiply(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(a.value*b.value) def divide(args): a, b = args[0], args[1] assert isinstance(a, MalInt) assert isinstance(b, MalInt) return MalInt(int(a.value/b.value)) repl_env.set(_symbol(u'+'), MalFunc(plus)) repl_env.set(_symbol(u'-'), MalFunc(minus)) repl_env.set(_symbol(u'*'), MalFunc(multiply)) repl_env.set(_symbol(u'/'), MalFunc(divide)) def entry_point(argv): while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step4_if_fn_do.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) return EVAL(ast[-1], env) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: return EVAL(ast[3], env) else: return nil else: return EVAL(a2, env) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step5_tco.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step6_file.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl class MalEval(MalFunc): def apply(self, args): return self.EvalFunc(args[0], self.env) def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) repl_env.set(types._symbol(u'eval'), MalEval(None, env=repl_env, EvalFunc=EVAL)) mal_args = [] if len(argv) >= 3: for a in argv[2:]: mal_args.append(MalStr(unicode(a))) repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if len(argv) >= 2: REP('(load-file "' + argv[1] + '")', repl_env) return 0 while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step7_quote.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval 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 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: return ast def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl class MalEval(MalFunc): def apply(self, args): return self.EvalFunc(args[0], self.env) def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) repl_env.set(types._symbol(u'eval'), MalEval(None, env=repl_env, EvalFunc=EVAL)) mal_args = [] if len(argv) >= 3: for a in argv[2:]: mal_args.append(MalStr(unicode(a))) repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if len(argv) >= 2: REP('(load-file "' + argv[1] + '")', repl_env) return 0 while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step8_macros.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval 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 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: return ast def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: func = EVAL(ast[2], env) return env.set(ast[1], MalFunc(func.fn, ast=func.ast, env=func.env, params=func.params, EvalFunc=func.EvalFunc, ismacro=True)) elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) if f.ismacro: ast = f.apply(ast.rest()) # Continue loop (TCO) continue args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl class MalEval(MalFunc): def apply(self, args): return self.EvalFunc(args[0], self.env) def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) repl_env.set(types._symbol(u'eval'), MalEval(None, env=repl_env, EvalFunc=EVAL)) mal_args = [] if len(argv) >= 3: for a in argv[2:]: mal_args.append(MalStr(unicode(a))) repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if len(argv) >= 2: REP('(load-file "' + argv[1] + '")', repl_env) return 0 while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/step9_try.py ================================================ import sys, traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval 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 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: return ast def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: func = EVAL(ast[2], env) return env.set(ast[1], MalFunc(func.fn, ast=func.ast, env=func.env, params=func.params, EvalFunc=func.EvalFunc, ismacro=True)) elif u"try*" == a0sym: if len(ast) < 3: return EVAL(ast[1], env); a1, a2 = ast[1], ast[2] a20 = a2[0] if isinstance(a20, MalSym): if a20.value == u"catch*": try: return EVAL(a1, env); except types.MalException as exc: exc = exc.object catch_env = Env(env, _list(a2[1]), _list(exc)) return EVAL(a2[2], catch_env) except Exception as exc: exc = MalStr(unicode("%s" % exc)) catch_env = Env(env, _list(a2[1]), _list(exc)) return EVAL(a2[2], catch_env) return EVAL(a1, env); elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) if f.ismacro: ast = f.apply(ast.rest()) # Continue loop (TCO) continue args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl class MalEval(MalFunc): def apply(self, args): return self.EvalFunc(args[0], self.env) def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) repl_env.set(types._symbol(u'eval'), MalEval(None, env=repl_env, EvalFunc=EVAL)) mal_args = [] if len(argv) >= 3: for a in argv[2:]: mal_args.append(MalStr(unicode(a))) repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if len(argv) >= 2: REP('(load-file "' + argv[1] + '")', repl_env) return 0 while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) #print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/stepA_mal.py ================================================ import sys IS_RPYTHON = sys.argv[0].endswith('rpython') if IS_RPYTHON: #from rpython.rlib.debug import fatalerror from rpython.rtyper.lltypesystem import lltype from rpython.rtyper.lltypesystem.lloperation import llop else: import traceback import mal_readline import mal_types as types from mal_types import (MalSym, MalInt, MalStr, nil, true, false, _symbol, _keywordu, throw_str, MalList, _list, MalVector, MalHashMap, MalFunc) import reader, printer from env import Env import core # read def READ(str): return reader.read_str(str) # eval 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 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: return ast def EVAL(ast, env): while True: if env.get(u"DEBUG-EVAL") not in (None, nil, false): print(u"EVAL: " + printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) value = env.get(ast.value) if value is None: throw_str("'" + str(ast.value) + "' not found") return value elif types._vector_Q(ast): res = [] for a in ast.values: res.append(EVAL(a, env)) return MalVector(res) elif types._hash_map_Q(ast): new_dct = {} for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) elif not types._list_Q(ast): return ast # primitive value, return unchanged else: # apply list if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): a0sym = a0.value else: a0sym = u"__<*fn*>__" if u"def!" == a0sym: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) return env.set(a1, res) elif u"let*" == a0sym: a1, a2 = ast[1], ast[2] let_env = Env(env) for i in range(0, len(a1), 2): let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: func = EVAL(ast[2], env) return env.set(ast[1], MalFunc(func.fn, ast=func.ast, env=func.env, params=func.params, EvalFunc=func.EvalFunc, ismacro=True)) elif u"try*" == a0sym: if len(ast) < 3: return EVAL(ast[1], env); a1, a2 = ast[1], ast[2] a20 = a2[0] if isinstance(a20, MalSym): if a20.value == u"catch*": try: return EVAL(a1, env); except types.MalException as exc: exc = exc.object catch_env = Env(env, _list(a2[1]), _list(exc)) return EVAL(a2[2], catch_env) except Exception as exc: exc = MalStr(unicode("%s" % exc)) catch_env = Env(env, _list(a2[1]), _list(exc)) return EVAL(a2[2], catch_env) return EVAL(a1, env); elif u"do" == a0sym: if len(ast) == 0: return nil for i in range(1, len(ast) - 1): EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is nil or cond is false: if len(ast) > 3: ast = ast[3] # Continue loop (TCO) else: return nil else: ast = a2 # Continue loop (TCO) elif u"fn*" == a0sym: a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: f = EVAL(a0, env) if f.ismacro: ast = f.apply(ast.rest()) # Continue loop (TCO) continue args_list = [] for i in range(1, len(ast)): args_list.append(EVAL(ast[i], env)) args = MalList(args_list) if isinstance(f, MalFunc): if f.ast: ast = f.ast env = f.gen_env(args) # Continue loop (TCO) else: return f.apply(args) else: raise Exception("%s is not callable" % f) # print def PRINT(exp): return printer._pr_str(exp) # repl class MalEval(MalFunc): def apply(self, args): return self.EvalFunc(args[0], self.env) def entry_point(argv): repl_env = Env() def REP(str, env): return PRINT(EVAL(READ(str), env)) # core.py: defined using python for k, v in core.ns.items(): repl_env.set(_symbol(unicode(k)), MalFunc(v)) repl_env.set(types._symbol(u'eval'), MalEval(None, env=repl_env, EvalFunc=EVAL)) mal_args = [] if len(argv) >= 3: for a in argv[2:]: mal_args.append(MalStr(unicode(a))) repl_env.set(_symbol(u'*ARGV*'), MalList(mal_args)) # core.mal: defined using the language itself REP("(def! *host-language* \"rpython\")", repl_env) REP("(def! not (fn* (a) (if a false true)))", repl_env) REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) 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)))))))", repl_env) if len(argv) >= 2: REP('(load-file "' + argv[1] + '")', repl_env) return 0 REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) while True: try: line = mal_readline.readline("user> ") if line == "": continue print(REP(line, repl_env)) except EOFError as e: break except reader.Blank: continue except types.MalException as e: print(u"Error: %s" % printer._pr_str(e.object, False)) except Exception as e: print("Error: %s" % e) if IS_RPYTHON: llop.debug_print_traceback(lltype.Void) else: print("".join(traceback.format_exception(*sys.exc_info()))) return 0 # _____ Define and setup target ___ def target(*args): return entry_point # Just run entry_point if not RPython compilation import sys if not sys.argv[0].endswith('rpython'): entry_point(sys.argv) ================================================ FILE: impls/rpython/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/ruby/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin LABEL org.opencontainers.image.source=https://github.com/kanaka/mal LABEL org.opencontainers.image.description="mal test container: ruby" ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install ruby ================================================ FILE: impls/ruby/Makefile ================================================ SOURCES_BASE = mal_readline.rb types.rb reader.rb printer.rb SOURCES_LISP = env.rb core.rb stepA_mal.rb SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.rb mal mal.rb: $(SOURCES) cat $+ | grep -v "^require_relative" > $@ mal: mal.rb echo "#!/usr/bin/env ruby" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.rb mal ================================================ FILE: impls/ruby/core.rb ================================================ require "readline" require_relative "reader" require_relative "printer" $core_ns = { :"=" => lambda {|a,b| a == b}, :throw => lambda {|a| raise MalException.new(a), "Mal Exception"}, :nil? => lambda {|a| a == nil}, :true? => lambda {|a| a == true}, :false? => lambda {|a| a == false}, :string? => lambda {|a| (a.is_a? String) && "\u029e" != a[0]}, :symbol => lambda {|a| a.to_sym}, :symbol? => lambda {|a| a.is_a? Symbol}, :keyword => lambda {|a| (a.is_a? String) && "\u029e" == a[0] ? a : "\u029e"+a}, :keyword? => lambda {|a| (a.is_a? String) && "\u029e" == a[0]}, :number? => lambda {|a| a.is_a? Numeric}, :fn? => lambda {|a| (a.is_a? Proc) && (!(a.is_a? Function) || !a.is_macro)}, :macro? => lambda {|a| (a.is_a? Function) && a.is_macro}, :"pr-str" => lambda {|*a| a.map {|e| _pr_str(e, true)}.join(" ")}, :str => lambda {|*a| a.map {|e| _pr_str(e, false)}.join("")}, :prn => lambda {|*a| puts(a.map {|e| _pr_str(e, true)}.join(" "))}, :println => lambda {|*a| puts(a.map {|e| _pr_str(e, false)}.join(" "))}, :readline => lambda {|a| Readline.readline(a,true)}, :"read-string" => lambda {|a| read_str(a)}, :slurp => lambda {|a| File.read(a)}, :< => lambda {|a,b| a < b}, :<= => lambda {|a,b| a <= b}, :> => lambda {|a,b| a > b}, :>= => lambda {|a,b| a >= b}, :+ => lambda {|a,b| a + b}, :- => lambda {|a,b| a - b}, :* => lambda {|a,b| a * b}, :/ => lambda {|a,b| a / b}, :"time-ms" => lambda {|| (Time.now.to_f * 1000).to_i}, :list => lambda {|*a| List.new a}, :list? => lambda {|*a| a[0].is_a? List}, :vector => lambda {|*a| Vector.new a}, :vector? => lambda {|*a| a[0].is_a? Vector}, :"hash-map" =>lambda {|*a| Hash[a.each_slice(2).to_a]}, :map? => lambda {|a| a.is_a? Hash}, :assoc => lambda {|*a| a[0].merge(Hash[a.drop(1).each_slice(2).to_a])}, :dissoc => lambda {|*a| h = a[0].clone; a.drop(1).each{|k| h.delete k}; h}, :get => lambda {|a,b| return nil if a == nil; a[b]}, :contains? => lambda {|a,b| a.key? b}, :keys => lambda {|a| List.new a.keys}, :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]}, :first => lambda {|a| a.nil? ? nil : a[0]}, :rest => lambda {|a| List.new(a.nil? || a.size == 0 ? [] : a.drop(1))}, :empty? => lambda {|a| a.size == 0}, :count => lambda {|a| return 0 if a == nil; a.size}, :apply => lambda {|*a| a[0][*a[1..-2].concat(a[-1])]}, :map => lambda {|a,b| List.new(b.map {|e| a[e]})}, :conj => lambda {|*a| a[0].clone.conj(a.drop(1))}, :seq => lambda {|a| a.nil? ? nil : a.size == 0 ? nil : a.seq}, :"with-meta" => lambda {|a,b| x = a.clone; x.meta = b; x}, :meta => lambda {|a| a.meta}, :atom => lambda {|a| Atom.new(a)}, :atom? => lambda {|a| a.is_a? Atom}, :deref => lambda {|a| a.val}, :reset! => lambda {|a,b| a.val = b}, :swap! => lambda {|*a| a[0].val = a[1][*[a[0].val].concat(a.drop(2))]}, } ================================================ FILE: impls/ruby/env.rb ================================================ class Env attr_accessor :data def initialize(outer=nil, binds=[], exprs=[]) @data = {} @outer = outer binds.each_index do |i| if binds[i] == :"&" data[binds[i+1]] = List.new exprs.drop(i) break else data[binds[i]] = exprs[i] end end return self end def find(key) if @data.key? key return self elsif @outer return @outer.find(key) else return nil end end def set(key, value) @data[key] = value return value end def get(key) env = find(key) raise "'" + key.to_s + "' not found" if not env env.data[key] end def get_or_nil(key) env = find(key) return nil if not env env.data[key] end end ================================================ FILE: impls/ruby/mal_readline.rb ================================================ require "readline" $history_loaded = false $histfile = "#{ENV['HOME']}/.mal-history" def _readline(prompt) if !$history_loaded && File.exist?($histfile) $history_loaded = true if File.readable?($histfile) File.readlines($histfile).each {|l| Readline::HISTORY.push(l.chomp)} end end if line = Readline.readline(prompt, true) if File.writable?($histfile) File.open($histfile, 'a+') {|f| f.write(line+"\n")} end return line else return nil end end ================================================ FILE: impls/ruby/printer.rb ================================================ require_relative "types" def _pr_str(obj, print_readably=true) _r = print_readably return case obj when List "(" + obj.map{|x| _pr_str(x, _r)}.join(" ") + ")" when Vector "[" + obj.map{|x| _pr_str(x, _r)}.join(" ") + "]" when Hash ret = [] obj.each{|k,v| ret.push(_pr_str(k,_r), _pr_str(v,_r))} "{" + ret.join(" ") + "}" when String if obj[0] == "\u029e" ":" + obj[1..-1] elsif _r obj.inspect # escape special characters else obj end when Atom "(atom " + _pr_str(obj.val, true) + ")" when nil "nil" else obj.to_s end end ================================================ FILE: impls/ruby/reader.rb ================================================ require_relative "types" class Reader def initialize(tokens) @position = 0 @tokens = tokens end def peek return @tokens[@position] end def next @position += 1 return @tokens[@position-1] end end def tokenize(str) re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ return str.scan(re).map{|m| m[0]}.select{ |t| t != "" && t[0..0] != ";" } end def parse_str(t) # trim and unescape return t[1..-2].gsub(/\\./, {"\\\\" => "\\", "\\n" => "\n", "\\\"" => '"'}) end def read_atom(rdr) token = rdr.next return case token when /^-?[0-9]+$/ then token.to_i # integer when /^-?[0-9][0-9.]*$/ then token.to_f # float when /^"(?:\\.|[^\\"])*"$/ then parse_str(token) # string when /^"/ then raise "expected '\"', got EOF" when /^:/ then "\u029e" + token[1..-1] # keyword when "nil" then nil when "true" then true when "false" then false else token.to_sym # symbol end end def read_list(rdr, klass, start="(", last =")") ast = klass.new token = rdr.next() if token != start raise "expected '" + start + "'" end while (token = rdr.peek) != last if not token raise "expected '" + last + "', got EOF" end ast.push(read_form(rdr)) end rdr.next return ast end def read_form(rdr) return case rdr.peek when ";" then nil when "'" then rdr.next; List.new [:quote, read_form(rdr)] when "`" then rdr.next; List.new [:quasiquote, read_form(rdr)] when "~" then rdr.next; List.new [:unquote, read_form(rdr)] when "~@" then rdr.next; List.new [:"splice-unquote", read_form(rdr)] when "^" then rdr.next; meta = read_form(rdr); List.new [:"with-meta", read_form(rdr), meta] when "@" then rdr.next; List.new [:deref, read_form(rdr)] when "(" then read_list(rdr, List, "(", ")") when ")" then raise "unexpected ')'" when "[" then read_list(rdr, Vector, "[", "]") when "]" then raise "unexpected ']'" when "{" then Hash[read_list(rdr, List, "{", "}").each_slice(2).to_a] when "}" then raise "unexpected '}'" else read_atom(rdr) end end def read_str(str) tokens = tokenize(str) return nil if tokens.size == 0 return read_form(Reader.new(tokens)) end ================================================ FILE: impls/ruby/run ================================================ #!/usr/bin/env bash exec ruby $(dirname $0)/${STEP:-stepA_mal}.rb "${@}" ================================================ FILE: impls/ruby/step0_repl.rb ================================================ require_relative "mal_readline" # read def READ(str) return str end # eval def EVAL(ast, env) return ast end # print def PRINT(exp) return exp end # repl def REP(str) return PRINT(EVAL(READ(str), {})) end # repl loop while line = _readline("user> ") puts REP(line) end ================================================ FILE: impls/ruby/step1_read_print.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) return ast end # print def PRINT(exp) return _pr_str(exp, true) end # repl def REP(str) return PRINT(EVAL(READ(str), {})) end # repl loop while line = _readline("user> ") begin puts REP(line) rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace.join("\n\t")}" end end ================================================ FILE: impls/ruby/step2_eval.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) #puts "EVAL: #{_pr_str(ast, true)}" case ast in Symbol raise "'" + ast.to_s + "' not found" if not env.key? ast return env[ast] in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in [a0, *] f = EVAL(a0, env) args = ast.drop(1) return f[*args.map{|a| EVAL(a, env)}] else # Empty list or scalar return ast end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = {} REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } repl_env[:+] = lambda {|a,b| a + b} repl_env[:-] = lambda {|a,b| a - b} repl_env[:*] = lambda {|a,b| a * b} repl_env[:/] = lambda {|a,b| a / b} # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace.join("\n\t")}" end end ================================================ FILE: impls/ruby/step3_env.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end return EVAL(a2, let_env) in [a0, *] f = EVAL(a0, env) args = ast.drop(1) return f[*args.map{|a| EVAL(a, env)}] else # Empty list or scalar return ast end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } repl_env.set(:+, lambda {|a,b| a + b}) repl_env.set(:-, lambda {|a,b| a - b}) repl_env.set(:*, lambda {|a,b| a * b}) repl_env.set(:/, lambda {|a,b| a / b}) # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace.join("\n\t")}" end end ================================================ FILE: impls/ruby/step4_if_fn_do.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end return EVAL(a2, let_env) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} return EVAL(ast.last, env) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond return EVAL(a2, env) else return EVAL(ast[3], env) end in :"fn*", a1, a2 return lambda {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) return f[*args.map{|a| EVAL(a, env)}] else # Empty list or scalar return ast end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace.join("\n\t")}" end end ================================================ FILE: impls/ruby/step5_tco.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/step6_file.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] if ARGV.size > 0 RE["(load-file \"" + ARGV[0] + "\")"] exit 0 end # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/step7_quote.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| if elt in List[:"splice-unquote", quoted] acc = List.new [:concat, quoted, acc] else acc = List.new [:cons, quasiquote(elt), acc] end end return acc end def quasiquote(ast) case ast when List if ast in List[:unquote, quoted] # ← fixed pattern quoted else qq_loop(ast) end when Vector List.new [:vec, qq_loop(ast)] when Hash, Symbol List.new [:quote, ast] else ast end end def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in :quote, a1 return a1 in :quasiquote, a1 ast = quasiquote(a1); # Continue loop (TCO) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] if ARGV.size > 0 RE["(load-file \"" + ARGV[0] + "\")"] exit 0 end # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/step8_macros.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| if elt in List[:"splice-unquote", quoted] acc = List.new [:concat, quoted, acc] else acc = List.new [:cons, quasiquote(elt), acc] end end return acc end def quasiquote(ast) case ast when List if ast in List[:unquote, quoted] # ← fixed pattern quoted else qq_loop(ast) end when Vector List.new [:vec, qq_loop(ast)] when Hash, Symbol List.new [:quote, ast] else ast end end def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in :quote, a1 return a1 in :quasiquote, a1 ast = quasiquote(a1); # Continue loop (TCO) in :defmacro!, a1, a2 func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function if f.is_macro ast = f[*args] next # Continue loop (TCO) end ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] if ARGV.size > 0 RE["(load-file \"" + ARGV[0] + "\")"] exit 0 end # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e puts "Error: #{e}" puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/step9_try.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| if elt in List[:"splice-unquote", quoted] acc = List.new [:concat, quoted, acc] else acc = List.new [:cons, quasiquote(elt), acc] end end return acc end def quasiquote(ast) case ast when List if ast in List[:unquote, quoted] # ← fixed pattern quoted else qq_loop(ast) end when Vector List.new [:vec, qq_loop(ast)] when Hash, Symbol List.new [:quote, ast] else ast end end def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in :quote, a1 return a1 in :quasiquote, a1 ast = quasiquote(a1); # Continue loop (TCO) in :defmacro!, a1, a2 func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) in [:"try*", a1, [:"catch*", key, handler]] begin return EVAL(a1, env) rescue Exception => exc if exc.is_a? MalException exc = exc.data else exc = exc.message end ast = handler env = Env.new(env, [key], [exc]) # Continue loop (TCO) end in [:"try*", a1] ast = a1 # Continue loop (TCO) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function if f.is_macro ast = f[*args] next # Continue loop (TCO) end ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) # core.mal: defined using the language itself RE["(def! not (fn* (a) (if a false true)))"] RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] if ARGV.size > 0 RE["(load-file \"" + ARGV[0] + "\")"] exit 0 end # repl loop while line = _readline("user> ") begin puts REP[line] rescue Exception => e if e.is_a? MalException puts "Error: #{_pr_str(e.data, true)}" else puts "Error: #{e}" end puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/stepA_mal.rb ================================================ require_relative "mal_readline" require_relative "types" require_relative "reader" require_relative "printer" require_relative "env" require_relative "core" # read def READ(str) return read_str(str) end # eval def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| if elt in List[:"splice-unquote", quoted] acc = List.new [:concat, quoted, acc] else acc = List.new [:cons, quasiquote(elt), acc] end end return acc end def quasiquote(ast) case ast when List if ast in List[:unquote, quoted] # ← fixed pattern quoted else qq_loop(ast) end when Vector List.new [:vec, qq_loop(ast)] when Hash, Symbol List.new [:quote, ast] else ast end end def EVAL(ast, env) while true if env.get_or_nil(:"DEBUG-EVAL") puts "EVAL: #{_pr_str(ast, true)}" end case ast in Symbol return env.get(ast) in Vector return Vector.new ast.map{|a| EVAL(a, env)} in Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} return new_hm # apply list in :def!, a1, a2 return env.set(a1, EVAL(a2, env)) in :"let*", a1, a2 let_env = Env.new(env) a1.each_slice(2) do |a,e| let_env.set(a, EVAL(e, let_env)) end env = let_env ast = a2 # Continue loop (TCO) in :quote, a1 return a1 in :quasiquote, a1 ast = quasiquote(a1); # Continue loop (TCO) in :defmacro!, a1, a2 func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) in :"rb*", a1 res = eval(a1) return case res when Array; List.new res else; res end in [:"try*", a1, [:"catch*", key, handler]] begin return EVAL(a1, env) rescue Exception => exc if exc.is_a? MalException exc = exc.data else exc = exc.message end ast = handler env = Env.new(env, [key], [exc]) # Continue loop (TCO) end in [:"try*", a1] ast = a1 # Continue loop (TCO) in [:do, *] ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) in [:if, a1, a2, *] cond = EVAL(a1, env) if cond ast = a2 # Continue loop (TCO) else ast = ast[3] # Continue loop (TCO) end in :"fn*", a1, a2 return Function.new(a2, env, a1) {|*args| EVAL(a2, Env.new(env, a1, List.new(args))) } in [a0, *] f = EVAL(a0, env) args = ast.drop(1) if f.class == Function if f.is_macro ast = f[*args] next # Continue loop (TCO) end ast = f.ast env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) # Continue loop (TCO) else return f[*args.map{|a| EVAL(a, env)}] end else # Empty list or scalar return ast end end end # print def PRINT(exp) return _pr_str(exp, true) end # repl repl_env = Env.new RE = lambda {|str| EVAL(READ(str), repl_env) } REP = lambda {|str| PRINT(EVAL(READ(str), repl_env)) } # core.rb: defined using ruby $core_ns.each do |k,v| repl_env.set(k,v) end repl_env.set(:eval, lambda {|ast| EVAL(ast, repl_env)}) repl_env.set(:"*ARGV*", List.new(ARGV.slice(1,ARGV.length) || [])) # core.mal: defined using the language itself RE["(def! *host-language* \"ruby\")"] RE["(def! not (fn* (a) (if a false true)))"] RE["(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"] RE["(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"] if ARGV.size > 0 RE["(load-file \"" + ARGV[0] + "\")"] exit 0 end # repl loop RE["(println (str \"Mal [\" *host-language* \"]\"))"] while line = _readline("user> ") begin puts REP[line] rescue Exception => e if e.is_a? MalException puts "Error: #{_pr_str(e.data, true)}" else puts "Error: #{e}" end puts "\t#{e.backtrace[0..100].join("\n\t")}" end end ================================================ FILE: impls/ruby/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/ruby/tests/stepA_mal.mal ================================================ ;; Testing basic ruby interop (rb* "7") ;=>7 (rb* "'7'") ;=>"7" (rb* "[7,8,9]") ;=>(7 8 9) (rb* "{\"abc\" => 789}") ;=>{"abc" 789} (rb* "print 'hello\n'") ;/hello ;=>nil (rb* "$foo=8;") (rb* "$foo") ;=>8 (rb* "['a','b','c'].map{|x| 'X'+x+'Y'}.join(' ')") ;=>"XaY XbY XcY" (rb* "[1,2,3].map{|x| 1+x}") ;=>(2 3 4) ================================================ FILE: impls/ruby/types.rb ================================================ require_relative "env" class MalException < StandardError attr_reader :data def initialize(data) @data = data end end class String # re-open and add seq def seq() return List.new self.split("") end end class List < Array attr_accessor :meta def conj(xs) xs.each{|x| self.unshift(x)} return self end def seq() return self end end class Vector < Array attr_accessor :meta def conj(xs) self.push(*xs) return self end def seq() return List.new self end end class Hash # re-open and add meta attr_accessor :meta end def sequential?(obj) return obj.is_a?(List) || obj.is_a?(Vector) end class Proc # re-open and add meta attr_accessor :meta end class Function < Proc attr_accessor :ast attr_accessor :env attr_accessor :params attr_accessor :is_macro def initialize(ast=nil, env=nil, params=nil, &block) super() @ast = ast @env = env @params = params @is_macro = false end def gen_env(args) return Env.new(@env, @params, args) end end class Atom attr_accessor :meta attr_accessor :val def initialize(val) @val = val end end ================================================ FILE: impls/ruby.2/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install ruby ================================================ FILE: impls/ruby.2/Makefile ================================================ SOURCES_BASE = errors.rb types.rb reader.rb printer.rb SOURCES_LISP = env.rb core.rb stepA_mal.rb SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.rb mal mal.rb: $(SOURCES) cat $+ | grep -v "^require_relative" > $@ mal: mal.rb echo "#!/usr/bin/env ruby" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.rb mal ================================================ FILE: impls/ruby.2/core.rb ================================================ require "readline" require_relative "types" module Mal module Core extend self def ns { Types::Symbol.for("+") => Types::Builtin.new("+") do |a, b| a + b end, Types::Symbol.for("-") => Types::Builtin.new("-") { |a, b| a - b }, Types::Symbol.for("*") => Types::Builtin.new("*") { |a, b| a * b }, Types::Symbol.for("/") => Types::Builtin.new("/") { |a, b| a / b }, Types::Symbol.for("list") => Types::Builtin.new("list") do |*mal| list = Types::List.new mal.each { |m| list << m } list end, Types::Symbol.for("list?") => Types::Builtin.new("list?") do |list = nil| list.is_a?(Types::List) ? Types::True.instance : Types::False.instance end, Types::Symbol.for("vector?") => Types::Builtin.new("vector?") do |vector = nil| vector.is_a?(Types::Vector) ? Types::True.instance : Types::False.instance end, Types::Symbol.for("string?") => Types::Builtin.new("string?") do |string = nil| string.is_a?(Types::String) ? Types::True.instance : Types::False.instance end, Types::Symbol.for("number?") => Types::Builtin.new("number?") do |number = nil| number.is_a?(Types::Number) ? Types::True.instance : Types::False.instance end, Types::Symbol.for("fn?") => Types::Builtin.new("fn?") do |fn = nil| fn.is_a?(Types::Callable) && !fn.is_macro? ? Types::True.instance : Types::False.instance end, Types::Symbol.for("macro?") => Types::Builtin.new("macro?") do |macro = nil| macro.is_a?(Types::Callable) && macro.is_macro? ? Types::True.instance : Types::False.instance end, Types::Symbol.for("empty?") => Types::Builtin.new("empty?") do |list_or_vector = nil| is_empty = case list_or_vector when Types::List, Types::Vector list_or_vector.empty? else true end is_empty ? Types::True.instance : Types::False.instance end, Types::Symbol.for("count") => Types::Builtin.new("count") do |*mal| count = if mal.any? case mal.first when Types::List, Types::Vector mal.first.size else 0 end else 0 end Types::Number.new(count) end, Types::Symbol.for("=") => Types::Builtin.new("=") do |a, b| if a.nil? || b.nil? Types::False.instance else if a == b Types::True.instance else Types::False.instance end end end, Types::Symbol.for("<") => Types::Builtin.new("<") do |a, b| if a.nil? || b.nil? Types::False.instance else if a.is_a?(Types::Number) && b.is_a?(Types::Number) if a.value < b.value Types::True.instance else Types::False.instance end else Types::False.instance end end end, Types::Symbol.for("<=") => Types::Builtin.new("<=") do |a, b| if a.nil? || b.nil? Types::False.instance else if a.is_a?(Types::Number) && b.is_a?(Types::Number) if a.value <= b.value Types::True.instance else Types::False.instance end else Types::False.instance end end end, Types::Symbol.for(">") => Types::Builtin.new(">") do |a, b| if a.nil? || b.nil? Types::False.instance else if a.is_a?(Types::Number) && b.is_a?(Types::Number) if a.value > b.value Types::True.instance else Types::False.instance end else Types::False.instance end end end, Types::Symbol.for(">=") => Types::Builtin.new(">=") do |a, b| if a.nil? || b.nil? Types::False.instance else if a.is_a?(Types::Number) && b.is_a?(Types::Number) if a.value >= b.value Types::True.instance else Types::False.instance end else Types::False.instance end end end, Types::Symbol.for("pr-str") => Types::Builtin.new("pr-str") do |*mal| Types::String.new(mal.map { |m| Mal.pr_str(m, true) }.join(" ")) end, Types::Symbol.for("str") => Types::Builtin.new("str") do |*mal| Types::String.new(mal.map { |m| Mal.pr_str(m, false) }.join("")) end, Types::Symbol.for("prn") => Types::Builtin.new("prn") do |*mal| puts mal.map { |m| Mal.pr_str(m, true) }.join(" ") Types::Nil.instance end, Types::Symbol.for("println") => Types::Builtin.new("println") do |*mal| puts mal.map { |m| Mal.pr_str(m, false) }.join(" ") Types::Nil.instance end, Types::Symbol.for("read-string") => Types::Builtin.new("read-string") do |string = nil| if string.is_a?(Types::String) Mal.read_str(string.value) else Types::Nil.instance end end, Types::Symbol.for("slurp") => Types::Builtin.new("slurp") do |file = nil| if file.is_a?(Types::String) if File.exist?(file.value) Types::String.new(File.read(file.value)) else raise FileNotFoundError, file.value end else Types::Nil.instance end end, Types::Symbol.for("atom") => Types::Builtin.new("atom") do |mal| Types::Atom.new(mal) end, Types::Symbol.for("atom?") => Types::Builtin.new("atom?") do |maybe_atom| maybe_atom.is_a?(Types::Atom) ? Types::True.instance : Types::False.instance end, Types::Symbol.for("deref") => Types::Builtin.new("deref") do |maybe_atom| maybe_atom.is_a?(Types::Atom) ? maybe_atom.value : Types::Nil.instance end, Types::Symbol.for("reset!") => Types::Builtin.new("reset!") do |atom, value| if value.nil? value = Types::Nil.instance end atom.value = value end, Types::Symbol.for("swap!") => Types::Builtin.new("swap!") do |atom, fn, *args| atom.value = fn.call(Types::Args.new([atom.value, *args])) end, Types::Symbol.for("cons") => Types::Builtin.new("cons") do |val, list_or_vector| Types::List.new([val, *list_or_vector]) end, Types::Symbol.for("concat") => Types::Builtin.new("concat") do |*mal| list = Types::List.new mal.each do |l| list.concat(l) end list end, Types::Symbol.for("vec") => Types::Builtin.new("vec") do |list_or_vector| case list_or_vector when Types::List vec = Types::Vector.new list_or_vector.each do |m| vec << m end vec when Types::Vector list_or_vector else raise TypeError, "invalid `vec` arguments, must be vector or list" end end, Types::Symbol.for("nth") => Types::Builtin.new("nth") do |list_or_vector, index| result = list_or_vector[index.value] raise IndexError, "Index #{index.value} is out of bounds" if result.nil? result end, Types::Symbol.for("first") => Types::Builtin.new("first") do |list_or_vector| if !list_or_vector.nil? && list_or_vector != Types::Nil.instance result = list_or_vector.first if result.nil? result = Types::Nil.instance end result else Types::Nil.instance end end, Types::Symbol.for("rest") => Types::Builtin.new("rest") do |list_or_vector| Types::List.new ( case list_or_vector when Types::List, Types::Vector if list_or_vector.empty? [] else list_or_vector[1..] end when Types::Nil [] else raise TypeError, "Unable to `rest`, too nervous" end ) end, Types::Symbol.for("throw") => Types::Builtin.new("throw") do |to_throw| raise MalError, to_throw end, Types::Symbol.for("apply") => Types::Builtin.new("apply") do |fn, *rest| args = Types::Args.new rest.flatten(1).each do |a| args << a end fn.call(args) end, Types::Symbol.for("map") => Types::Builtin.new("map") do |fn, *rest| results = Types::List.new rest.flatten(1).each do |a| results << fn.call(Types::Args.new([a])) end results end, Types::Symbol.for("nil?") => Types::Builtin.new("nil?") do |mal| if mal == Types::Nil.instance Types::True.instance else Types::False.instance end end, Types::Symbol.for("true?") => Types::Builtin.new("true?") do |mal| if mal == Types::True.instance Types::True.instance else Types::False.instance end end, Types::Symbol.for("false?") => Types::Builtin.new("false?") do |mal| if mal == Types::False.instance Types::True.instance else Types::False.instance end end, Types::Symbol.for("symbol?") => Types::Builtin.new("symbol?") do |mal| if mal.is_a?(Types::Symbol) Types::True.instance else Types::False.instance end end, Types::Symbol.for("keyword?") => Types::Builtin.new("keyword?") do |mal| if mal.is_a?(Types::Keyword) Types::True.instance else Types::False.instance end end, Types::Symbol.for("symbol") => Types::Builtin.new("symbol") do |string| if string Types::Symbol.for(string.value) else Types::Nil.instance end end, Types::Symbol.for("keyword") => Types::Builtin.new("keyword") do |keyword| if keyword Types::Keyword.for(keyword.value) else Types::Nil.instance end end, Types::Symbol.for("vector") => Types::Builtin.new("vector") do |*items| vector = Types::Vector.new items.each do |i| vector << i end vector end, Types::Symbol.for("sequential?") => Types::Builtin.new("sequential?") do |list_or_vector| case list_or_vector when Types::List, Types::Vector Types::True.instance else Types::False.instance end end, Types::Symbol.for("hash-map") => Types::Builtin.new("hash-map") do |*items| raise UnbalancedHashmapError, "unbalanced hashmap error, arguments must be even" if items&.size&.odd? hashmap = Types::Hashmap.new items.each_slice(2) do |(k, v)| hashmap[k] = v end hashmap end, Types::Symbol.for("map?") => Types::Builtin.new("map?") do |mal| if mal.is_a?(Types::Hashmap) Types::True.instance else Types::False.instance end end, Types::Symbol.for("assoc") => Types::Builtin.new("assoc") do |hashmap, *items| raise UnbalancedHashmapError, "unbalanced hashmap error, arguments must be even" if items.size&.odd? new_hashmap = hashmap.dup items.each_slice(2) do |(k, v)| new_hashmap[k] = v end new_hashmap end, Types::Symbol.for("dissoc") => Types::Builtin.new("dissoc") do |hashmap, *keys| new_hashmap = Types::Hashmap.new hashmap.keys.each do |k| next if keys.include?(k) new_hashmap[k] = hashmap[k] end new_hashmap end, Types::Symbol.for("get") => Types::Builtin.new("get") do |hashmap, key| if Types::Hashmap === hashmap && key && hashmap.key?(key) hashmap[key] else Types::Nil.instance end end, Types::Symbol.for("contains?") => Types::Builtin.new("contains?") do |hashmap, key| if Types::Hashmap === hashmap && key && hashmap.key?(key) Types::True.instance else Types::False.instance end end, Types::Symbol.for("keys") => Types::Builtin.new("keys") do |hashmap| if Types::Hashmap === hashmap Types::List.new(hashmap.keys) else Types::Nil.instance end end, Types::Symbol.for("vals") => Types::Builtin.new("vals") do |hashmap| if Types::Hashmap === hashmap Types::List.new(hashmap.values) else Types::Nil.instance end end, Types::Symbol.for("readline") => Types::Builtin.new("readline") do |prompt = nil| prompt = if prompt.nil? "user> " else prompt.value end input = Readline.readline(prompt) if input.nil? Types::Nil.instance else Types::String.new(input) end end, Types::Symbol.for("meta") => Types::Builtin.new("meta") do |value| case value when Types::List, Types::Vector, Types::Hashmap, Types::Callable value.meta else Types::Nil.instance end end, Types::Symbol.for("with-meta") => Types::Builtin.new("with-meta") do |value, meta| case value when Types::List, Types::Vector, Types::Hashmap, Types::Callable new_value = value.dup new_value.meta = meta new_value else raise TypeError, "Unable to use meta with #{Mal.pr_str(value)}" end end, Types::Symbol.for("time-ms") => Types::Builtin.new("time-ms") do Types::Number.new((Time.now.to_f.round(3) * 1000).to_i) end, Types::Symbol.for("conj") => Types::Builtin.new("conj") do |list_or_vector, *new_elems| case list_or_vector when Types::List Types::List.new([*new_elems.reverse, *list_or_vector]) when Types::Vector Types::Vector.new([*list_or_vector, *new_elems]) else raise TypeError, "Unable to `conj` with <#{Mal.pr_str(list_or_vector)}>, must be list or vector" end end, Types::Symbol.for("seq") => Types::Builtin.new("seq") do |sequential| case sequential when Types::List if sequential.any? sequential else Types::Nil.instance end when Types::Vector if sequential.any? Types::List.new(sequential) else Types::Nil.instance end when Types::String if !sequential.value.empty? Types::List.new(sequential.value.chars.map { |c| Types::String.new(c) }) else Types::Nil.instance end when Types::Nil Types::Nil.instance else raise TypeError, "Unable to `seq` with <#{Mal.pr_str(sequential)}>, must be list, vector, string, or nil" end end } end end end ================================================ FILE: impls/ruby.2/env.rb ================================================ require_relative "errors" require_relative "types" module Mal class Env def initialize(outer = nil, binds = Types::List.new, exprs = Types::List.new) @outer = outer @data = {} spread_next = false binds.each_with_index do |b, i| if b.value == "&" spread_next = true else if spread_next set(b, Types::List.new(exprs[(i - 1)..]) || Types::Nil.instance) break else set(b, exprs[i] || Types::Nil.instance) end end end end def set(k, v) @data[k] = v end def get(k) if @data.key?(k) @data[k] elsif !@outer.nil? @outer.get(k) else 0 end end end end ================================================ FILE: impls/ruby.2/errors.rb ================================================ module Mal class Error < ::StandardError; end class TypeError < ::TypeError; end class MalError < Error attr_reader :value def initialize(value) @value = value end def message value.inspect end end class FileNotFoundError < Error; end class IndexError < TypeError; end class SkipCommentError < Error; end class InvalidHashmapKeyError < TypeError; end class InvalidIfExpressionError < TypeError; end class InvalidLetBindingsError < TypeError; end class InvalidReaderPositionError < Error; end class InvalidTypeError < TypeError; end class NotCallableError < Error; end class SymbolNotFoundError < Error; end class SyntaxError < TypeError; end class UnbalancedEscapingError < Error; end class UnbalancedHashmapError < Error; end class UnbalancedListError < Error; end class UnbalancedStringError < Error; end class UnbalancedVectorError < Error; end class UnknownError < Error attr_reader :original_error def initialize(original_error) @original_error = original_error end def inspect "UnknownError :: #{original_error.inspect}" end def message "UnknownError<#{original_error.class}> :: #{original_error.message}" end end end ================================================ FILE: impls/ruby.2/printer.rb ================================================ require_relative "errors" require_relative "types" module Mal extend self def pr_str(mal, print_readably = false) case mal when Types::List "(#{mal.map { |m| pr_str(m, print_readably) }.join(" ")})" when Types::Vector "[#{mal.map { |m| pr_str(m, print_readably) }.join(" ")}]" when Types::Hashmap "{#{mal.map { |k, v| [pr_str(k, print_readably), pr_str(v, print_readably)].join(" ") }.join(" ")}}" when Types::Keyword if print_readably pr_str_keyword(mal) else ":#{mal.value}" end when Types::String if print_readably pr_str_string(mal) else mal.value end when Types::Atom "(atom #{pr_str(mal.value, print_readably)})" when Types::Base, Types::Callable mal.inspect else raise InvalidTypeError, "unable to print value <#{mal.inspect}>" end end def pr_str_keyword(mal) value = mal.value.dup value.gsub!('\\','\\\\\\\\') value.gsub!("\n",'\n') value.gsub!('"','\"') ":#{value}" end def pr_str_string(mal) value = mal.value.dup value.gsub!('\\','\\\\\\\\') value.gsub!("\n",'\n') value.gsub!('"','\"') "\"#{value}\"" end end ================================================ FILE: impls/ruby.2/reader.rb ================================================ require_relative "errors" require_relative "types" module Mal extend self TOKEN_REGEX = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/ def read_atom(reader) case reader.peek when /\A"(?:\\.|[^\\"])*"\z/ read_string(reader) when /\A"/ raise UnbalancedStringError, "unbalanced string << #{reader.peek.inspect} >>" when /\A:/ read_keyword(reader) when "nil" read_nil(reader) when "true" read_true(reader) when "false" read_false(reader) when /\A-?\d+(\.\d+)?/ read_number(reader) when /\A;/ raise SkipCommentError else read_symbol(reader) end end def read_deref(reader) list = Types::List.new list << Types::Symbol.for("deref") list << read_form(reader) list end def read_false(reader) reader.advance! Types::False.instance end def read_form(reader) case reader.peek when "'" read_quote(reader.advance!) when "`" read_quasiquote(reader.advance!) when "~" read_unquote(reader.advance!) when "~@" read_splice_unquote(reader.advance!) when "@" read_deref(reader.advance!) when "^" read_with_metadata(reader.advance!) when "(" read_list(reader.advance!) when "[" read_vector(reader.advance!) when "{" read_hashmap(reader.advance!) else read_atom(reader) end end def read_hashmap(reader) hashmap = Types::Hashmap.new until reader.peek == "}" key = read_form(reader) unless Types::String === key || Types::Keyword === key raise InvalidHashmapKeyError, "invalid hashmap key, must be string or keyword" end if reader.peek != "}" value = read_form(reader) else raise UnbalancedHashmapError, "unbalanced hashmap error, missing closing '}'" end hashmap[key] = value end reader.advance! hashmap rescue Error => e case e when InvalidReaderPositionError raise UnbalancedHashmapError, "unbalanced hashmap error, missing closing '}'" else raise e end end def read_keyword(reader) value = reader.next.dup[1...] substitute_escaped_chars!(value) Types::Keyword.for(value) end def read_list(reader) list = Types::List.new until reader.peek == ")" list << read_form(reader) end reader.advance! list rescue Error => e case e when InvalidReaderPositionError raise UnbalancedListError, "unbalanced list error, missing closing ')'" else raise e end end def read_nil(reader) reader.advance! Types::Nil.instance end def read_number(reader) case reader.peek when /\d+\.\d+/ Types::Number.new(reader.next.to_f) when /\d+/ Types::Number.new(reader.next.to_i) else raise InvalidTypeError, "invalid number syntax, only supports integers/floats" end end def read_quasiquote(reader) list = Types::List.new list << Types::Symbol.for("quasiquote") list << read_form(reader) list end def read_quote(reader) list = Types::List.new list << Types::Symbol.for("quote") list << read_form(reader) list end def read_splice_unquote(reader) list = Types::List.new list << Types::Symbol.for("splice-unquote") list << read_form(reader) list end def read_str(input) tokenized = tokenize(input) raise SkipCommentError if tokenized.empty? read_form(Reader.new(tokenized)) end def read_string(reader) raw_value = reader.next.dup value = raw_value[1...-1] substitute_escaped_chars!(value) if raw_value.length <= 1 || raw_value[-1] != '"' raise UnbalancedStringError, "unbalanced string error, missing closing '\"'" end Types::String.new(value) end def read_symbol(reader) Types::Symbol.for(reader.next) end def read_true(reader) reader.advance! Types::True.instance end def read_unquote(reader) list = Types::List.new list << Types::Symbol.for("unquote") list << read_form(reader) list end def read_vector(reader) vector = Types::Vector.new until reader.peek == "]" vector << read_form(reader) end reader.advance! vector rescue Error => e case e when InvalidReaderPositionError raise UnbalancedVectorError, "unbalanced vector error, missing closing ']'" else raise e end end def read_with_metadata(reader) list = Types::List.new list << Types::Symbol.for("with-meta") first = read_form(reader) second = read_form(reader) list << second list << first list end def tokenize(input) input.scan(TOKEN_REGEX).flatten.each_with_object([]) do |token, tokens| if token != "" && !token.start_with?(";") tokens << token end end end class Reader attr_reader :tokens def initialize(tokens) @position = 0 @tokens = tokens end def advance! @position += 1 self end def next value = peek @position += 1 value end def peek if @position > @tokens.size - 1 raise InvalidReaderPositionError, "invalid reader position error, unable to parse mal expression" end @tokens[@position] end end private def substitute_escaped_chars!(string_or_keyword) string_or_keyword.gsub!(/\\./, {"\\\\" => "\\", "\\n" => "\n", "\\\"" => '"'}) end end ================================================ FILE: impls/ruby.2/run ================================================ #!/usr/bin/env bash exec ruby $(dirname $0)/${STEP:-stepA_mal}.rb "${@}" ================================================ FILE: impls/ruby.2/step0_repl.rb ================================================ require "readline" module Mal extend self def READ(input) input end def EVAL(input) input end def PRINT(input) input end def rep(input) PRINT(EVAL(READ(input))) end end while input = Readline.readline("user> ") puts Mal.rep(input) end ================================================ FILE: impls/ruby.2/step1_read_print.rb ================================================ require "readline" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def READ(input) read_str(input) end def EVAL(input) input end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input))) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue SkipCommentError nil end end while input = Readline.readline("user> ") puts Mal.rep(input) end puts ================================================ FILE: impls/ruby.2/step2_eval.rb ================================================ require "readline" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self @repl_env = { '+' => -> (a, b) { a + b }, '-' => -> (a, b) { a - b }, '*' => -> (a, b) { a * b }, '/' => -> (a, b) { a / b }, } def READ(input) read_str(input) end def EVAL(ast, environment) # puts "EVAL: #{pr_str(ast, true)}" case ast when Types::Symbol if @repl_env.key?(ast.value) @repl_env[ast.value] else raise SymbolNotFoundError, "Error! Symbol #{ast.value} not found." end when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end evaluated = Types::List.new ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) maybe_callable.call(*evaluated[1..]) else raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end else return ast end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." end end while input = Readline.readline("user> ") puts Mal.rep(input) end puts ================================================ FILE: impls/ruby.2/step3_env.rb ================================================ require "readline" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self @repl_env = Env.new @repl_env.set(Types::Symbol.for('+'), -> (a, b) { a + b }) @repl_env.set(Types::Symbol.for('-'), -> (a, b) { a - b }) @repl_env.set(Types::Symbol.for('*'), -> (a, b) { a * b }) @repl_env.set(Types::Symbol.for('/'), -> (a, b) { a / b }) def READ(input) read_str(input) end def EVAL(ast, environment) case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? EVAL(val, e) else Types::Nil.instance end else evaluated = Types::List.new ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) maybe_callable.call(*evaluated[1..]) else raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end else return ast end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." end end while input = Readline.readline("user> ") puts Mal.rep(input) end puts ================================================ FILE: impls/ruby.2/step4_if_fn_do.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end Mal.rep("(def! not (fn* (a) (if a false true)))") end def READ(input) read_str(input) end def EVAL(ast, environment) case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? EVAL(val, e) else Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? evaluated = Types::List.new values.each do |v| evaluated << EVAL(v, environment) end evaluated.last else Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? EVAL(when_false, environment) else Types::Nil.instance end else if !when_true.nil? EVAL(when_true, environment) else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end else evaluated = Types::List.new ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) maybe_callable.call(Types::Args.new(evaluated[1..])) else raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end else return ast end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." end end Mal.boot_repl! while input = Readline.readline("user> ") puts Mal.rep(input) end puts ================================================ FILE: impls/ruby.2/step5_tco.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end Mal.rep("(def! not (fn* (a) (if a false true)))") end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end args = Types::List.new ast[1..].each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) else return maybe_callable.call(Types::Args.new(args)) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." end end Mal.boot_repl! while input = Readline.readline("user> ") puts Mal.rep(input) end puts ================================================ FILE: impls/ruby.2/step6_file.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end @repl_env.set( Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") Mal.rep("(def! *ARGV* (list))") if !run_application? end def run_application? ARGV.any? end def run! Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") Mal.rep("(load-file #{ARGV.first.inspect})") end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end args = Types::List.new ast[1..].each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) else return maybe_callable.call(Types::Args.new(args)) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue SkipCommentError nil end end Mal.boot_repl! if Mal.run_application? Mal.run! else while input = Readline.readline("user> ") val = Mal.rep(input) puts val unless val.nil? end puts end ================================================ FILE: impls/ruby.2/step7_quote.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end @repl_env.set( Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") Mal.rep("(def! *ARGV* (list))") if !run_application? end def run_application? ARGV.any? end def run! Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") Mal.rep("(load-file #{ARGV.first.inspect})") end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end when Types::Symbol.for("quote") _, ret = ast return ret when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end args = Types::List.new ast[1..].each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) else return maybe_callable.call(Types::Args.new(args)) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue SkipCommentError nil end def quasiquote_list(mal) result = Types::List.new mal.reverse_each do |elt| if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") result = Types::List.new([ Types::Symbol.for("concat"), elt[1], result ]) else result = Types::List.new([ Types::Symbol.for("cons"), quasiquote(elt), result ]) end end result end def quasiquote(mal) case mal when Types::List if mal.first == Types::Symbol.for("unquote") mal[1] else quasiquote_list(mal) end when Types::Vector Types::List.new([ Types::Symbol.for("vec"), quasiquote_list(mal) ]) when Types::Hashmap, Types::Symbol Types::List.new([ Types::Symbol.for("quote"), mal ]) else mal end end end Mal.boot_repl! if Mal.run_application? Mal.run! else while input = Readline.readline("user> ") val = Mal.rep(input) puts val unless val.nil? end puts end ================================================ FILE: impls/ruby.2/step8_macros.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end @repl_env.set( Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if !run_application? Mal.rep("(def! *ARGV* (list))") Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") end end def run_application? ARGV.any? end def run! Mal.rep("(def! *ARGV* (list #{ARGV[1..].map(&:inspect).join(" ")}))") Mal.rep("(load-file #{ARGV.first.inspect})") end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("defmacro!") _, sym, val = ast result = EVAL(val, environment) case result when Types::Function return environment.set(sym, result.to_macro) else raise TypeError end when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end when Types::Symbol.for("quote") _, ret = ast return ret when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end raw_args = ast[1..] if maybe_callable.is_macro? if raw_args.any? ast = maybe_callable.call(Types::Args.new(raw_args)) else ast = maybe_callable.call end next end args = Types::List.new raw_args.each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) else return maybe_callable.call(Types::Args.new(args)) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue SkipCommentError nil rescue TypeError nil end def quasiquote_list(mal) result = Types::List.new mal.reverse_each do |elt| if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") result = Types::List.new([ Types::Symbol.for("concat"), elt[1], result ]) else result = Types::List.new([ Types::Symbol.for("cons"), quasiquote(elt), result ]) end end result end def quasiquote(mal) case mal when Types::List if mal.first == Types::Symbol.for("unquote") mal[1] else quasiquote_list(mal) end when Types::Vector Types::List.new([ Types::Symbol.for("vec"), quasiquote_list(mal) ]) when Types::Hashmap, Types::Symbol Types::List.new([ Types::Symbol.for("quote"), mal ]) else mal end end end Mal.boot_repl! if Mal.run_application? Mal.run! else while input = Readline.readline("user> ") val = Mal.rep(input) puts val unless val.nil? end puts end ================================================ FILE: impls/ruby.2/step9_try.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end @repl_env.set( Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if !run_application? Mal.rep("(def! *ARGV* (list))") Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") end end def run_application? ARGV.any? end def run! args = ARGV[1..].map(&:inspect) if args.any? Mal.rep("(def! *ARGV* (list #{args.join(" ")}))") else Mal.rep("(def! *ARGV* (list))") end file = File.absolute_path(ARGV.first) Dir.chdir(File.dirname(file)) do Mal.rep("(load-file #{file.inspect})") end end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("defmacro!") _, sym, val = ast result = EVAL(val, environment) case result when Types::Function return environment.set(sym, result.to_macro) else raise TypeError end when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end when Types::Symbol.for("quote") _, ret = ast return ret when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast begin return EVAL(to_try, environment) rescue => e raise e if catch_list.nil? || catch_list&.empty? raise SyntaxError, "try* missing proper catch*" unless catch_list&.first == Types::Symbol.for("catch*") _, exception_symbol, exception_handler = catch_list value = if e.is_a?(MalError) e.value else Types::String.new(e.message) end return EVAL( exception_handler, Env.new( environment, Types::List.new([exception_symbol]), Types::List.new([value]) ) ) end else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end raw_args = ast[1..] if maybe_callable.is_macro? if raw_args.any? ast = maybe_callable.call(Types::Args.new(raw_args)) else ast = maybe_callable.call end next end args = Types::List.new raw_args.each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) else return maybe_callable.call(Types::Args.new(args)) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue MalError => e "Error: #{pr_str(e.value, true)}" rescue Error, TypeError => e "#{e.class} -- #{e.message}" rescue SkipCommentError nil end def quasiquote_list(mal) result = Types::List.new mal.reverse_each do |elt| if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") result = Types::List.new([ Types::Symbol.for("concat"), elt[1], result ]) else result = Types::List.new([ Types::Symbol.for("cons"), quasiquote(elt), result ]) end end result end def quasiquote(mal) case mal when Types::List if mal.first == Types::Symbol.for("unquote") mal[1] else quasiquote_list(mal) end when Types::Vector Types::List.new([ Types::Symbol.for("vec"), quasiquote_list(mal) ]) when Types::Hashmap, Types::Symbol Types::List.new([ Types::Symbol.for("quote"), mal ]) else mal end end end Mal.boot_repl! if Mal.run_application? Mal.run! else while input = Readline.readline("user> ") val = Mal.rep(input) puts val unless val.nil? end puts end ================================================ FILE: impls/ruby.2/stepA_mal.rb ================================================ require "readline" require_relative "core" require_relative "env" require_relative "errors" require_relative "printer" require_relative "reader" module Mal extend self def boot_repl! @repl_env = Env.new Core.ns.each do |k, v| @repl_env.set(k, v) end @repl_env.set( Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") Mal.rep("(def! *host-language* \"ruby.2\")") Mal.rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if !run_application? Mal.rep("(def! *ARGV* (list))") Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") end end def run_application? ARGV.any? end def run! args = ARGV[1..].map(&:inspect) if args.any? Mal.rep("(def! *ARGV* (list #{args.join(" ")}))") else Mal.rep("(def! *ARGV* (list))") end file = File.absolute_path(ARGV.first) Dir.chdir(File.dirname(file)) do Mal.rep("(load-file #{file.inspect})") end end def READ(input) read_str(input) end def EVAL(ast, environment) loop do case environment.get(Types::Symbol.for("DEBUG-EVAL")) when 0, Types::Nil, Types::False else puts "EVAL: #{pr_str(ast, true)}" end case ast when Types::Symbol value = environment.get(ast) if value == 0 raise SymbolNotFoundError, "'#{ast.value}' not found" end return value when Types::Vector vec = Types::Vector.new ast.each { |i| vec << EVAL(i, environment) } return vec when Types::Hashmap hashmap = Types::Hashmap.new ast.each { |k, v| hashmap[k] = EVAL(v, environment) } return hashmap when Types::List if ast.size == 0 return ast end case ast.first when Types::Symbol.for("def!") _, sym, val = ast return environment.set(sym, EVAL(val, environment)) when Types::Symbol.for("defmacro!") _, sym, val = ast result = EVAL(val, environment) case result when Types::Function return environment.set(sym, result.to_macro) else raise TypeError, "defmacro! must be bound to a function" end when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast bindings = bindings.dup # TODO note bugfix let bindings w/ TCO loop and destructive mutation (shift) unless Types::List === bindings || Types::Vector === bindings raise InvalidLetBindingsError, "let* bindings must be a list or vector" end until bindings.empty? k, v = bindings.shift(2) raise InvalidLetBindingsError, "Invalid let* bindings 'nil' key" if k.nil? v = Types::Nil.instance if v.nil? e.set(k, EVAL(v, e)) end if !val.nil? # Continue loop ast = val environment = e else return Types::Nil.instance end when Types::Symbol.for("do") _, *values = ast if !values.nil? && values.any? values[0...-1].each do |v| EVAL(v, environment) end # Continue loop ast = values.last else return Types::Nil.instance end when Types::Symbol.for("if") _, condition, when_true, when_false = ast case EVAL(condition, environment) when Types::False.instance, Types::Nil.instance if !when_false.nil? # Continue loop ast = when_false else return Types::Nil.instance end else if !when_true.nil? # Continue loop ast = when_true else raise InvalidIfExpressionError, "No expression to evaluate when true" end end when Types::Symbol.for("fn*") _, binds, to_eval = ast return Types::Function.new(to_eval, binds, environment) do |*exprs| EVAL(to_eval, Env.new(environment, binds, exprs)) end when Types::Symbol.for("quote") _, ret = ast return ret when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast begin return EVAL(to_try, environment) rescue => e raise e if catch_list.nil? || catch_list&.empty? raise SyntaxError, "try* missing proper catch*" unless catch_list&.first == Types::Symbol.for("catch*") _, exception_symbol, exception_handler = catch_list value = if e.is_a?(MalError) e.value else Types::String.new(e.message) end return EVAL( exception_handler, Env.new( environment, Types::List.new([exception_symbol]), Types::List.new([value]) ) ) end else maybe_callable = EVAL(ast.first, environment) if !maybe_callable.respond_to?(:call) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end raw_args = ast[1..] if maybe_callable.is_macro? if raw_args.any? ast = maybe_callable.call(Types::Args.new(raw_args)) else ast = maybe_callable.call end next end args = Types::List.new raw_args.each { |i| args << EVAL(i, environment) } if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, args, ) elsif args.any? return maybe_callable.call(Types::Args.new(args)) else return maybe_callable.call(Types::Args.new) end end else return ast end end end def PRINT(input) pr_str(input, true) end def rep(input) PRINT(EVAL(READ(input), @repl_env)) rescue InvalidHashmapKeyError => e "Error! Hashmap keys can only be strings or keywords." rescue NotCallableError => e e.message rescue SymbolNotFoundError => e e.message rescue UnbalancedEscapingError => e "Error! Detected unbalanced escaping. Check for matching '\\'." rescue UnbalancedHashmapError => e "Error! Detected unbalanced list. Check for matching '}'." rescue UnbalancedListError => e "Error! Detected unbalanced list. Check for matching ')'." rescue UnbalancedStringError => e "Error! Detected unbalanced string. Check for matching '\"'." rescue UnbalancedVectorError => e "Error! Detected unbalanced list. Check for matching ']'." rescue MalError => e "Error: #{pr_str(e.value, true)}" rescue Error, TypeError => e "#{e.class} -- #{e.message}" rescue SkipCommentError nil end def quasiquote_list(mal) result = Types::List.new mal.reverse_each do |elt| if elt.is_a?(Types::List) && elt.first == Types::Symbol.for("splice-unquote") result = Types::List.new([ Types::Symbol.for("concat"), elt[1], result ]) else result = Types::List.new([ Types::Symbol.for("cons"), quasiquote(elt), result ]) end end result end def quasiquote(mal) case mal when Types::List if mal.first == Types::Symbol.for("unquote") mal[1] else quasiquote_list(mal) end when Types::Vector Types::List.new([ Types::Symbol.for("vec"), quasiquote_list(mal) ]) when Types::Hashmap, Types::Symbol Types::List.new([ Types::Symbol.for("quote"), mal ]) else mal end end end Mal.boot_repl! if Mal.run_application? Mal.run! else while input = Readline.readline("user> ") val = Mal.rep(input) puts val unless val.nil? end puts end ================================================ FILE: impls/ruby.2/types.rb ================================================ module Mal module Types class Args < ::Array end class List < ::Array def meta @meta ||= Types::Nil.instance end def meta=(value) @meta = value end def to_list self end end class Vector < ::Array def meta @meta ||= Types::Nil.instance end def meta=(value) @meta = value end def to_list List.new(self) end end class Hashmap < ::Hash def meta @meta ||= Types::Nil.instance end def meta=(value) @meta = value end end class Base < ::Struct.new(:value) def inspect value.inspect end end class String < Base; end class Atom < Base def inspect "Atom<#{value.inspect}>" end end class Keyword < Base def self.for(value) @_keywords ||= {} if @_keywords.key?(value) @_keywords[value] else @_keywords[value] = new(value) end end end class Number < Base def +(other) self.class.new(value + other.value) end def -(other) self.class.new(value - other.value) end def *(other) self.class.new(value * other.value) end def /(other) self.class.new(value / other.value) end end class Symbol < Base def self.for(value) @_symbols ||= {} if @_symbols.key?(value) @_symbols[value] else @_symbols[value] = new(value) end end def inspect value end end class Nil < Base def self.instance @_instance ||= new(nil) end def inspect "nil" end end class True < Base def self.instance @_instance ||= new(true) end end class False < Base def self.instance @_instance ||= new(false) end end class Callable def initialize(&block) @fn = block end def call(args = nil) args = Types::Args.new if args.nil? raise unless args.is_a?(Types::Args) @fn.call(*args) end def inspect raise NotImplementedError, "invalid callable" end def is_mal_fn? false end def is_macro? false end def meta @meta ||= Types::Nil.instance end def meta=(value) @meta = value end end class Builtin < Callable attr_reader :name def initialize(name, &block) @name = name @fn = block end def inspect "#" end end class Function < Callable attr_reader :ast, :params, :env def initialize(ast, params, env, &block) @ast = ast @params = params @env = env @fn = block end def inspect "#" end def is_mal_fn? true end def to_macro Macro.new(ast, params, env, &@fn) end end class Macro < Callable attr_reader :ast, :params, :env def initialize(ast, params, env, &block) @ast = ast @params = params @env = env @fn = block end def inspect "#" end def is_mal_fn? true end def is_macro? true end end end end ================================================ FILE: impls/rust/.gitignore ================================================ ./target ================================================ FILE: impls/rust/Cargo.toml ================================================ [package] name = "rust2" version = "0.1.0" authors = ["root"] [dependencies] rustyline = "14.0" regex = "1.7" itertools = "0.13" fnv = "1.0.6" [[bin]] name = "step0_repl" path = "step0_repl.rs" [[bin]] name = "step1_read_print" path = "step1_read_print.rs" [[bin]] name = "step2_eval" path = "step2_eval.rs" [[bin]] name = "step3_env" path = "step3_env.rs" [[bin]] name = "step4_if_fn_do" path = "step4_if_fn_do.rs" [[bin]] name = "step5_tco" path = "step5_tco.rs" [[bin]] name = "step6_file" path = "step6_file.rs" [[bin]] name = "step7_quote" path = "step7_quote.rs" [[bin]] name = "step8_macros" path = "step8_macros.rs" [[bin]] name = "step9_try" path = "step9_try.rs" [[bin]] name = "stepA_mal" path = "stepA_mal.rs" ================================================ FILE: impls/rust/Dockerfile ================================================ FROM ubuntu:25.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install cargo \ librust-fnv-dev \ librust-itertools-dev \ librust-regex-dev \ librust-rustyline-dev \ rust-clippy rustfmt ENV CARGO_HOME /mal ================================================ FILE: impls/rust/Makefile ================================================ EXEC_DIR := target/release UPPER_STEPS := $(EXEC_DIR)/step4_if_fn_do \ $(EXEC_DIR)/step5_tco \ $(EXEC_DIR)/step6_file \ $(EXEC_DIR)/step7_quote \ $(EXEC_DIR)/step8_macros \ $(EXEC_DIR)/step9_try \ $(EXEC_DIR)/stepA_mal STEP0 := $(EXEC_DIR)/step0_repl STEP1-2 := $(EXEC_DIR)/step1_read_print \ $(EXEC_DIR)/step2_eval STEP3 := $(EXEC_DIR)/step3_env STEPS := $(STEP0) $(STEP1-2) $(STEP3) $(UPPER_STEPS) all: $(STEPS) $(STEPS): $(EXEC_DIR)/%: %.rs cargo build --release --bin $* $(STEPS): readline.rs $(STEP1-2) $(STEP3) $(UPPER_STEPS): types.rs reader.rs printer.rs $(STEP3) $(UPPER_STEPS): env.rs $(UPPER_STEPS): core.rs lint: rustfmt *.rs cargo clippy .PHONY: clean lint all clean: rm -fr target/ rm -f .mal-history *~ Cargo.lock ================================================ FILE: impls/rust/core.rs ================================================ use std::fs::File; use std::io::Read; use std::rc::Rc; use std::time::{SystemTime, UNIX_EPOCH}; use crate::printer::pr_seq; use crate::reader::read_str; use crate::types::MalVal::{ Atom, Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector, }; use crate::types::{ list, FuncStruct, MalArgs, MalRet, MalVal, _assoc, error, func, hash_map, unwrap_map_key, vector, wrap_map_key, }; use readline; macro_rules! fn_t_int_int { ($ret:ident, $fn:expr) => {{ |a: MalArgs| match (&a[0], &a[1]) { (Int(a0), Int(a1)) => Ok($ret($fn(a0, a1))), _ => error("expecting (int,int) args"), } }}; } macro_rules! fn_is_type { ($($ps:pat),*) => {{ |a:MalArgs| { Ok(Bool(match a[0] { $($ps => true,)* _ => false})) } }}; ($p:pat if $e:expr) => {{ |a:MalArgs| { Ok(Bool(match a[0] { $p if $e => true, _ => false})) } }}; ($p:pat if $e:expr,$($ps:pat),*) => {{ |a:MalArgs| { Ok(Bool(match a[0] { $p if $e => true, $($ps => true,)* _ => false})) } }}; } macro_rules! fn_str { ($fn:expr) => {{ |a: MalArgs| match &a[0] { Str(a0) => $fn(&a0), _ => error("expecting (str) arg"), } }}; } fn symbol(a: MalArgs) -> MalRet { match a[0] { Str(ref s) => Ok(Sym(s.to_string())), _ => error("illegal symbol call"), } } fn readline(p: &str) -> MalRet { match readline::readline(p) { Some(s) => Ok(Str(s)), None => Ok(Nil), } } fn slurp(f: &str) -> MalRet { let mut s = String::new(); match File::open(f).and_then(|mut f| f.read_to_string(&mut s)) { Ok(_) => Ok(Str(s)), Err(e) => error(&e.to_string()), } } fn time_ms(_a: MalArgs) -> MalRet { let ms_e = match SystemTime::now().duration_since(UNIX_EPOCH) { Ok(d) => d, Err(e) => return error(&format!("{:?}", e)), }; Ok(Int( ms_e.as_secs() as i64 * 1000 + ms_e.subsec_nanos() as i64 / 1_000_000 )) } fn get(a: MalArgs) -> MalRet { match a[0] { Nil => Ok(Nil), Hash(ref hm, _) => match hm.get(&wrap_map_key(&a[1])?) { Some(mv) => Ok(mv.clone()), None => Ok(Nil), }, _ => error("illegal get args"), } } fn assoc(a: MalArgs) -> MalRet { match a[0] { Hash(ref hm, _) => _assoc((**hm).clone(), a[1..].to_vec()), _ => error("assoc on non-Hash Map"), } } fn dissoc(a: MalArgs) -> MalRet { match a[0] { Hash(ref hm, _) => { let mut new_hm = (**hm).clone(); for k in a[1..].iter() { let _ = new_hm.remove(&wrap_map_key(k)?); } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } _ => error("dissoc on non-Hash Map"), } } fn contains_q(a: MalArgs) -> MalRet { match a[0] { Hash(ref hm, _) => Ok(Bool(hm.contains_key(&wrap_map_key(&a[1])?))), _ => error("illegal get args"), } } fn keys(a: MalArgs) -> MalRet { match a[0] { Hash(ref hm, _) => Ok(list(hm.keys().map(|k| unwrap_map_key(k)).collect())), _ => error("keys requires Hash Map"), } } fn vals(a: MalArgs) -> MalRet { match a[0] { Hash(ref hm, _) => Ok(list(hm.values().cloned().collect())), _ => error("vals requires Hash Map"), } } fn vec(a: MalArgs) -> MalRet { match a[0] { List(ref v, _) => Ok(Vector(v.clone(), Rc::new(Nil))), Vector(_, _) => Ok(a[0].clone()), _ => error("non-seq passed to vec"), } } fn cons(a: MalArgs) -> MalRet { match &a[1] { List(v, _) | Vector(v, _) => { let mut new_v = vec![a[0].clone()]; new_v.extend_from_slice(v); Ok(list(new_v)) } _ => error("cons expects seq as second arg"), } } fn concat(a: MalArgs) -> MalRet { let mut new_v = vec![]; for seq in a.iter() { match seq { List(v, _) | Vector(v, _) => new_v.extend_from_slice(v), _ => return error("non-seq passed to concat"), } } Ok(list(new_v)) } fn nth(a: MalArgs) -> MalRet { match (&a[0], &a[1]) { (List(seq, _) | Vector(seq, _), Int(idx)) => match seq.get(*idx as usize) { Some(result) => Ok(result.clone()), None => error("nth: index out of range"), }, _ => error("invalid args to nth"), } } fn first(a: MalArgs) -> MalRet { match a[0] { List(ref seq, _) | Vector(ref seq, _) if seq.len() > 0 => Ok(seq[0].clone()), List(_, _) | Vector(_, _) | Nil => Ok(Nil), _ => error("invalid args to first"), } } fn rest(a: MalArgs) -> MalRet { match a[0] { List(ref seq, _) | Vector(ref seq, _) if seq.len() > 1 => Ok(list(seq[1..].to_vec())), List(_, _) | Vector(_, _) | Nil => Ok(list!()), _ => error("invalid args to first"), } } fn apply(a: MalArgs) -> MalRet { match a[a.len() - 1] { List(ref v, _) | Vector(ref v, _) => { let f = &a[0]; let mut fargs = a[1..a.len() - 1].to_vec(); fargs.extend_from_slice(v); f.apply(fargs) } _ => error("apply called with non-seq"), } } fn map(a: MalArgs) -> MalRet { match a[1] { List(ref v, _) | Vector(ref v, _) => { let mut res = vec![]; for mv in v.iter() { res.push(a[0].apply(vec![mv.clone()])?) } Ok(list(res)) } _ => error("map called with non-seq"), } } fn conj(a: MalArgs) -> MalRet { match a[0] { List(ref v, _) => { let sl = a[1..].iter().rev().cloned().collect::>(); Ok(list([&sl[..], v].concat())) } Vector(ref v, _) => Ok(vector([v, &a[1..]].concat())), _ => error("conj: called with non-seq"), } } fn seq(a: MalArgs) -> MalRet { match a[0] { ref l @ List(ref v, _) if v.len() > 0 => Ok(l.clone()), Vector(ref v, _) if v.len() > 0 => Ok(list(v.to_vec())), Str(ref s) if !s.is_empty() => Ok(list(s.chars().map(|c| Str(c.to_string())).collect())), List(_, _) | Vector(_, _) | Str(_) | Nil => Ok(Nil), _ => error("seq: called with non-seq"), } } fn keyword(a: MalArgs) -> MalRet { match a[0] { Kwd(_) => Ok(a[0].clone()), Str(ref s) => Ok(Kwd(String::from(s))), _ => error("invalid type for keyword"), } } pub fn empty_q(a: MalArgs) -> MalRet { match a[0] { List(ref l, _) | Vector(ref l, _) => Ok(Bool(l.len() == 0)), Nil => Ok(Bool(true)), _ => error("invalid type for empty?"), } } pub fn count(a: MalArgs) -> MalRet { match a[0] { List(ref l, _) | Vector(ref l, _) => Ok(Int(l.len() as i64)), Nil => Ok(Int(0)), _ => error("invalid type for count"), } } pub fn atom(a: MalArgs) -> MalRet { Ok(Atom(Rc::new(std::cell::RefCell::new(a[0].clone())))) } pub fn deref(a: MalArgs) -> MalRet { match a[0] { Atom(ref a) => Ok(a.borrow().clone()), _ => error("attempt to deref a non-Atom"), } } pub fn reset_bang(a: MalArgs) -> MalRet { match a[0] { Atom(ref atm) => { *atm.borrow_mut() = a[1].clone(); Ok(a[1].clone()) } _ => error("attempt to reset! a non-Atom"), } } pub fn swap_bang(a: MalArgs) -> MalRet { match a[0] { Atom(ref atm) => { let mut fargs = a[2..].to_vec(); fargs.insert(0, atm.borrow().clone()); let result = a[1].apply(fargs)?; *atm.borrow_mut() = result.clone(); Ok(result) } _ => error("attempt to swap! a non-Atom"), } } pub fn get_meta(a: MalArgs) -> MalRet { match a[0] { List(_, ref meta) | Vector(_, ref meta) | Hash(_, ref meta) => Ok((**meta).clone()), Func(_, ref meta) => Ok((**meta).clone()), MalFunc(FuncStruct { ref meta, .. }) => Ok((**meta).clone()), _ => error("meta not supported by type"), } } pub fn with_meta(a: MalArgs) -> MalRet { let m = Rc::new(a[1].clone()); match a[0] { List(ref l, _) => Ok(List(l.clone(), m)), Vector(ref l, _) => Ok(Vector(l.clone(), m)), Hash(ref l, _) => Ok(Hash(l.clone(), m)), Func(ref l, _) => Ok(Func(*l, m)), MalFunc(ref f @ FuncStruct { .. }) => Ok(MalFunc(FuncStruct { meta: m, ..f.clone() })), _ => error("with-meta not supported by type"), } } pub fn ns() -> Vec<(&'static str, MalVal)> { vec![ ("=", func(|a| Ok(Bool(a[0] == a[1])))), ("throw", func(|a| Err(a[0].clone()))), ("nil?", func(fn_is_type!(Nil))), ("true?", func(fn_is_type!(Bool(true)))), ("false?", func(fn_is_type!(Bool(false)))), ("symbol", func(symbol)), ("symbol?", func(fn_is_type!(Sym(_)))), ("string?", func(fn_is_type!(Str(_)))), ("keyword", func(keyword)), ("keyword?", func(fn_is_type!(Kwd(_)))), ("number?", func(fn_is_type!(Int(_)))), ( "fn?", func(fn_is_type!( MalFunc(FuncStruct { is_macro: false, .. }), Func(_, _) )), ), ( "macro?", func(fn_is_type!(MalFunc(FuncStruct { is_macro: true, .. }))), ), ("pr-str", func(|a| Ok(Str(pr_seq(&a, true, "", "", " "))))), ("str", func(|a| Ok(Str(pr_seq(&a, false, "", "", ""))))), ( "prn", func(|a| { println!("{}", pr_seq(&a, true, "", "", " ")); Ok(Nil) }), ), ( "println", func(|a| { println!("{}", pr_seq(&a, false, "", "", " ")); Ok(Nil) }), ), ("read-string", func(fn_str!(read_str))), ("readline", func(fn_str!(readline))), ("slurp", func(fn_str!(slurp))), ("<", func(fn_t_int_int!(Bool, |i, j| { i < j }))), ("<=", func(fn_t_int_int!(Bool, |i, j| { i <= j }))), (">", func(fn_t_int_int!(Bool, |i, j| { i > j }))), (">=", func(fn_t_int_int!(Bool, |i, j| { i >= j }))), ("+", func(fn_t_int_int!(Int, |i, j| { i + j }))), ("-", func(fn_t_int_int!(Int, |i, j| { i - j }))), ("*", func(fn_t_int_int!(Int, |i, j| { i * j }))), ("/", func(fn_t_int_int!(Int, |i, j| { i / j }))), ("time-ms", func(time_ms)), ("sequential?", func(fn_is_type!(List(_, _), Vector(_, _)))), ("list", func(|a| Ok(list(a)))), ("list?", func(fn_is_type!(List(_, _)))), ("vector", func(|a| Ok(vector(a)))), ("vector?", func(fn_is_type!(Vector(_, _)))), ("hash-map", func(hash_map)), ("map?", func(fn_is_type!(Hash(_, _)))), ("assoc", func(assoc)), ("dissoc", func(dissoc)), ("get", func(get)), ("contains?", func(contains_q)), ("keys", func(keys)), ("vals", func(vals)), ("vec", func(vec)), ("cons", func(cons)), ("concat", func(concat)), ("empty?", func(empty_q)), ("nth", func(nth)), ("first", func(first)), ("rest", func(rest)), ("count", func(count)), ("apply", func(apply)), ("map", func(map)), ("conj", func(conj)), ("seq", func(seq)), ("meta", func(get_meta)), ("with-meta", func(with_meta)), ("atom", func(atom)), ("atom?", func(fn_is_type!(Atom(_)))), ("deref", func(deref)), ("reset!", func(reset_bang)), ("swap!", func(swap_bang)), ] } ================================================ FILE: impls/rust/env.rs ================================================ use std::cell::RefCell; use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use crate::types::MalVal::{List, Sym, Vector}; use crate::types::{error, list, MalRet, MalVal}; pub struct EnvStruct { data: RefCell>, outer: Option, } pub type Env = Rc; // TODO: it would be nice to use impl here but it doesn't work on // a deftype (i.e. Env) pub fn env_new(outer: Option) -> Env { Rc::new(EnvStruct { data: RefCell::new(FnvHashMap::default()), outer, }) } // TODO: mbinds and exprs as & types pub fn env_bind(outer: Env, mbinds: &MalVal, exprs: Vec) -> Result { let env = env_new(Some(outer)); match mbinds { List(binds, _) | Vector(binds, _) => { for (i, b) in binds.iter().enumerate() { match b { Sym(s) if s == "&" => { env_set(&env, &binds[i + 1], list(exprs[i..].to_vec()))?; break; } _ => { env_set(&env, b, exprs[i].clone())?; } } } Ok(env) } _ => error("env_bind binds not List/Vector"), } } pub fn env_get(env: &Env, key: &str) -> Option { let mut mut_env = env; loop { if let Some(value) = mut_env.data.borrow().get(key) { return Some(value.clone()); } else if let Some(outer) = &mut_env.outer { mut_env = outer; } else { return None; } } } pub fn env_set(env: &Env, key: &MalVal, val: MalVal) -> MalRet { match key { Sym(s) => { env_sets(env, s, val.clone()); Ok(val) } _ => error("Env.set called with non-Str"), } } pub fn env_sets(env: &Env, key: &str, val: MalVal) { env.data.borrow_mut().insert(key.to_string(), val); } ================================================ FILE: impls/rust/printer.rs ================================================ use crate::types::MalVal::{ Atom, Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector, }; use crate::types::{unwrap_map_key, FuncStruct, MalVal}; fn escape_str(s: &str) -> String { s.chars() .map(|c| match c { '"' => "\\\"".to_string(), '\n' => "\\n".to_string(), '\\' => "\\\\".to_string(), _ => c.to_string(), }) .collect::>() .join("") } impl MalVal { pub fn pr_str(&self, print_readably: bool) -> String { match self { Nil => String::from("nil"), Bool(true) => String::from("true"), Bool(false) => String::from("false"), Int(i) => format!("{}", i), //Float(f) => format!("{}", f), Kwd(s) => format!(":{}", s), Str(s) => { if print_readably { format!("\"{}\"", escape_str(s)) } else { s.clone() } } Sym(s) => s.clone(), List(l, _) => pr_seq(l, print_readably, "(", ")", " "), Vector(l, _) => pr_seq(l, print_readably, "[", "]", " "), Hash(hm, _) => { let l: Vec = hm .iter() .flat_map(|(k, v)| vec![unwrap_map_key(k), v.clone()]) .collect(); pr_seq(&l, print_readably, "{", "}", " ") } Func(_, _) => String::from("#"), MalFunc(FuncStruct { ast: a, params: p, .. }) => format!("(fn* {} {})", p.pr_str(true), a.pr_str(true)), Atom(a) => format!("(atom {})", a.borrow().pr_str(true)), } } } pub fn pr_seq(seq: &[MalVal], print_readably: bool, start: &str, end: &str, join: &str) -> String { let strs: Vec = seq.iter().map(|x| x.pr_str(print_readably)).collect(); format!("{}{}{}", start, strs.join(join), end) } ================================================ FILE: impls/rust/reader.rs ================================================ use regex::{Captures, Regex}; use std::rc::Rc; use crate::types::MalVal::{Bool, Int, Kwd, List, Nil, Str, Sym}; use crate::types::{error, hash_map, list, vector, MalRet, MalVal}; #[derive(Debug, Clone)] struct Reader { tokens: Vec, pos: usize, } impl Reader { fn next(&mut self) -> Result { self.pos += 1; Ok(self .tokens .get(self.pos - 1) .ok_or_else(|| Str("underflow".to_string()))? .to_string()) } fn peek(&self) -> Result { Ok(self .tokens .get(self.pos) .ok_or_else(|| Str("underflow".to_string()))? .to_string()) } } thread_local! { static TOKENIZE_RE: Regex = Regex::new( r###"[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]+)"### ).unwrap(); static UNESCAPE_RE: Regex = Regex::new(r#"\\(.)"#).unwrap(); static INT_RE: Regex = Regex::new(r"^-?[0-9]+$").unwrap(); static STR_RE: Regex = Regex::new(r#""(?:\\.|[^\\"])*""#).unwrap(); } fn tokenize(str: &str) -> Vec { TOKENIZE_RE.with(|re| { let mut res = vec![]; for cap in re.captures_iter(str) { if cap[1].starts_with(';') { continue; } res.push(String::from(&cap[1])); } res }) } fn unescape_str(s: &str) -> String { UNESCAPE_RE.with(|re| { re.replace_all(s, |caps: &Captures| { if &caps[1] == "n" { "\n" } else { &caps[1] }.to_string() }) .to_string() }) } fn read_atom(rdr: &mut Reader) -> MalRet { let token = rdr.next()?; match &token[..] { "nil" => Ok(Nil), "false" => Ok(Bool(false)), "true" => Ok(Bool(true)), _ => { if INT_RE.with(|re| re.is_match(&token)) { Ok(Int(token.parse().unwrap())) } else if STR_RE.with(|re| re.is_match(&token)) { Ok(Str(unescape_str(&token[1..token.len() - 1]))) } else if token.starts_with('\"') { error("expected '\"', got EOF") } else if let Some(keyword) = token.strip_prefix(':') { Ok(Kwd(String::from(keyword))) } else { Ok(Sym(token.to_string())) } } } } fn read_seq(rdr: &mut Reader, end: &str) -> Result, MalVal> { let mut seq: Vec = vec![]; rdr.next()?; loop { let token = match rdr.peek() { Ok(t) => t, Err(_) => return error(&format!("expected '{}', got EOF", end)), }; if token == end { break; } seq.push(read_form(rdr)?); } let _ = rdr.next(); Ok(seq) } fn read_form(rdr: &mut Reader) -> MalRet { let token = rdr.peek()?; match &token[..] { "'" => { let _ = rdr.next(); Ok(list!(Sym("quote".to_string()), read_form(rdr)?)) } "`" => { let _ = rdr.next(); Ok(list!(Sym("quasiquote".to_string()), read_form(rdr)?)) } "~" => { let _ = rdr.next(); Ok(list!(Sym("unquote".to_string()), read_form(rdr)?)) } "~@" => { let _ = rdr.next(); Ok(list!(Sym("splice-unquote".to_string()), read_form(rdr)?)) } "^" => { let _ = rdr.next(); let meta = read_form(rdr)?; Ok(list!(Sym("with-meta".to_string()), read_form(rdr)?, meta)) } "@" => { let _ = rdr.next(); Ok(list!(Sym("deref".to_string()), read_form(rdr)?)) } ")" => error("unexpected ')'"), "(" => Ok(list(read_seq(rdr, ")")?)), "]" => error("unexpected ']'"), "[" => Ok(vector(read_seq(rdr, "]")?)), "}" => error("unexpected '}'"), "{" => hash_map(read_seq(rdr, "}")?.to_vec()), _ => read_atom(rdr), } } pub fn read_str(str: &str) -> MalRet { let tokens = tokenize(str); //println!("tokens: {:?}", tokens); if tokens.is_empty() { return error("no input"); } read_form(&mut Reader { pos: 0, tokens }) } ================================================ FILE: impls/rust/readline.rs ================================================ extern crate rustyline; // A global variable makes more sense than passing the readline editor // as an argument to *every* core function just for readline. struct S { e: rustyline::Editor<(), rustyline::history::DefaultHistory>, } impl Drop for S { fn drop(&mut self) { self.e.save_history(".mal-history").unwrap() } } thread_local! { static ED : std::cell::RefCell = { let mut e = rustyline::Editor::new().unwrap(); if e.load_history(".mal-history").is_err() { println!("No previous history."); } std::cell::RefCell::new(S{e}) } } pub fn readline(prompt: &str) -> Option { ED.with_borrow_mut(|s| { let r = s.e.readline(prompt); if let Err(rustyline::error::ReadlineError::Eof) = r { None } else { let mut line = r.unwrap(); // Remove any trailing \n or \r\n while line.ends_with('\n') || line.ends_with('\r') { line.pop(); } if !line.is_empty() { let _ = s.e.add_history_entry(&line); } Some(line.to_string()) } }) } ================================================ FILE: impls/rust/run ================================================ #!/bin/sh exec $(dirname $0)/target/release/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/rust/step0_repl.rs ================================================ #![allow(non_snake_case)] mod readline; fn main() { // `()` can be used when no completer is required // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { println!("{}", line); } } println!(); } ================================================ FILE: impls/rust/step1_read_print.rs ================================================ #![allow(non_snake_case)] extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] #[allow(dead_code)] mod types; use crate::types::{MalRet, MalVal}; #[allow(dead_code)] mod env; mod printer; mod reader; // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(ast: MalVal) -> MalRet { Ok(ast) } // print fn print(ast: MalVal) -> String { ast.pr_str(true) } fn rep(str: &str) -> Result { let ast = read(str)?; let exp = eval(ast)?; Ok(print(exp)) } fn main() { // `()` can be used when no completer is required // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); } ================================================ FILE: impls/rust/step2_eval.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] #[allow(dead_code)] mod types; use crate::types::MalVal::{Func, Hash, Int, List, Nil, Sym, Vector}; use crate::types::{error, func, vector, MalArgs, MalRet, MalVal}; #[allow(dead_code)] mod env; mod printer; mod reader; pub type Env = FnvHashMap; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(ast: &MalVal, env: &Env) -> MalRet { // println!("EVAL: {}", print(&ast)); match ast { Sym(s) => match env.get(s) { Some(r) => Ok(r.clone()), None => error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } Ok(vector(lst)) } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; let f = eval(a0, env)?; let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } f.apply(args) } _ => Ok(ast.clone()), } } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn int_op(op: fn(i64, i64) -> i64, a: MalArgs) -> MalRet { match (a[0].clone(), a[1].clone()) { (Int(a0), Int(a1)) => Ok(Int(op(a0, a1))), _ => error("invalid int_op args"), } } fn main() { // `()` can be used when no completer is required let mut repl_env = Env::default(); repl_env.insert("+".to_string(), func(|a: MalArgs| int_op(|i, j| i + j, a))); repl_env.insert("-".to_string(), func(|a: MalArgs| int_op(|i, j| i - j, a))); repl_env.insert("*".to_string(), func(|a: MalArgs| int_op(|i, j| i * j, a))); repl_env.insert("/".to_string(), func(|a: MalArgs| int_op(|i, j| i / j, a))); // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, &repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); } ================================================ FILE: impls/rust/step3_env.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] #[allow(dead_code)] mod types; use crate::types::MalVal::{Bool, Func, Hash, Int, List, Nil, Sym, Vector}; use crate::types::{error, func, vector, MalArgs, MalRet, MalVal}; #[allow(dead_code)] mod env; mod printer; mod reader; use crate::env::{env_get, env_new, env_set, env_sets, Env}; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(ast: &MalVal, env: &Env) -> MalRet { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => Ok(r), None => error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } Ok(vector(lst)) } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => env_set(env, &l[1], eval(&l[2], env)?), Sym(a0sym) if a0sym == "let*" => { let let_env = &env_new(Some(env.clone())); let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, let_env)?; env_set(let_env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; eval(a2, let_env) } _ => { let f = eval(a0, env)?; let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } f.apply(args) } } } _ => Ok(ast.clone()), } } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn int_op(op: fn(i64, i64) -> i64, a: MalArgs) -> MalRet { match (a[0].clone(), a[1].clone()) { (Int(a0), Int(a1)) => Ok(Int(op(a0, a1))), _ => error("invalid int_op args"), } } fn main() { // `()` can be used when no completer is required let repl_env = env_new(None); env_sets(&repl_env, "+", func(|a: MalArgs| int_op(|i, j| i + j, a))); env_sets(&repl_env, "-", func(|a: MalArgs| int_op(|i, j| i - j, a))); env_sets(&repl_env, "*", func(|a: MalArgs| int_op(|i, j| i * j, a))); env_sets(&repl_env, "/", func(|a: MalArgs| int_op(|i, j| i / j, a))); // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, &repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); } ================================================ FILE: impls/rust/step4_if_fn_do.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Sym, Vector}; use crate::types::{error, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(ast: &MalVal, env: &Env) -> MalRet { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => Ok(r), None => error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } Ok(vector(lst)) } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => env_set(env, &l[1], eval(&l[2], env)?), Sym(a0sym) if a0sym == "let*" => { let let_env = &env_new(Some(env.clone())); let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, let_env)?; env_set(let_env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; eval(a2, let_env) } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } eval(l.last().unwrap_or(&Nil), env) } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => eval(&l[3], env), Bool(false) | Nil => Ok(Nil), _ if l.len() >= 3 => eval(&l[2], env), _ => Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })) } _ => { let f = eval(a0, env)?; let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } f.apply(args) } } } _ => Ok(ast.clone()), } } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } fn main() { // `()` can be used when no completer is required // core.rs: defined using rust let repl_env = env_new(None); for (k, v) in core::ns() { env_sets(&repl_env, k, v); } // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", &repl_env); // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, &repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); } ================================================ FILE: impls/rust/step5_tco.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Sym, Vector}; use crate::types::{error, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } fn main() { // `()` can be used when no completer is required // core.rs: defined using rust let repl_env = env_new(None); for (k, v) in core::ns() { env_sets(&repl_env, k, v); } // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", &repl_env); // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, &repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); } ================================================ FILE: impls/rust/step6_file.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } thread_local! { static REPL_ENV: Env = env_new(None); } fn main() { REPL_ENV.with(|repl_env| { let mut args = std::env::args(); let arg1 = args.nth(1); // `()` can be used when no completer is required // core.rs: defined using rust env_sets( repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e))), ); for (k, v) in core::ns() { env_sets(repl_env, k, v); } env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re( "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env, ); if let Some(f) = arg1 { // Invoked with arguments re(&format!("(load-file \"{}\")", f), repl_env); std::process::exit(0); } // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); }) } ================================================ FILE: impls/rust/step7_quote.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval 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; } } } } acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); } 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(); } } } qq_iter(v) } Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), _ => ast.clone(), } } fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), Sym(a0sym) if a0sym == "quasiquote" => { live_ast = quasiquote(&l[1]); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } thread_local! { static REPL_ENV: Env = env_new(None); } fn main() { REPL_ENV.with(|repl_env| { let mut args = std::env::args(); let arg1 = args.nth(1); // `()` can be used when no completer is required // core.rs: defined using rust env_sets( repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e))), ); for (k, v) in core::ns() { env_sets(repl_env, k, v); } env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re( "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env, ); if let Some(f) = arg1 { // Invoked with arguments re(&format!("(load-file \"{}\")", f), repl_env); std::process::exit(0); } // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); }) } ================================================ FILE: impls/rust/step8_macros.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval 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; } } } } acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); } 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(); } } } qq_iter(v) } Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), _ => ast.clone(), } } fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), Sym(a0sym) if a0sym == "quasiquote" => { live_ast = quasiquote(&l[1]); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "defmacro!" => { let (a1, a2) = (&l[1], &l[2]); let r = eval(a2, env)?; match r { MalFunc(f) => { return env_set( env, a1, MalFunc(FuncStruct { is_macro: true, ..f.clone() }), ) } _ => return error("set_macro on non-function"), } } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ MalFunc(FuncStruct { is_macro: true, .. }) => { let new_ast = f.apply(l[1..].to_vec())?; live_ast = new_ast; ast = &live_ast; continue 'tco; } f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } thread_local! { static REPL_ENV: Env = env_new(None); } fn main() { REPL_ENV.with(|repl_env| { let mut args = std::env::args(); let arg1 = args.nth(1); // `()` can be used when no completer is required // core.rs: defined using rust env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); for (k, v) in core::ns() { env_sets(repl_env, k, v); } env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re( "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env, ); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if let Some(f) = arg1 { // Invoked with arguments re(&format!("(load-file \"{}\")", f), repl_env); std::process::exit(0); } // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); }) } ================================================ FILE: impls/rust/step9_try.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval 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; } } } } acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); } 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(); } } } qq_iter(v) } Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), _ => ast.clone(), } } fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), Sym(a0sym) if a0sym == "quasiquote" => { live_ast = quasiquote(&l[1]); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "defmacro!" => { let (a1, a2) = (&l[1], &l[2]); let r = eval(a2, env)?; match r { MalFunc(f) => { return env_set( env, a1, MalFunc(FuncStruct { is_macro: true, ..f.clone() }), ) } _ => return error("set_macro on non-function"), } } Sym(a0sym) if a0sym == "try*" => { if l.len() < 3 { live_ast = l[1].clone(); ast = &live_ast; continue 'tco; } match eval(&l[1], env) { Err(exc) => match &l[2] { List(c, _) => { live_env = env_new(Some(env.clone())); env = &live_env; env_set(env, &c[1], exc)?; live_ast = c[2].clone(); ast = &live_ast; continue 'tco; } _ => return error("invalid catch block"), }, res => return res, } } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ MalFunc(FuncStruct { is_macro: true, .. }) => { let new_ast = f.apply(l[1..].to_vec())?; live_ast = new_ast; ast = &live_ast; continue 'tco; } f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } thread_local! { static REPL_ENV: Env = env_new(None); } fn main() { REPL_ENV.with(|repl_env| { let mut args = std::env::args(); let arg1 = args.nth(1); // `()` can be used when no completer is required // core.rs: defined using rust env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); for (k, v) in core::ns() { env_sets(repl_env, k, v); } env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); // core.mal: defined using the language itself re("(def! not (fn* (a) (if a false true)))", repl_env); re( "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env, ); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if let Some(f) = arg1 { // Invoked with arguments re(&format!("(load-file \"{}\")", f), repl_env); std::process::exit(0); } // main repl loop while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); }) } ================================================ FILE: impls/rust/stepA_mal.rs ================================================ #![allow(non_snake_case)] use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; extern crate fnv; extern crate itertools; extern crate regex; mod readline; #[macro_use] mod types; use crate::types::MalVal::{Bool, Func, Hash, List, MalFunc, Nil, Str, Sym, Vector}; use crate::types::{error, list, vector, FuncStruct, MalArgs, MalRet, MalVal}; mod env; mod printer; mod reader; use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; impl MalVal { pub fn apply(&self, args: MalArgs) -> MalRet { match self { Func(f, _) => f(args), MalFunc(FuncStruct { ref ast, ref env, ref params, .. }) => { let fn_env = &env_bind(env.clone(), params, args)?; eval(ast, fn_env) } _ => error("attempt to call non-function"), } } } // read fn read(str: &str) -> MalRet { reader::read_str(str) } // eval 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; } } } } acc = list!(Sym("cons".to_string()), quasiquote(elt), acc); } 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(); } } } qq_iter(v) } Vector(v, _) => list!(Sym("vec".to_string()), qq_iter(v)), Hash(_, _) | Sym(_) => list!(Sym("quote".to_string()), ast.clone()), _ => ast.clone(), } } fn eval(orig_ast: &MalVal, orig_env: &Env) -> MalRet { let mut ast = orig_ast; let mut env = orig_env; // These variables ensure a sufficient lifetime for the data // referenced by ast and env. let mut live_ast; let mut live_env; 'tco: loop { match env_get(env, "DEBUG-EVAL") { None | Some(Bool(false)) | Some(Nil) => (), _ => println!("EVAL: {}", print(ast)), } match ast { Sym(s) => match env_get(env, s) { Some(r) => return Ok(r), None => return error(&format!("'{}' not found", s)), }, Vector(v, _) => { let mut lst: MalArgs = vec![]; for a in v.iter() { lst.push(eval(a, env)?); } return Ok(vector(lst)); } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); for (k, v) in hm.iter() { new_hm.insert(k.to_string(), eval(v, env)?); } return Ok(Hash(Rc::new(new_hm), Rc::new(Nil))); } List(l, _) => { if l.is_empty() { return Ok(ast.clone()); } let a0 = &l[0]; match a0 { Sym(a0sym) if a0sym == "def!" => { return env_set(env, &l[1], eval(&l[2], env)?); } Sym(a0sym) if a0sym == "let*" => { live_env = env_new(Some(env.clone())); env = &live_env; let (a1, a2) = (&l[1], &l[2]); match a1 { List(binds, _) | Vector(binds, _) => { for (b, e) in binds.iter().tuples() { let val = eval(e, env)?; env_set(env, b, val)?; } } _ => { return error("let* with non-List bindings"); } }; live_ast = a2.clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "quote" => return Ok(l[1].clone()), Sym(a0sym) if a0sym == "quasiquote" => { live_ast = quasiquote(&l[1]); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "defmacro!" => { let (a1, a2) = (&l[1], &l[2]); let r = eval(a2, env)?; match r { MalFunc(f) => { return env_set( env, a1, MalFunc(FuncStruct { is_macro: true, ..f.clone() }), ) } _ => return error("set_macro on non-function"), } } Sym(a0sym) if a0sym == "try*" => { if l.len() < 3 { live_ast = l[1].clone(); ast = &live_ast; continue 'tco; } match eval(&l[1], env) { Err(exc) => match &l[2] { List(c, _) => { live_env = env_new(Some(env.clone())); env = &live_env; env_set(env, &c[1], exc)?; live_ast = c[2].clone(); ast = &live_ast; continue 'tco; } _ => return error("invalid catch block"), }, res => return res, } } Sym(a0sym) if a0sym == "do" => { for i in 1..l.len() - 1 { let _ = eval(&l[i], env)?; } live_ast = l.last().unwrap_or(&Nil).clone(); ast = &live_ast; continue 'tco; } Sym(a0sym) if a0sym == "if" => { let cond = eval(&l[1], env)?; match cond { Bool(false) | Nil if l.len() >= 4 => { live_ast = l[3].clone(); ast = &live_ast; continue 'tco; } Bool(false) | Nil => return Ok(Nil), _ if l.len() >= 3 => { live_ast = l[2].clone(); ast = &live_ast; continue 'tco; } _ => return Ok(Nil), } } Sym(a0sym) if a0sym == "fn*" => { let (a1, a2) = (l[1].clone(), l[2].clone()); return Ok(MalFunc(FuncStruct { ast: Rc::new(a2), env: env.clone(), params: Rc::new(a1), is_macro: false, meta: Rc::new(Nil), })); } _ => match eval(a0, env)? { f @ MalFunc(FuncStruct { is_macro: true, .. }) => { let new_ast = f.apply(l[1..].to_vec())?; live_ast = new_ast; ast = &live_ast; continue 'tco; } f @ Func(_, _) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } return f.apply(args); } MalFunc(FuncStruct { ast: mast, env: menv, params: mparams, .. }) => { let mut args: MalArgs = vec![]; for i in 1..l.len() { args.push(eval(&l[i], env)?); } live_env = env_bind(menv.clone(), &mparams, args)?; env = &live_env; live_ast = (*mast).clone(); ast = &live_ast; continue 'tco; } _ => return error("attempt to call non-function"), }, } } _ => return Ok(ast.clone()), }; } // end 'tco loop } // print fn print(ast: &MalVal) -> String { ast.pr_str(true) } fn rep(str: &str, env: &Env) -> Result { let ast = read(str)?; let exp = eval(&ast, env)?; Ok(print(&exp)) } fn re(str: &str, env: &Env) { if let Ok(ast) = read(str) { if eval(&ast, env).is_ok() { return; } } panic!("error during startup"); } thread_local! { static REPL_ENV: Env = env_new(None); } fn main() { REPL_ENV.with(|repl_env| { let mut args = std::env::args(); let arg1 = args.nth(1); // `()` can be used when no completer is required // core.rs: defined using rust env_sets(repl_env, "eval", types::func(|a| REPL_ENV.with(|e| eval(&a[0], e)))); for (k, v) in core::ns() { env_sets(repl_env, k, v); } env_sets(repl_env, "*ARGV*", list(args.map(Str).collect())); // core.mal: defined using the language itself re("(def! *host-language* \"rust\")", repl_env); re("(def! not (fn* (a) (if a false true)))", repl_env); re( "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env, ); re("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env); if let Some(f) = arg1 { // Invoked with arguments re(&format!("(load-file \"{}\")", f), repl_env); std::process::exit(0); } // main repl loop re("(println (str \"Mal [\" *host-language* \"]\"))", repl_env); while let Some(ref line) = readline::readline("user> ") { if !line.is_empty() { match rep(line, repl_env) { Ok(ref out) => println!("{}", out), Err(ref e) => println!("Error: {}", e.pr_str(true)), } } } println!(); }) } ================================================ FILE: impls/rust/types.rs ================================================ use std::cell::RefCell; use std::rc::Rc; //use std::collections::HashMap; use fnv::FnvHashMap; use itertools::Itertools; use crate::env::Env; use crate::types::MalVal::{Bool, Func, Hash, Int, Kwd, List, MalFunc, Nil, Str, Sym, Vector}; // Function closures and atoms may create cyclic dependencies, so // reference counting should be replaced at least for these two kinds // of references. #[derive(Clone)] pub enum MalVal { Nil, Bool(bool), Int(i64), //Float(f64), Str(String), Sym(String), Kwd(String), List(Rc>, Rc), Vector(Rc>, Rc), Hash(Rc>, Rc), Func(fn(MalArgs) -> MalRet, Rc), MalFunc(FuncStruct), Atom(Rc>), } #[derive(Clone)] pub struct FuncStruct { pub ast: Rc, pub env: Env, pub params: Rc, pub is_macro: bool, pub meta: Rc, } pub type MalArgs = Vec; pub type MalRet = Result; // type utility macros macro_rules! list { [$($args:expr),*] => {{ let v: Vec = vec![$($args),*]; List(Rc::new(v),Rc::new(Nil)) }} } // type utility functions pub fn error(s: &str) -> Result { Err(Str(s.to_string())) } pub fn list(seq: MalArgs) -> MalVal { List(Rc::new(seq), Rc::new(Nil)) } pub fn vector(seq: MalArgs) -> MalVal { Vector(Rc::new(seq), Rc::new(Nil)) } impl PartialEq for MalVal { fn eq(&self, other: &MalVal) -> bool { match (self, other) { (Nil, Nil) => true, (Bool(ref a), Bool(ref b)) => a == b, (Int(ref a), Int(ref b)) => a == b, (Str(ref a), Str(ref b)) => a == b, (Sym(ref a), Sym(ref b)) => a == b, (Kwd(ref a), Kwd(ref b)) => a == b, (List(ref a, _), List(ref b, _)) | (Vector(ref a, _), Vector(ref b, _)) | (List(ref a, _), Vector(ref b, _)) | (Vector(ref a, _), List(ref b, _)) => a == b, (Hash(ref a, _), Hash(ref b, _)) => a == b, (MalFunc { .. }, MalFunc { .. }) => false, _ => false, } } } pub fn func(f: fn(MalArgs) -> MalRet) -> MalVal { Func(f, Rc::new(Nil)) } pub fn _assoc(mut hm: FnvHashMap, kvs: MalArgs) -> MalRet { if kvs.len() % 2 != 0 { return error("odd number of elements"); } for (k, v) in kvs.iter().tuples() { hm.insert(wrap_map_key(k)?, v.clone()); } Ok(Hash(Rc::new(hm), Rc::new(Nil))) } pub fn wrap_map_key(k: &MalVal) -> Result { match k { Str(s) => Ok(String::from(s)), Kwd(s) => Ok(format!("\u{29e}{}", s)), _ => error("key is not string"), } } pub fn unwrap_map_key(s: &str) -> MalVal { match s.strip_prefix('\u{29e}') { Some(keyword) => Kwd(String::from(keyword)), _ => Str(String::from(s)), } } pub fn hash_map(kvs: MalArgs) -> MalRet { let hm: FnvHashMap = FnvHashMap::default(); _assoc(hm, kvs) } ================================================ FILE: impls/scala/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Java and maven RUN apt-get -y install openjdk-8-jdk #RUN apt-get -y install maven2 #ENV MAVEN_OPTS -Duser.home=/mal # Scala RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list RUN apt-get -y update RUN apt-get -y --force-yes install sbt RUN apt-get -y install scala ENV SBT_OPTS -Duser.home=/mal ================================================ FILE: impls/scala/Makefile ================================================ SOURCES_BASE = types.scala reader.scala printer.scala SOURCES_LISP = env.scala core.scala stepA_mal.scala SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) TARGET_DIR=target/scala-2.11 all: $(TARGET_DIR)/mal.jar dist: mal mal: $(TARGET_DIR)/mal.jar cp $< $@ $(TARGET_DIR)/mal.jar: sbt assembly $(TARGET_DIR)/classes/step%.class: step%.scala $(SOURCES) sbt assembly clean: rm -rf mal target .PHONY: all dist clean ================================================ FILE: impls/scala/assembly.sbt ================================================ import sbtassembly.AssemblyPlugin.defaultShellScript test in assembly := {} assemblyJarName in assembly := "mal.jar" mainClass in assembly := Some("stepA_mal") assemblyOption in assembly ~= { _.copy(prependShellScript = Some(defaultShellScript)) } ================================================ FILE: impls/scala/build.sbt ================================================ lazy val root = (project in file(".")). settings( name := "mal", version := "0.1", scalaVersion := "2.11.4" ) ================================================ FILE: impls/scala/core.scala ================================================ import scala.collection.mutable import scala.io.Source import types.{MalList, _list, _list_Q, MalVector, _vector, _vector_Q, MalHashMap, _hash_map_Q, _hash_map, Func, MalFunction} import printer._pr_list object core { def mal_throw(a: List[Any]) = { throw new types.MalException(printer._pr_str(a(0))).init(a(0)) } // Scalar functions def keyword(a: List[Any]) = { val s = a(0).asInstanceOf[String] if (0 < s.length && s(0) == '\u029e') s else "\u029e" + s } def keyword_Q(a: List[Any]) = { a(0) match { case s: String => s.length != 0 && s(0) == '\u029e' case _ => false } } def string_Q(a: List[Any]) = { a(0) match { case s: String => s.length == 0 || s(0) != '\u029e' case _ => false } } def fn_Q(a: List[Any]) = { a(0) match { case s: Func => true case s: MalFunction => !s.asInstanceOf[MalFunction].ismacro case _ => false } } def macro_Q(a: List[Any]) = { a(0) match { case s: MalFunction => s.asInstanceOf[MalFunction].ismacro case _ => false } } // number functions def _bool_op(a: List[Any], op: (Long, Long) => Boolean) = { op(a(0).asInstanceOf[Long],a(1).asInstanceOf[Long]) } def _num_op(a: List[Any], op: (Long, Long) => Long) = { op(a(0).asInstanceOf[Long],a(1).asInstanceOf[Long]) } def number_Q(a: List[Any]) = { a(0).isInstanceOf[Long] || a(0).isInstanceOf[Double] } // string functions def read_string(a: List[Any]) = { reader.read_str(a(0).asInstanceOf[String]) } def slurp(a: List[Any]) = { Source.fromFile(a(0).asInstanceOf[String]).getLines.mkString("\n") + "\n" } // Hash Map functions def assoc(a: List[Any]): Any = { a(0).asInstanceOf[MalHashMap] ++ _hash_map(a.drop(1):_*) } def dissoc(a: List[Any]): Any = { var kSet = a.drop(1).toSet a(0).asInstanceOf[MalHashMap] .filterKeys{ !kSet.contains(_) } } def get(a: List[Any]): Any = { val hm = a(0).asInstanceOf[MalHashMap] val key = a(1).asInstanceOf[String] if (hm != null && hm.value.contains(key)) hm(key) else null } def contains_Q(a: List[Any]): Any = { a(0).asInstanceOf[MalHashMap].value .contains(a(1).asInstanceOf[String]) } // sequence functions def concat(a: List[Any]): Any = { _list((for (sq <- a) yield types._toIter(sq)).flatten:_*) } def nth(a: List[Any]): Any = { val lst = a(0).asInstanceOf[MalList].value val idx = a(1).asInstanceOf[Long] if (idx < lst.length) { lst(idx.toInt) } else { throw new Exception("nth: index out of range") } } def first(a: List[Any]): Any = { a(0) match { case null => null case ml: MalList => { val lst = ml.value if (lst.length > 0) lst(0) else null } } } def rest(a: List[Any]): Any = { a(0) match { case null => _list() case ml: MalList => _list(ml.drop(1).value:_*) } } def empty_Q(a: List[Any]): Any = { a(0) match { case null => true case ml: MalList => ml.value.isEmpty } } def count(a: List[Any]): Any = { a(0) match { case null => 0 case ml: MalList => ml.value.length.asInstanceOf[Long] } } def apply(a: List[Any]): Any = { a match { case f :: rest => { var args1 = rest.slice(0,rest.length-1) var args = args1 ++ rest(rest.length-1).asInstanceOf[MalList].value types._apply(f, args) } case _ => throw new Exception("invalid apply call") } } def do_map(a: List[Any]): Any = { a match { case f :: seq :: Nil => { var res = seq.asInstanceOf[MalList].map(x => types._apply(f,List(x))); _list(res.value:_*) } case _ => throw new Exception("invalid map call") } } def conj(a: List[Any]): Any = { a(0) match { case mv: MalVector => { _vector(mv.value ++ a.slice(1,a.length):_*) } case ml: MalList => { _list(a.slice(1,a.length).reverse ++ ml.value:_*) } } } def seq(a: List[Any]): Any = { a(0) match { case mv: MalVector => { if (mv.value.length == 0) null else _list(mv.value:_*) } case ml: MalList => { if (ml.value.length == 0) null else ml } case ms: String => { if (ms.length == 0) null else _list(ms.split("(?!^)"):_*) } case null => null case _ => throw new Exception("seq: called on non-sequence") } } // meta functions def with_meta(a: List[Any]): Any = { val meta: Any = a(1) a(0) match { case ml: MalList => { val new_ml = ml.clone() new_ml.meta = meta new_ml } case hm: MalHashMap => { val new_hm = hm.clone() new_hm.meta = meta new_hm } case fn: Func => { val new_fn = fn.clone() new_fn.meta = meta new_fn } case fn: MalFunction => { val new_fn = fn.clone() new_fn.meta = meta new_fn } case _ => throw new Exception("no meta support for " + a(0).getClass) } } def meta(a: List[Any]): Any = { a(0) match { case ml: MalList => ml.meta case hm: MalHashMap => hm.meta case fn: Func => fn.meta case fn: MalFunction => fn.meta case _ => throw new Exception("no meta support for " + a(0).getClass) } } // atom functions def reset_BANG(a: List[Any]): Any = { a(0).asInstanceOf[types.Atom].value = a(1) a(1) } def swap_BANG(a: List[Any]): Any = { a match { case a0 :: f :: rest => { val atm = a0.asInstanceOf[types.Atom] val args = atm.value +: rest atm.value = types._apply(f, args) atm.value } case _ => throw new Exception("invalid swap! call") } } val ns: Map[String, (List[Any]) => Any] = Map( "=" -> ((a: List[Any]) => types._equal_Q(a(0), a(1))), "throw" -> mal_throw _, "nil?" -> ((a: List[Any]) => a(0) == null), "true?" -> ((a: List[Any]) => a(0) == true), "false?" -> ((a: List[Any]) => a(0) == false), "number?" -> number_Q _, "string?" -> string_Q _, "symbol" -> ((a: List[Any]) => Symbol(a(0).asInstanceOf[String])), "symbol?" -> ((a: List[Any]) => a(0).isInstanceOf[Symbol]), "keyword" -> keyword _, "keyword?" -> keyword_Q _, "fn?" -> fn_Q, "macro?" -> macro_Q, "pr-str" -> ((a: List[Any]) => _pr_list(a, true, " ")), "str" -> ((a: List[Any]) => _pr_list(a, false, "")), "prn" -> ((a: List[Any]) => { println(_pr_list(a, true, " ")); null}), "println" -> ((a: List[Any]) => { println(_pr_list(a, false, " ")); null}), "readline" -> ((a: List[Any]) => readLine(a(0).asInstanceOf[String])), "read-string" -> read_string _, "slurp" -> slurp _, "<" -> ((a: List[Any]) => _bool_op(a, _ < _)), "<=" -> ((a: List[Any]) => _bool_op(a, _ <= _)), ">" -> ((a: List[Any]) => _bool_op(a, _ > _)), ">=" -> ((a: List[Any]) => _bool_op(a, _ >= _)), "+" -> ((a: List[Any]) => _num_op(a, _ + _)), "-" -> ((a: List[Any]) => _num_op(a, _ - _)), "*" -> ((a: List[Any]) => _num_op(a, _ * _)), "/" -> ((a: List[Any]) => _num_op(a, _ / _)), "time-ms" -> ((a: List[Any]) => System.currentTimeMillis), "list" -> ((a: List[Any]) => _list(a:_*)), "list?" -> ((a: List[Any]) => _list_Q(a(0))), "vector" -> ((a: List[Any]) => _vector(a:_*)), "vector?" -> ((a: List[Any]) => _vector_Q(a(0))), "hash-map" -> ((a: List[Any]) => _hash_map(a:_*)), "map?" -> ((a: List[Any]) => _hash_map_Q(a(0))), "assoc" -> assoc _, "dissoc" -> dissoc _, "get" -> get _, "contains?" -> contains_Q _, "keys" -> ((a: List[Any]) => a(0).asInstanceOf[MalHashMap].keys), "vals" -> ((a: List[Any]) => a(0).asInstanceOf[MalHashMap].vals), "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 _, "empty?" -> empty_Q _, "count" -> count _, "apply" -> apply _, "map" -> do_map _, "conj" -> conj _, "seq" -> seq _, "with-meta" -> with_meta _, "meta" -> meta _, "atom" -> ((a: List[Any]) => new types.Atom(a(0))), "atom?" -> ((a: List[Any]) => a(0).isInstanceOf[types.Atom]), "deref" -> ((a: List[Any]) => a(0).asInstanceOf[types.Atom].value), "reset!" -> reset_BANG _, "swap!" -> swap_BANG _ ) } // vim:ts=2:sw=2 ================================================ FILE: impls/scala/env.scala ================================================ import types._list import scala.collection.mutable object env { class Env(outer: Env = null, binds: Iterator[Any] = null, exprs: Iterator[Any] = null) { val data: mutable.Map[Symbol, Any] = mutable.Map() if (binds != null && exprs != null) { binds.foreach(b => { val k = b.asInstanceOf[Symbol] if (k == '&) { data(binds.next().asInstanceOf[Symbol]) = _list(exprs.toSeq:_*) } else { data(k) = exprs.next() } }) } def find(key: Symbol): Env = { if (data.contains(key)) { this } else if (outer != null) { outer.find(key) } else { null } } def set(key: Symbol, value: Any): Any = { data(key) = value value } def get(key: Symbol): Any = { val env = find(key) if (env == null) throw new Exception("'" + key.name + "' not found") env.data(key) } } } // vim:ts=2:sw=2 ================================================ FILE: impls/scala/printer.scala ================================================ import types.{MalList, MalVector, MalHashMap, MalFunction} object printer { def _pr_str(obj: Any, print_readably: Boolean = true): String = { val _r = print_readably return obj match { case v: MalVector => v.toString(_r) case l: MalList => l.toString(_r) case hm: MalHashMap => hm.toString(_r) case s: String => { if (s.length > 0 && s(0) == '\u029e') { ":" + s.substring(1,s.length) } else if (_r) { //println("here1: " + s) "\"" + s.replace("\\", "\\\\") .replace("\"", "\\\"") .replace("\n", "\\n") + "\"" } else { s } } case Symbol(s) => s case a: types.Atom => "(atom " + a.value + ")" case null => "nil" case _ => { if (obj.isInstanceOf[MalFunction]) { val f = obj.asInstanceOf[MalFunction] "" } else { obj.toString } } } } def _pr_list(lst: List[Any], print_readably: Boolean = true, sep: String = " "): String = { lst.map{_pr_str(_, print_readably)}.mkString(sep) } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/project/assembly.sbt ================================================ addSbtPlugin("com.eed3si9n" % "sbt-assembly" % "0.14.6") ================================================ FILE: impls/scala/reader.scala ================================================ import scala.util.matching.Regex import types.{MalList, _list, MalVector, _vector, MalHashMap, _hash_map} object reader { class Reader (tokens: Array[String]) { var data = tokens var position: Int = 0 def peek(): String = { if (position >= data.length) return(null) data(position) } def next(): String = { if (position >= data.length) return(null) position = position + 1 data(position-1) } } def tokenize(str: String): Array[String] = { val re = """[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)""".r re.findAllMatchIn(str).map{ _.group(1) } .filter{ s => s != "" && s(0) != ';' } .toArray } def parse_str(s: String): String = { // TODO: use re.replaceAllIn instead for single pass s.replace("\\\\", "\u029e") .replace("\\\"", "\"") .replace("\\n", "\n") .replace("\u029e", "\\") } def read_atom(rdr: Reader): Any = { val token = rdr.next() val re_int = """^(-?[0-9]+)$""".r val re_flt = """^(-?[0-9][0-9.]*)$""".r val re_str = """^"((?:\\.|[^\\"])*)"$""".r val re_str_bad = """^"(.*)$""".r val re_key = """^:(.*)$""".r return token match { case re_int(i) => i.toLong // integer case re_flt(f) => f.toDouble // float case re_str(s) => parse_str(s) // string case re_str_bad(s) => throw new Exception("expected '\"', got EOF") case re_key(k) => "\u029e" + k // keyword case "nil" => null case "true" => true case "false" => false case _ => Symbol(token) // symbol } } def read_list(rdr: Reader, start: String = "(", end: String = ")"): MalList = { var ast: MalList = _list() var token = rdr.next() if (token != start) throw new Exception("expected '" + start + "', got EOF") while ({token = rdr.peek(); token != end}) { if (token == null) throw new Exception("expected '" + end + "', got EOF") ast = ast :+ read_form(rdr) } rdr.next() ast } def read_form(rdr: Reader): Any = { return rdr.peek() match { case "'" => { rdr.next; _list(Symbol("quote"), read_form(rdr)) } case "`" => { rdr.next; _list(Symbol("quasiquote"), read_form(rdr)) } case "~" => { rdr.next; _list(Symbol("unquote"), read_form(rdr)) } case "~@" => { rdr.next; _list(Symbol("splice-unquote"), read_form(rdr)) } case "^" => { rdr.next; val meta = read_form(rdr); _list(Symbol("with-meta"), read_form(rdr), meta) } case "@" => { rdr.next; _list(Symbol("deref"), read_form(rdr)) } case "(" => read_list(rdr) case ")" => throw new Exception("unexpected ')')") case "[" => _vector(read_list(rdr, "[", "]").value:_*) case "]" => throw new Exception("unexpected ']')") case "{" => _hash_map(read_list(rdr, "{", "}").value:_*) case "}" => throw new Exception("unexpected '}')") case _ => read_atom(rdr) } } def read_str(str: String): Any = { val tokens = tokenize(str) if (tokens.length == 0) return null return read_form(new Reader(tokens)) } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/run ================================================ #!/usr/bin/env bash exec java -classpath "$(dirname $0)/target/scala-2.11/mal.jar" "${STEP:-stepA_mal}" "$@" ================================================ FILE: impls/scala/step0_repl.scala ================================================ object step0_repl { def READ(str: String): String = { str } def EVAL(str: String, env: String): String = { str } def PRINT(str: String): String = { str } def REP(str: String): String = { PRINT(EVAL(READ(str), "")) } def main(args: Array[String]) { var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Exception => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step1_read_print.scala ================================================ import reader.tokenize object step1_read_print { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(ast: Any, env: String): Any = { ast } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val REP = (str: String) => { PRINT(EVAL(READ(str), "")) } var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Exception => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step2_eval.scala ================================================ import types.{MalList, _list_Q, MalVector, MalHashMap, MalFunction} object step2_eval { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(ast: Any, env: Map[Symbol,Any]): Any = { // println("EVAL: " + printer._pr_str(ast,true)) ast match { case s : Symbol => return env(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list if (ast.asInstanceOf[MalList].value.length == 0) return ast ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: List[Any] => Any = null try { fn = f.asInstanceOf[List[Any] => Any] } catch { case _: Throwable => throw new Exception("attempt to call non-function") } return fn(el) } case _ => throw new Exception("invalid apply") } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Map[Symbol,Any] = Map( '+ -> ((a: List[Any]) => a(0).asInstanceOf[Long] + a(1).asInstanceOf[Long]), '- -> ((a: List[Any]) => a(0).asInstanceOf[Long] - a(1).asInstanceOf[Long]), '* -> ((a: List[Any]) => a(0).asInstanceOf[Long] * a(1).asInstanceOf[Long]), '/ -> ((a: List[Any]) => a(0).asInstanceOf[Long] / a(1).asInstanceOf[Long])) val REP = (str: String) => { PRINT(EVAL(READ(str), repl_env)) } var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Exception => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step3_env.scala ================================================ import types.{MalList, _list_Q, MalVector, MalHashMap, MalFunction} import env.Env object step3_env { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(ast: Any, env: Env): Any = { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } return EVAL(a2, let_env) } case _ => { // function call ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: List[Any] => Any = null try { fn = f.asInstanceOf[(List[Any]) => Any] } catch { case _: Throwable => throw new Exception("attempt to call non-function") } return fn(el) } case _ => throw new Exception("invalid apply") } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() repl_env.set('+, (a: List[Any]) => a(0).asInstanceOf[Long] + a(1).asInstanceOf[Long]) repl_env.set('-, (a: List[Any]) => a(0).asInstanceOf[Long] - a(1).asInstanceOf[Long]) repl_env.set('*, (a: List[Any]) => a(0).asInstanceOf[Long] * a(1).asInstanceOf[Long]) repl_env.set('/, (a: List[Any]) => a(0).asInstanceOf[Long] / a(1).asInstanceOf[Long]) val REP = (str: String) => { PRINT(EVAL(READ(str), repl_env)) } var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step4_if_fn_do.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step4_if_fn_do { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(ast: Any, env: Env): Any = { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } return EVAL(a2, let_env) } case Symbol("do") :: rest => { val el = rest.map(EVAL(_, env)) return el.last } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null return EVAL(rest(0), env) } else { return EVAL(a2, env) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new Func((args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) }) } case _ => { // function call ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { var fn: Func = null try { fn = f.asInstanceOf[Func] } catch { case _: Throwable => throw new Exception("attempt to call non-function") } return fn(el) } case _ => throw new Exception("invalid apply") } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step5_tco.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step5_tco { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case _ => { // function call ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { f match { case fn: MalFunction => { env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } case fn: Func => { return fn(el) } case _ => { throw new Exception("attempt to call non-function: " + f) } } } case _ => throw new Exception("invalid apply") } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step6_file.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step6_file { // read def READ(str: String): Any = { reader.read_str(str) } // eval def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case _ => { // function call ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { f match { case fn: MalFunction => { env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } case fn: Func => { return fn(el) } case _ => { throw new Exception("attempt to call non-function: " + f) } } } case _ => throw new Exception("invalid apply") } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") System.exit(0) } // repl loop var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step7_quote.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step7_quote { // read def READ(str: String): Any = { reader.read_str(str) } // eval 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 = { 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) } } case _ : Symbol => _list(Symbol("quote"), ast) case _ : MalHashMap => _list(Symbol("quote"), ast) case _ => ast } } def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("quote") :: a1 :: Nil => { return a1 } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case _ => { // function call ast.asInstanceOf[MalList].map(EVAL(_, env)).value match { case f :: el => { f match { case fn: MalFunction => { env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } case fn: Func => { return fn(el) } case _ => { throw new Exception("attempt to call non-function: " + f) } } } case _ => throw new Exception("invalid apply") } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") System.exit(0) } // repl loop var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step8_macros.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step8_macros { // read def READ(str: String): Any = { reader.read_str(str) } // eval 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 = { 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) } } case _ : Symbol => _list(Symbol("quote"), ast) case _ : MalHashMap => _list(Symbol("quote"), ast) case _ => ast } } def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("quote") :: a1 :: Nil => { return a1 } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } case Symbol("defmacro!") :: a1 :: a2 :: Nil => { val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() f.ismacro = true return env.set(a1.asInstanceOf[Symbol], f) } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case first :: rest => { // function call EVAL(first, env) match { case fn: MalFunction => { if (fn.ismacro) { ast = fn(rest) // continue loop (TCO) } else { val el = rest.map(EVAL(_, env)) env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } } case fn: Func => { val el = rest.map(EVAL(_, env)) return fn(el) } case f => { throw new Exception("attempt to call non-function: " + f) } } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") System.exit(0) } // repl loop var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/step9_try.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object step9_try { // read def READ(str: String): Any = { reader.read_str(str) } // eval 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 = { 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) } } case _ : Symbol => _list(Symbol("quote"), ast) case _ : MalHashMap => _list(Symbol("quote"), ast) case _ => ast } } def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("quote") :: a1 :: Nil => { return a1 } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } case Symbol("defmacro!") :: a1 :: a2 :: Nil => { val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() f.ismacro = true return env.set(a1.asInstanceOf[Symbol], f) } case Symbol("try*") :: a1 :: rest => { try { return EVAL(a1, env) } catch { case t: Throwable => { if (rest.length == 0) throw t rest(0).asInstanceOf[MalList].value match { case List(Symbol("catch*"), a21, a22) => { val exc: Any = t match { case mex: types.MalException => mex.value case _ => t.getMessage } return EVAL(a22, new Env(env, List(a21).iterator, List(exc).iterator)) } } throw t } } } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case first :: rest => { // function call EVAL(first, env) match { case fn: MalFunction => { if (fn.ismacro) { ast = fn(rest) // continue loop (TCO) } else { val el = rest.map(EVAL(_, env)) env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } } case fn: Func => { val el = rest.map(EVAL(_, env)) return fn(el) } case f => { throw new Exception("attempt to call non-function: " + f) } } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) // core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") System.exit(0) } // repl loop var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/stepA_mal.scala ================================================ import types.{MalList, _list, _list_Q, MalVector, MalHashMap, Func, MalFunction} import env.Env object stepA_mal { // read def READ(str: String): Any = { reader.read_str(str) } // eval 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 = { 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) } } case _ : Symbol => _list(Symbol("quote"), ast) case _ : MalHashMap => _list(Symbol("quote"), ast) case _ => ast } } def EVAL(orig_ast: Any, orig_env: Env): Any = { var ast = orig_ast; var env = orig_env; while (true) { if (env.find(Symbol("DEBUG-EVAL")) != null) { val dbgeval = env.get(Symbol("DEBUG-EVAL")) if (dbgeval != null && dbgeval != false) { println("EVAL: " + printer._pr_str(ast,true)) } } ast match { case s : Symbol => return env.get(s) case v: MalVector => return v.map(EVAL(_, env)) case l: MalList => {} case m: MalHashMap => { return m.map{case (k,v) => (k, EVAL(v, env))} } case _ => return ast } // apply list ast.asInstanceOf[MalList].value match { case Nil => { return ast } case Symbol("def!") :: a1 :: a2 :: Nil => { return env.set(a1.asInstanceOf[Symbol], EVAL(a2, env)) } case Symbol("let*") :: a1 :: a2 :: Nil => { val let_env = new Env(env) for (g <- a1.asInstanceOf[MalList].value.grouped(2)) { let_env.set(g(0).asInstanceOf[Symbol],EVAL(g(1),let_env)) } env = let_env ast = a2 // continue loop (TCO) } case Symbol("quote") :: a1 :: Nil => { return a1 } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } case Symbol("defmacro!") :: a1 :: a2 :: Nil => { val f = EVAL(a2, env).asInstanceOf[MalFunction].clone() f.ismacro = true return env.set(a1.asInstanceOf[Symbol], f) } case Symbol("try*") :: a1 :: rest => { try { return EVAL(a1, env) } catch { case t: Throwable => { if (rest.length == 0) throw t rest(0).asInstanceOf[MalList].value match { case List(Symbol("catch*"), a21, a22) => { val exc: Any = t match { case mex: types.MalException => mex.value case _ => t.getMessage } return EVAL(a22, new Env(env, List(a21).iterator, List(exc).iterator)) } } throw t } } } case Symbol("do") :: rest => { rest.slice(0,rest.length-1).map(EVAL(_, env)) ast = ast.asInstanceOf[MalList].value.last // continue loop (TCO) } case Symbol("if") :: a1 :: a2 :: rest => { val cond = EVAL(a1, env) if (cond == null || cond == false) { if (rest.length == 0) return null ast = rest(0) // continue loop (TCO) } else { ast = a2 // continue loop (TCO) } } case Symbol("fn*") :: a1 :: a2 :: Nil => { return new MalFunction(a2, env, a1.asInstanceOf[MalList], (args: List[Any]) => { EVAL(a2, new Env(env, types._toIter(a1), args.iterator)) } ) } case first :: rest => { // function call EVAL(first, env) match { case fn: MalFunction => { if (fn.ismacro) { ast = fn(rest) // continue loop (TCO) } else { val el = rest.map(EVAL(_, env)) env = fn.gen_env(el) ast = fn.ast // continue loop (TCO) } } case fn: Func => { val el = rest.map(EVAL(_, env)) return fn(el) } case f => { throw new Exception("attempt to call non-function: " + f) } } } } } } // print def PRINT(exp: Any): String = { printer._pr_str(exp, true) } // repl def main(args: Array[String]) = { val repl_env: Env = new Env() val REP = (str: String) => PRINT(EVAL(READ(str), repl_env)) // core.scala: defined using scala core.ns.map{case (k: String,v: Any) => { repl_env.set(Symbol(k), new Func(v)) }} repl_env.set(Symbol("eval"), new Func((a: List[Any]) => EVAL(a(0), repl_env))) repl_env.set(Symbol("*ARGV*"), _list(args.slice(1,args.length):_*)) // core.mal: defined using the language itself REP("(def! *host-language* \"scala\")") REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (args.length > 0) { REP("(load-file \"" + args(0) + "\")") System.exit(0) } // repl loop REP("(println (str \"Mal [\" *host-language* \"]\"))") var line:String = null while ({line = readLine("user> "); line != null}) { try { println(REP(line)) } catch { case e : Throwable => { println("Error: " + e.getMessage) println(" " + e.getStackTrace.mkString("\n ")) } } } } } // vim: ts=2:sw=2 ================================================ FILE: impls/scala/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/scala/types.scala ================================================ import scala.collection._ import scala.collection.generic._ import env.Env import printer._pr_str object types { class MalException(msg: String) extends Throwable(msg) { var value: Any = null def init(obj: Any) = { value = obj; this } } def _toIter(obj: Any): Iterator[Any] = { obj match { case v: MalVector => v.value.iterator case l: MalList => l.value.iterator case null => Iterator.empty case _ => throw new Exception("cannot convert " + obj.getClass + " to iterator") } } def _equal_Q(a: Any, b: Any): Any = { (a, b) match { case (a: MalList, b: MalList) => { if (a.value.length != b.value.length) return false for ( (x, y) <- (a.value zip b.value) ) { if (_equal_Q(x, y) != true) return false } true } case (a: MalHashMap, b: MalHashMap) => { if (a.value.size != b.value.size) return false for ( (k,v) <- a.value ) { if (_equal_Q(v,b.value(k)) != true) return false } true } case _ => a == b } } def _sequential_Q(a: Any): Boolean = { a match { case l: MalList => true case _ => false } } def _symbol_Q(a: Any) = { a.isInstanceOf[Symbol] } // Lists class MalList(seq: Any*) { var value: List[Any] = seq.toList var meta: Any = null override def clone(): MalList = { val new_ml = new MalList() new_ml.value = value new_ml.meta = meta new_ml } def apply(idx: Int): Any = value(idx) def map(f: Any => Any) = new MalList(value.map(f):_*) def drop(cnt: Int) = new MalList(value.drop(cnt):_*) def :+(that: Any) = new MalList((value :+ that):_*) def +:(that: Any) = new MalList((that +: value):_*) override def toString() = { "(" + value.map(_pr_str(_, true)).mkString(" ") + ")" } def toString(print_readably: Boolean) = { "(" + value.map(_pr_str(_, print_readably)).mkString(" ") + ")" } } def _list(seq: Any*) = { new MalList(seq:_*) } def _list_Q(obj: Any) = { obj.isInstanceOf[MalList] && !obj.isInstanceOf[MalVector] } // Vectors class MalVector(seq: Any*) extends MalList(seq:_*) { override def clone() = { val new_mv = new MalVector() new_mv.value = value new_mv.meta = meta new_mv } override def map(f: Any => Any) = new MalVector(value.map(f):_*) override def drop(cnt: Int) = new MalVector(value.drop(cnt):_*) override def toString() = { "[" + value.map(_pr_str(_, true)).mkString(" ") + "]" } override def toString(print_readably: Boolean) = { "[" + value.map(_pr_str(_, print_readably)).mkString(" ") + "]" } } def _vector(seq: Any*) = { new MalVector(seq:_*) } def _vector_Q(obj: Any) = { obj.isInstanceOf[MalVector] } // Hash Maps class MalHashMap(seq: Any*) { var value: Map[String,Any] = seq.toList.grouped(2).map( (kv: List[Any]) => (kv(0).asInstanceOf[String], kv(1))).toMap var meta: Any = null override def clone(): MalHashMap = { val new_hm = new MalHashMap() new_hm.value = value new_hm.meta = meta new_hm } def keys(): MalList = new MalList(value.keys.toSeq:_*) def vals(): MalList = new MalList(value.values.toSeq:_*) def apply(key: String): Any = value(key) def map(f: ((String, Any)) => (String, Any)) = { val res = value.map(f).map{case (k,v) => List(k,v)} new MalHashMap(res.flatten.toSeq:_*) } def filterKeys(f: String => Boolean) = { val res = value.filterKeys(f).map{case (k,v) => List(k,v)} new MalHashMap(res.flatten.toSeq:_*) } def ++(that: MalHashMap) = { val new_hm = clone() new_hm.value ++= that.value new_hm } override def toString() = { var res = mutable.MutableList[Any]() for ((k,v) <- value) { res += _pr_str(k, true) res += _pr_str(v, true) } "{" + res.mkString(" ") + "}" } def toString(print_readably: Boolean) = { var res = mutable.MutableList[Any]() for ((k,v) <- value) { res += _pr_str(k, print_readably) res += _pr_str(v, print_readably) } "{" + res.mkString(" ") + "}" } } def _hash_map(seq: Any*) = { new MalHashMap(seq:_*) } def _hash_map_Q(obj: Any) = { obj.isInstanceOf[MalHashMap] } // Function types class Func(_fn: ((List[Any]) => Any)) { val fn = _fn var meta: Any = null override def clone(): Func = { val new_fn = new Func(fn) new_fn.meta = meta new_fn } def apply(args: List[Any]): Any = fn(args) } class MalFunction(_ast: Any, _env: Env, _params: MalList, fn: ((List[Any]) => Any)) { val ast = _ast val env = _env val params = _params var ismacro = false var meta: Any = null override def clone(): MalFunction = { val new_fn = new MalFunction(ast, env, params, fn) new_fn.ismacro = ismacro new_fn.meta = meta new_fn } def apply(args: List[Any]): Any = fn(args) def gen_env(args: List[Any]): Env = { return new Env(env, params.value.iterator, args.iterator) } } def _apply(f: Any, args: List[Any]): Any = { f match { case fn: types.MalFunction => fn(args) case fn: Func => fn(args) case _ => throw new Exception("attempt to call non-function") } } def _hash_map(lst: List[Any]): Any = { lst.grouped(2).map( (kv: List[Any]) => (kv(0).asInstanceOf[String], kv(1))).toMap } class Atom(_value: Any) { var value = _value } } // vim:ts=2:sw=2 ================================================ FILE: impls/scheme/.gitignore ================================================ lib/*.scm lib/*.so lib/*.c lib/*.o lib/*.meta lib.*.scm *.so *.c *.o out/ eggs/* ================================================ FILE: impls/scheme/Dockerfile ================================================ FROM ubuntu:focal MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Dev tools RUN DEBIAN_FRONTEND=noninteractive apt-get -y install gcc g++ bison flex groff make cmake pkg-config git # Prepackaged Scheme implementations RUN apt-get -y install gauche chicken-bin RUN chicken-install r7rs # Chibi RUN cd /tmp && curl -Lo chibi-0.10.tar.gz https://github.com/ashinn/chibi-scheme/archive/0.10.tar.gz \ && tar xvzf chibi-0.10.tar.gz && cd chibi-scheme-0.10 \ && make && make install && rm -rf /tmp/chibi-* # Kawa RUN apt-get -y install openjdk-8-jdk-headless RUN cd /tmp && curl -O http://ftp.gnu.org/pub/gnu/kawa/kawa-3.1.1.tar.gz \ && tar xvzf kawa-3.1.1.tar.gz && cd kawa-3.1.1 \ && ./configure && make && make install && rm -rf /tmp/kawa-3.1.1* # Sagittarius RUN apt-get -y install libgc-dev zlib1g-dev libffi-dev libssl-dev RUN cd /tmp && curl -LO https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/sagittarius-0.9.7.tar.gz \ && tar xvzf sagittarius-0.9.7.tar.gz && cd sagittarius-0.9.7 \ && cmake . && make && make install && rm -rf /tmp/sagittarius-0.9.7* # Cyclone RUN apt-get -y install libck-dev libtommath-dev RUN cd /tmp && git clone https://github.com/justinethier/cyclone-bootstrap \ && cd cyclone-bootstrap \ && make && make install && rm -rf /tmp/cyclone-bootstrap # Foment RUN cd /tmp && git clone https://github.com/leftmike/foment \ && cd foment/unix && make && cp release/foment /usr/bin/foment \ && rm -rf /tmp/foment ENV HOME /mal ================================================ FILE: impls/scheme/Makefile ================================================ BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco BINS += step6_file step7_quote step8_macros step9_try stepA_mal scheme_MODE ?= chibi CLASSSTEPS = out/step0_repl.class out/step1_read_print.class \ out/step3_env.class out/step4_if_fn_do.class out/step5_tco.class \ out/step6_file.class out/step7_quote.class out/step8_macros.class \ out/step9_try.class out/stepA_mal.class STEPS = $(if $(filter kawa,$(scheme_MODE)),$(CLASSSTEPS),\ $(if $(filter chicken,$(scheme_MODE)),$(BINS),\ $(if $(filter cyclone,$(scheme_MODE)),$(BINS)))) KAWA_STEP1_DEPS = out/lib/util.class out/lib/reader.class \ out/lib/printer.class out/lib/types.class KAWA_STEP3_DEPS = $(KAWA_STEP1_DEPS) out/lib/env.class KAWA_STEP4_DEPS = $(KAWA_STEP3_DEPS) out/lib/core.class CHICKEN_STEP1_DEPS = lib.util.so lib.types.so lib.reader.so lib.printer.so CHICKEN_STEP3_DEPS = $(CHICKEN_STEP1_DEPS) lib.env.so CHICKEN_STEP4_DEPS = $(CHICKEN_STEP3_DEPS) lib.core.so CYCLONE_STEP1_DEPS = lib/util.so lib/reader.so lib/printer.so lib/types.so CYCLONE_STEP3_DEPS = $(CYCLONE_STEP1_DEPS) lib/env.so CYCLONE_STEP4_DEPS = $(CYCLONE_STEP3_DEPS) lib/core.so STEP1_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP1_DEPS),\ $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP1_DEPS),\ $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP1_DEPS)))) STEP3_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP3_DEPS),\ $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP3_DEPS),\ $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP3_DEPS)))) STEP4_DEPS = $(if $(filter kawa,$(scheme_MODE)),$(KAWA_STEP4_DEPS),\ $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN_STEP4_DEPS),\ $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE_STEP4_DEPS)))) KAWALIB = kawa --r7rs --no-warn-unused -d out -C KAWA = kawa --r7rs --no-warn-unused -d out --main -C CHICKEN = csc -setup-mode -host -O3 -R r7rs CHICKENLIB = $(CHICKEN) -D compiling-extension -J -s -regenerate-import-libraries CYCLONELIB = cyclone -O2 CYCLONE = $(CYCLONELIB) SCMLIB = $(if $(filter kawa,$(scheme_MODE)),$(KAWALIB),\ $(if $(filter chicken,$(scheme_MODE)),$(CHICKENLIB),\ $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONELIB)))) SCM = $(if $(filter kawa,$(scheme_MODE)),$(KAWA),\ $(if $(filter chicken,$(scheme_MODE)),$(CHICKEN),\ $(if $(filter cyclone,$(scheme_MODE)),$(CYCLONE)))) MKDIR = mkdir -p SYMLINK = ln -sfr RM = rm -f RMR = rm -rf all: $(STEPS) .PHONY: clean .PRECIOUS: lib/%.scm lib/%.scm: lib/%.sld $(SYMLINK) $< $@ out/lib/%.class: lib/%.scm $(SCMLIB) $< out/%.class: %.scm $(SCM) $< lib.%.so: lib/%.sld $(SCMLIB) $< -o $@ lib/%.so: lib/%.sld $(SCMLIB) $< %: %.scm $(SCM) $< out/step1_read_print.class out/step2_eval.class: $(STEP1_DEPS) out/step3_env.class: $(STEP3_DEPS) out/step4_if_fn_do.class out/step5_tco.class out/step6_file.class out/step7_quote.class out/step8_macros.class out/step9_try.class out/stepA_mal.class: $(STEP4_DEPS) step1_read_print.scm step2_eval.scm: $(STEP1_DEPS) step3_env.scm: $(STEP3_DEPS) step4_if_fn_do.scm step5_tco.scm step6_file.scm step7_quote.scm step8_macros.scm step9_try.scm stepA_mal.scm: $(STEP4_DEPS) clean: $(RM) lib/*.scm lib/*.so lib/*.c lib/*.o lib/*.meta $(RM) lib.*.scm *.build.sh *.install.sh *.link *.so *.c *.o $(BINS) $(RMR) out ================================================ FILE: impls/scheme/lib/core.sld ================================================ (define-library (lib core) (export ns) (import (scheme base)) (import (scheme write)) (import (scheme file)) (import (scheme time)) (import (scheme read)) (import (scheme eval)) ;; HACK: cyclone doesn't implement environments yet, but its eval ;; behaves as if you were using the repl environment (cond-expand (cyclone) (else (import (scheme repl)))) (import (lib types)) (import (lib util)) (import (lib printer)) (import (lib reader)) (begin (define (coerce x) (if x mal-true mal-false)) (define (->printed-string args print-readably sep) (let ((items (map (lambda (arg) (pr-str arg print-readably)) args))) (string-intersperse items sep))) (define (mal-equal? a b) (let ((a-type (and (mal-object? a) (mal-type a))) (a-value (and (mal-object? a) (mal-value a))) (b-type (and (mal-object? b) (mal-type b))) (b-value (and (mal-object? b) (mal-value b)))) (cond ((or (not a-type) (not b-type)) mal-false) ((and (memq a-type '(list vector)) (memq b-type '(list vector))) (mal-list-equal? (->list a-value) (->list b-value))) ((and (eq? a-type 'map) (eq? b-type 'map)) (mal-map-equal? a-value b-value)) (else (and (eq? a-type b-type) (equal? a-value b-value)))))) (define (mal-list-equal? as bs) (let loop ((as as) (bs bs)) (cond ((and (null? as) (null? bs)) #t) ((or (null? as) (null? bs)) #f) (else (if (mal-equal? (car as) (car bs)) (loop (cdr as) (cdr bs)) #f))))) (define (mal-map-ref key m . default) (if (pair? default) (alist-ref key m mal-equal? (car default)) (alist-ref key m mal-equal?))) (define (mal-map-equal? as bs) (if (not (= (length as) (length bs))) #f (let loop ((as as)) (if (pair? as) (let* ((item (car as)) (key (car item)) (value (cdr item))) (if (mal-equal? (mal-map-ref key bs) value) (loop (cdr as)) #f)) #t)))) (define (mal-map-dissoc m keys) (let loop ((items m) (acc '())) (if (pair? items) (let* ((item (car items)) (key (car item))) (if (contains? keys (lambda (x) (mal-equal? key x))) (loop (cdr items) acc) (loop (cdr items) (cons item acc)))) (reverse acc)))) (define (mal-map-assoc m kvs) (let ((kvs (list->alist kvs))) (append kvs (mal-map-dissoc m (map car kvs))))) (define (map-in-order proc items) (let loop ((items items) (acc '())) (if (null? items) (reverse acc) (loop (cdr items) (cons (proc (car items)) acc))))) (define (slurp path) (call-with-output-string (lambda (out) (call-with-input-file path (lambda (in) (let loop () (let ((chunk (read-string 1024 in))) (when (not (eof-object? chunk)) (display chunk out) (loop))))))))) (define (time-ms) (* (/ (current-jiffy) (jiffies-per-second)) 1000.0)) (define (->mal-object x) (cond ((boolean? x) (if x mal-true mal-false)) ((char? x) (mal-string (char->string x))) ((procedure? x) x) ((symbol? x) (mal-symbol x)) ((number? x) (mal-number x)) ((string? x) (mal-string x)) ((or (null? x) (pair? x)) (mal-list (map ->mal-object x))) ((vector? x) (mal-vector (vector-map ->mal-object x))) (else (error "unknown type")))) (define (scm-eval input) (call-with-input-string input (lambda (port) (cond-expand (cyclone (->mal-object (eval (read port)))) (else (->mal-object (eval (read port) (environment '(scheme base) '(scheme write))))))))) (define ns `((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) (- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) (* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) (/ . ,(lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) (list . ,(lambda args (mal-list args))) (list? . ,(lambda (x) (coerce (mal-instance-of? x 'list)))) (empty? . ,(lambda (lis) (coerce (null? (->list (mal-value lis)))))) (count . ,(lambda (lis) (mal-number (if (eq? lis mal-nil) 0 (length (->list (mal-value lis))))))) (< . ,(lambda (a b) (coerce (< (mal-value a) (mal-value b))))) (<= . ,(lambda (a b) (coerce (<= (mal-value a) (mal-value b))))) (> . ,(lambda (a b) (coerce (> (mal-value a) (mal-value b))))) (>= . ,(lambda (a b) (coerce (>= (mal-value a) (mal-value b))))) (= . ,(lambda (a b) (coerce (mal-equal? a b)))) (pr-str . ,(lambda args (mal-string (->printed-string args #t " ")))) (str . ,(lambda args (mal-string (->printed-string args #f "")))) (prn . ,(lambda args (display (->printed-string args #t " ")) (newline) mal-nil)) (println . ,(lambda args (display (->printed-string args #f " ")) (newline) mal-nil)) (read-string . ,(lambda (string) (read-str (mal-value string)))) (slurp . ,(lambda (path) (mal-string (slurp (mal-value path))))) (throw . ,(lambda (x) (raise (cons 'user-error x)))) (readline . ,(lambda (prompt) (let ((output (readline (mal-value prompt)))) (if output (mal-string output) mal-nil)))) (time-ms . ,(lambda () (mal-number (time-ms)))) (scm-eval . ,(lambda (input) (scm-eval (mal-value input)))) (atom . ,(lambda (x) (mal-atom x))) (atom? . ,(lambda (x) (coerce (mal-instance-of? x 'atom)))) (deref . ,(lambda (atom) (mal-value atom))) (reset! . ,(lambda (atom x) (mal-value-set! atom x) x)) (swap! . ,(lambda (atom fn . args) (let* ((fn (if (func? fn) (func-fn fn) fn)) (value (apply fn (cons (mal-value atom) args)))) (mal-value-set! atom value) value))) (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)) (list-ref items index) (error (str "Out of range: " index)))))) (first . ,(lambda (x) (if (eq? x mal-nil) mal-nil (let ((items (->list (mal-value x)))) (if (null? items) mal-nil (car items)))))) (rest . ,(lambda (x) (if (eq? x mal-nil) (mal-list '()) (let ((items (->list (mal-value x)))) (if (null? items) (mal-list '()) (mal-list (cdr items))))))) (conj . ,(lambda (coll . args) (let ((items (mal-value coll))) (cond ((vector? items) (mal-vector (vector-append items (list->vector args)))) ((list? items) (mal-list (append (reverse args) items))) (else (error "invalid collection type")))))) (seq . ,(lambda (x) (if (eq? x mal-nil) mal-nil (let ((value (mal-value x))) (case (mal-type x) ((list) (if (null? value) mal-nil x)) ((vector) (if (zero? (vector-length value)) mal-nil (mal-list (vector->list value)))) ((string) (if (zero? (string-length value)) mal-nil (mal-list (map mal-string (explode value))))) (else (error "invalid collection type"))))))) (apply . ,(lambda (f . args) (apply (if (func? f) (func-fn f) f) (if (pair? (cdr args)) (append (butlast args) (->list (mal-value (last args)))) (->list (mal-value (car args))))))) (map . ,(lambda (f items) (mal-list (map-in-order (if (func? f) (func-fn f) f) (->list (mal-value items)))))) (nil? . ,(lambda (x) (coerce (eq? x mal-nil)))) (true? . ,(lambda (x) (coerce (eq? x mal-true)))) (false? . ,(lambda (x) (coerce (eq? x mal-false)))) (number? . ,(lambda (x) (coerce (mal-instance-of? x 'number)))) (string? . ,(lambda (x) (coerce (mal-instance-of? x 'string)))) (symbol? . ,(lambda (x) (coerce (mal-instance-of? x 'symbol)))) (symbol . ,(lambda (x) (mal-symbol (string->symbol (mal-value x))))) (keyword? . ,(lambda (x) (coerce (mal-instance-of? x 'keyword)))) (keyword . ,(lambda (x) (if (mal-instance-of? x 'keyword) x (mal-keyword (string->symbol (mal-value x)))))) (vector? . ,(lambda (x) (coerce (mal-instance-of? x 'vector)))) (vector . ,(lambda args (mal-vector (list->vector args)))) (map? . ,(lambda (x) (coerce (mal-instance-of? x 'map)))) (hash-map . ,(lambda args (mal-map (list->alist args)))) (sequential? . ,(lambda (x) (coerce (and (mal-object? x) (memq (mal-type x) '(list vector)))))) (fn? . ,(lambda (x) (coerce (or (procedure? x) (and (func? x) (not (func-macro? x))))))) (macro? . ,(lambda (x) (coerce (and (func? x) (func-macro? x))))) (assoc . ,(lambda (m . kvs) (mal-map (mal-map-assoc (mal-value m) kvs)))) (dissoc . ,(lambda (m . keys) (mal-map (mal-map-dissoc (mal-value m) keys)))) (get . ,(lambda (m key) (mal-map-ref key (mal-value m) mal-nil))) (contains? . ,(lambda (m key) (coerce (mal-map-ref key (mal-value m))))) (keys . ,(lambda (m) (mal-list (map car (mal-value m))))) (vals . ,(lambda (m) (mal-list (map cdr (mal-value m))))) (with-meta . ,(lambda (x meta) (cond ((mal-object? x) (make-mal-object (mal-type x) (mal-value x) meta)) ((func? x) (let ((func (make-func (func-ast x) (func-params x) (func-env x) (func-fn x)))) (func-macro?-set! func #f) (func-meta-set! func meta) func)) (else (error "unsupported type"))))) (meta . ,(lambda (x) (cond ((mal-object? x) (or (mal-meta x) mal-nil)) ((func? x) (or (func-meta x) mal-nil)) (else mal-nil)))) )) ) ) ================================================ FILE: impls/scheme/lib/env.sld ================================================ (define-library (lib env) (export make-env env-set env-get) (import (scheme base)) (import (lib util)) (import (lib types)) (begin (define-record-type env (%make-env outer data) env? (outer env-outer) (data env-data env-data-set!)) (define (make-env outer . rest) (let ((env (%make-env outer '()))) (when (pair? rest) (let loop ((binds (car rest)) (exprs (cadr rest))) (when (pair? binds) (let ((bind (car binds))) (if (eq? bind '&) (env-set env (cadr binds) (mal-list exprs)) (begin (env-set env bind (car exprs)) (loop (cdr binds) (cdr exprs)))))))) env)) (define (env-set env key value) (env-data-set! env (cons (cons key value) (env-data env)))) (define (env-get env key) (cond ((alist-ref key (env-data env)) => identity) ((env-outer env) => (lambda (outer) (env-get outer key))) (else #f))) ) ) ================================================ FILE: impls/scheme/lib/printer.sld ================================================ (define-library (lib printer) (export pr-str) (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib types)) (begin (define (pr-str ast print-readably) (cond ((procedure? ast) "#") ((func? ast) "#") (else (if (procedure? ast) "#" (let* ((type (and (mal-object? ast) (mal-type ast))) (value (and (mal-object? ast) (mal-value ast)))) (case type ((true) "true") ((false) "false") ((nil) "nil") ((number) (number->string value)) ((string) (call-with-output-string (lambda (port) (if print-readably (begin (display #\" port) (string-for-each (lambda (char) (case char ((#\\) (display "\\\\" port)) ((#\") (display "\\\"" port)) ((#\newline) (display "\\n" port)) (else (display char port)))) value) (display #\" port)) (display value port))))) ((keyword) (string-append ":" (symbol->string value))) ((symbol) (symbol->string value)) ((list) (pr-list value "(" ")" print-readably)) ((vector) (pr-list (vector->list value) "[" "]" print-readably)) ((map) (pr-list (alist->list value) "{" "}" print-readably)) ((atom) (string-append "(atom " (pr-str value print-readably) ")")) (else (error "unknown type")))))))) (define (pr-list items starter ender print-readably) (call-with-output-string (lambda (port) (display starter port) (let ((reprs (map (lambda (item) (pr-str item print-readably)) items))) (display (string-intersperse reprs " ") port)) (display ender port)))) ) ) ================================================ FILE: impls/scheme/lib/reader.sld ================================================ (define-library (lib reader) (export read-str) (import (scheme base)) (import (scheme char)) (import (scheme read)) (import (scheme write)) (import (lib util)) (import (lib types)) (begin (define-record-type reader (%make-reader tokens position) reader? (tokens %reader-tokens) (position %reader-position %reader-position-set!)) (define (make-reader tokens) (%make-reader (list->vector tokens) 0)) (define (peek reader) (let ((tokens (%reader-tokens reader)) (position (%reader-position reader))) (if (>= position (vector-length tokens)) #f (vector-ref tokens position)))) (define (next reader) (let ((token (peek reader))) (when token (%reader-position-set! reader (+ (%reader-position reader) 1))) token)) (define (read-str input) (let* ((tokens (tokenizer input)) (reader (make-reader tokens))) (read-form reader))) (define (whitespace-char? char) (or (char-whitespace? char) (char=? char #\,))) (define (special-char? char) (memv char '(#\[ #\] #\{ #\} #\( #\) #\' #\` #\~ #\^ #\@))) (define (non-word-char? char) (or (whitespace-char? char) (memv char '(#\[ #\] #\{ #\} #\( #\) #\' #\" #\` #\;)))) (define (tokenizer input) (call-with-input-string input (lambda (port) (let loop ((tokens '())) (if (eof-object? (peek-char port)) (reverse tokens) (let ((char (read-char port))) (cond ((whitespace-char? char) (loop tokens)) ((and (char=? char #\~) (char=? (peek-char port) #\@)) (read-char port) ; remove @ token (loop (cons "~@" tokens))) ((char=? char #\") (loop (cons (tokenize-string port) tokens))) ((char=? char #\;) (skip-comment port) (loop tokens)) ((special-char? char) (loop (cons (char->string char) tokens))) (else (loop (cons (tokenize-word port char) tokens)))))))))) (define (tokenize-string port) (let loop ((chars '(#\"))) (let ((char (read-char port))) (cond ((eof-object? char) (list->string (reverse chars))) ((char=? char #\\) (let ((char (read-char port))) (when (not (eof-object? char)) (loop (cons char (cons #\\ chars)))))) ((not (char=? char #\")) (loop (cons char chars))) ((char=? char #\") (list->string (reverse (cons #\" chars)))))))) (define (skip-comment port) (let loop () (let ((char (peek-char port))) (when (not (or (eof-object? char) (char=? char #\newline))) (read-char port) (loop))))) (define (tokenize-word port char) (let loop ((chars (list char))) (let ((char (peek-char port))) (if (or (eof-object? char) (non-word-char? char)) (list->string (reverse chars)) (loop (cons (read-char port) chars)))))) (define (read-form reader) (let ((token (peek reader))) (cond ((equal? token "'") (read-macro reader 'quote)) ((equal? token "`") (read-macro reader 'quasiquote)) ((equal? token "~") (read-macro reader 'unquote)) ((equal? token "~@") (read-macro reader 'splice-unquote)) ((equal? token "@") (read-macro reader 'deref)) ((equal? token "^") (read-meta reader)) ((equal? token "(") (read-list reader ")" mal-list)) ((equal? token "[") (read-list reader "]" (lambda (items) (mal-vector (list->vector items))))) ((equal? token "{") (read-list reader "}" (lambda (items) (mal-map (list->alist items))))) (else (read-atom reader))))) (define (read-macro reader symbol) (next reader) ; pop macro token (mal-list (list (mal-symbol symbol) (read-form reader)))) (define (read-meta reader) (next reader) ; pop macro token (let ((form (read-form reader))) (mal-list (list (mal-symbol 'with-meta) (read-form reader) form)))) (define (read-list reader ender proc) (next reader) ; pop list start (let loop ((items '())) (let ((token (peek reader))) (cond ((equal? token ender) (next reader) (proc (reverse items))) ((not token) (error (str "expected '" ender "', got EOF"))) (else (loop (cons (read-form reader) items))))))) (define (read-atom reader) (let ((token (next reader))) (cond ((not token) (error "end of token stream" 'empty-input)) ((equal? token "true") mal-true) ((equal? token "false") mal-false) ((equal? token "nil") mal-nil) ((string->number token) => mal-number) ((char=? (string-ref token 0) #\") (guard (ex ((cond-expand ;; HACK: https://github.com/ashinn/chibi-scheme/pull/540 (chibi (error-object? ex)) (else (read-error? ex))) (error (str "expected '" #\" "', got EOF")))) (mal-string (call-with-input-string token read)))) ((char=? (string-ref token 0) #\:) (mal-keyword (string->symbol (string-copy token 1)))) (else (mal-symbol (string->symbol token)))))) ) ) ================================================ FILE: impls/scheme/lib/types.sld ================================================ (define-library (lib types) (export make-mal-object mal-object? mal-type mal-value mal-value-set! mal-meta mal-true mal-false mal-nil mal-number mal-string mal-symbol mal-keyword mal-list mal-vector mal-map mal-atom make-func func? func-ast func-params func-env func-fn func-macro? func-macro?-set! func-meta func-meta-set! mal-instance-of?) (import (scheme base)) (begin (define-record-type mal-object (make-mal-object type value meta) mal-object? (type mal-type) (value mal-value mal-value-set!) (meta mal-meta mal-meta-set!)) (define mal-true (make-mal-object 'true #t #f)) (define mal-false (make-mal-object 'false #f #f)) (define mal-nil (make-mal-object 'nil #f #f)) (define (mal-number n) (make-mal-object 'number n #f)) (define (mal-string string) (make-mal-object 'string string #f)) (define (mal-symbol name) (make-mal-object 'symbol name #f)) (define (mal-keyword name) (make-mal-object 'keyword name #f)) (define (mal-list items) (make-mal-object 'list items #f)) (define (mal-vector items) (make-mal-object 'vector items #f)) (define (mal-map items) (make-mal-object 'map items #f)) (define (mal-atom item) (make-mal-object 'atom item #f)) (define-record-type func (%make-func ast params env fn macro? meta) func? (ast func-ast) (params func-params) (env func-env) (fn func-fn) (macro? func-macro? func-macro?-set!) (meta func-meta func-meta-set!)) (define (make-func ast params env fn) (%make-func ast params env fn #f #f)) (define (mal-instance-of? x type) (and (mal-object? x) (eq? (mal-type x) type))) ) ) ================================================ FILE: impls/scheme/lib/util.sld ================================================ (define-library (lib util) (export call-with-input-string call-with-output-string str prn debug string-intersperse explode char->string list->alist alist->list alist-ref alist-map ->list car-safe cdr-safe contains? last butlast identity readline ;; HACK: cyclone doesn't have those error-object? read-error? error-object-message error-object-irritants) (import (scheme base)) (import (scheme write)) (begin ;; HACK: cyclone currently implements error the SICP way (cond-expand (cyclone (define (error-object? x) (and (pair? x) (string? (car x)))) (define read-error? error-object?) (define error-object-message car) (define error-object-irritants cdr)) (else)) (define (call-with-input-string string proc) (let ((port (open-input-string string))) (dynamic-wind (lambda () #t) (lambda () (proc port)) (lambda () (close-input-port port))))) (define (call-with-output-string proc) (let ((port (open-output-string))) (dynamic-wind (lambda () #t) (lambda () (proc port) (get-output-string port)) (lambda () (close-output-port port))))) (define (str . items) (call-with-output-string (lambda (port) (for-each (lambda (item) (display item port)) items)))) (define (prn . items) (for-each (lambda (item) (write item) (display " ")) items) (newline)) (define (debug . items) (parameterize ((current-output-port (current-error-port))) (apply prn items))) (define (intersperse items sep) (let loop ((items items) (acc '())) (if (null? items) (reverse acc) (let ((tail (cdr items))) (if (null? tail) (loop (cdr items) (cons (car items) acc)) (loop (cdr items) (cons sep (cons (car items) acc)))))))) (define (string-intersperse items sep) (apply string-append (intersperse items sep))) (define (char->string char) (list->string (list char))) (define (explode string) (map char->string (string->list string))) (define (list->alist items) (let loop ((items items) (acc '())) (if (null? items) (reverse acc) (let ((key (car items))) (when (null? (cdr items)) (error "unbalanced list")) (let ((value (cadr items))) (loop (cddr items) (cons (cons key value) acc))))))) (define (alist->list items) (let loop ((items items) (acc '())) (if (null? items) (reverse acc) (let ((kv (car items))) (loop (cdr items) (cons (cdr kv) (cons (car kv) acc))))))) (define (alist-ref key alist . args) (let ((test (if (pair? args) (car args) eqv?)) (default (if (> (length args) 1) (cadr args) #f))) (let loop ((items alist)) (if (pair? items) (let ((item (car items))) (if (test (car item) key) (cdr item) (loop (cdr items)))) default)))) (define (alist-map proc items) (map (lambda (item) (proc (car item) (cdr item))) items)) (define (->list items) (if (vector? items) (vector->list items) items)) (define (car-safe x) (if (pair? x) (car x) '())) (define (cdr-safe x) (if (pair? x) (cdr x) '())) (define (contains? items test) (let loop ((items items)) (if (pair? items) (if (test (car items)) #t (loop (cdr items))) #f))) (define (last items) (when (null? items) (error "empty argument")) (let loop ((items items)) (let ((tail (cdr items))) (if (pair? tail) (loop tail) (car items))))) (define (butlast items) (when (null? items) (error "empty argument")) (let loop ((items items) (acc '())) (let ((tail (cdr items))) (if (pair? tail) (loop tail (cons (car items) acc)) (reverse acc))))) (define (identity x) x) (define (readline prompt) (display prompt) (flush-output-port) (let ((input (read-line))) (if (eof-object? input) #f input))) ) ) ================================================ FILE: impls/scheme/run ================================================ #!/usr/bin/env bash basedir=$(dirname $0) step=${STEP:-stepA_mal} if [[ -e /usr/share/kawa/lib/kawa.jar ]]; then kawa=/usr/share/kawa/lib/kawa.jar elif [[ -e /usr/local/share/kawa/lib/kawa.jar ]]; then kawa=/usr/local/share/kawa/lib/kawa.jar fi if [[ $(which sash 2>/dev/null) ]]; then sagittarius=sash elif [[ $(which sagittarius 2>/dev/null) ]]; then sagittarius=sagittarius fi case ${scheme_MODE:-chibi} in chibi) exec chibi-scheme -I$basedir $basedir/$step.scm "${@}" ;; kawa) exec java -cp $kawa:$basedir/out $step "${@}" ;; gauche) exec gosh -I$basedir $basedir/$step.scm "${@}" ;; chicken) CHICKEN_REPOSITORY=$basedir/eggs exec $basedir/$step "${@}" ;; sagittarius) exec $sagittarius -n -L$basedir $basedir/$step.scm "${@}" ;; cyclone) exec $basedir/$step "${@}" ;; foment) exec foment $basedir/$step.scm "${@}" ;; *) echo "Invalid scheme_MODE: ${scheme_MODE}"; exit 2 ;; esac ================================================ FILE: impls/scheme/step0_repl.scm ================================================ (import (scheme base)) (import (scheme write)) (define (READ input) input) (define (EVAL input) input) (define (PRINT input) input) (define (rep input) (PRINT (EVAL (READ input)))) (define (readline prompt) (display prompt) (flush-output-port) (let ((input (read-line))) (if (eof-object? input) #f input))) (define (main) (let loop () (let ((input (readline "user> "))) (when input (display (rep input)) (newline) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step1_read_print.scm ================================================ (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (define (READ input) (read-str input)) (define (EVAL ast) ast) (define (PRINT ast) (pr-str ast #t)) (define (rep input) (PRINT (EVAL (READ input)))) (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline)))) (display (rep input)) (newline)) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step2_eval.scm ================================================ (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (define (READ input) (read-str input)) (define (EVAL ast env) ; (display (str "EVAL: " (pr-str ast #t) "\n")) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (alist-ref key env) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((op (EVAL (car items) env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (apply op ops))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env `((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) (- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) (* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) (/ . ,(lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))))) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline)))) (display (rep input)) (newline)) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step3_env.scm ================================================ (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (define (READ input) (read-str input)) (define (EVAL ast env) (let ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (case (mal-value (car items)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((let*) (let* ((env* (make-env env)) (binds (mal-value (cadr items))) (binds (if (vector? binds) (vector->list binds) binds)) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) (else (let ((op (EVAL (car items) env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (apply op ops))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) (env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) (env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) (env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline)))) (display (rep input)) (newline)) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step4_if_fn_do.scm ================================================ (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (define (EVAL ast env) (let ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (case (mal-value (car items)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) (EVAL (list-ref items 2) env)))) ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2))) (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (else (let ((op (EVAL (car items) env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (apply op ops))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (rep "(def! not (fn* (a) (if a false true)))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step5_tco.scm ================================================ (import (scheme base)) (import (scheme write)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (define (EVAL ast env) (let ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (case (mal-value (car items)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL (car items) env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops)))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (rep "(def! not (fn* (a) (if a false true)))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (main) ================================================ FILE: impls/scheme/step6_file.scm ================================================ (import (scheme base)) (import (scheme write)) (import (scheme process-context)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (define (EVAL ast env) (let ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL a0 env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops))))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define args (cdr (command-line))) (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (if (null? args) (main) (rep (string-append "(load-file \"" (car args) "\")"))) ================================================ FILE: impls/scheme/step7_quote.scm ================================================ (import (scheme base)) (import (scheme write)) (import (scheme process-context)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (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) (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 ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL a0 env)) (ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops))))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define args (cdr (command-line))) (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (if (null? args) (main) (rep (string-append "(load-file \"" (car args) "\")"))) ================================================ FILE: impls/scheme/step8_macros.scm ================================================ (import (scheme base)) (import (scheme write)) (import (scheme process-context)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (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) (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 ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((defmacro!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (when (func? value) (func-macro?-set! value #t)) (env-set env symbol value) value)) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL a0 env))) (if (and (func? op) (func-macro? op)) (EVAL (apply (func-fn op) (cdr items)) env) ; TCO (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops))))))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define args (cdr (command-line))) (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (if (null? args) (main) (rep (string-append "(load-file \"" (car args) "\")"))) ================================================ FILE: impls/scheme/step9_try.scm ================================================ (import (scheme base)) (import (scheme write)) (import (scheme process-context)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (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) (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 ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((defmacro!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (when (func? value) (func-macro?-set! value #t)) (env-set env symbol value) value)) ((try*) (if (< (length items) 3) (EVAL (cadr items) env) (let ((handle-catch (lambda (value) (let ((handler (mal-value (list-ref items 2))) (env* (make-env env))) (env-set env* (mal-value (cadr handler)) value) (EVAL (list-ref handler 2) env*))))) (guard (ex ((error-object? ex) (handle-catch (mal-string (error-object-message ex)))) ((and (pair? ex) (eq? (car ex) 'user-error)) (handle-catch (cdr ex)))) (EVAL (cadr items) env))))) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL a0 env))) (if (and (func? op) (func-macro? op)) (EVAL (apply (func-fn op) (cdr items)) env) ; TCO (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops))))))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define args (cdr (command-line))) (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (define (main) (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (if (null? args) (main) (rep (string-append "(load-file \"" (car args) "\")"))) ================================================ FILE: impls/scheme/stepA_mal.scm ================================================ (import (scheme base)) (import (scheme write)) (import (scheme process-context)) (import (lib util)) (import (lib reader)) (import (lib printer)) (import (lib types)) (import (lib env)) (import (lib core)) (define (READ input) (read-str input)) (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) (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 ((dbgeval (env-get env 'DEBUG-EVAL))) (when (and (mal-object? dbgeval) (not (memq (mal-type dbgeval) '(false nil)))) (display (str "EVAL: " (pr-str ast #t) "\n")))) (case (and (mal-object? ast) (mal-type ast)) ((symbol) (let ((key (mal-value ast))) (or (env-get env key) (error (str "'" key "' not found"))))) ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) (mal-value ast)))) ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) (mal-value ast)))) ((list) (let ((items (mal-value ast))) (if (null? items) ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (env-set env symbol value) value)) ((defmacro!) (let ((symbol (mal-value (cadr items))) (value (EVAL (list-ref items 2) env))) (when (func? value) (func-macro?-set! value #t)) (env-set env symbol value) value)) ((try*) (if (< (length items) 3) (EVAL (cadr items) env) (let ((handle-catch (lambda (value) (let ((handler (mal-value (list-ref items 2))) (env* (make-env env))) (env-set env* (mal-value (cadr handler)) value) (EVAL (list-ref handler 2) env*))))) (guard (ex ((error-object? ex) (handle-catch (mal-string (error-object-message ex)))) ((and (pair? ex) (eq? (car ex) 'user-error)) (handle-catch (cdr ex)))) (EVAL (cadr items) env))))) ((let*) (let ((env* (make-env env)) (binds (->list (mal-value (cadr items)))) (form (list-ref items 2))) (let loop ((binds binds)) (when (pair? binds) (let ((key (mal-value (car binds)))) (when (null? (cdr binds)) (error "unbalanced list")) (let ((value (EVAL (cadr binds) env*))) (env-set env* key value) (loop (cddr binds)))))) (EVAL form env*))) ; TCO ((do) (let ((forms (cdr items))) (if (null? forms) mal-nil ;; the evaluation order of map is unspecified (let loop ((forms forms)) (let ((form (car forms)) (tail (cdr forms))) (if (null? tail) (EVAL form env) ; TCO (begin (EVAL form env) (loop tail)))))))) ((if) (let* ((condition (EVAL (cadr items) env)) (type (and (mal-object? condition) (mal-type condition)))) (if (memq type '(false nil)) (if (< (length items) 4) mal-nil (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) (binds (map mal-value binds)) (body (list-ref items 2)) (fn (lambda args (let ((env* (make-env env binds args))) (EVAL body env*))))) (make-func body binds env fn))) (else (let ((op (EVAL a0 env))) (if (and (func? op) (func-macro? op)) (EVAL (apply (func-fn op) (cdr items)) env) ; TCO (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO (apply op ops))))))))))) (else ast))) (define (PRINT ast) (pr-str ast #t)) (define repl-env (make-env #f)) (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns) (define (rep input) (PRINT (EVAL (READ input) repl-env))) (define args (cdr (command-line))) (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env))) (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args)))) (let ((scheme (or (get-environment-variable "scheme_MODE") "chibi"))) (env-set repl-env '*host-language* (mal-string (str "scheme (" scheme ")")))) (rep "(def! not (fn* (a) (if a false true)))") (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") (define (main) (rep "(println (str \"Mal [\" *host-language* \"]\"))") (let loop () (let ((input (readline "user> "))) (when input (guard (ex ((error-object? ex) (when (not (memv 'empty-input (error-object-irritants ex))) (display "[error] ") (display (error-object-message ex)) (newline))) ((and (pair? ex) (eq? (car ex) 'user-error)) (display "[error] ") (display (pr-str (cdr ex) #t)) (newline))) (display (rep input)) (newline)) (loop)))) (newline)) (if (null? args) (main) (rep (string-append "(load-file \"" (car args) "\")"))) ================================================ FILE: impls/scheme/tests/stepA_mal.mal ================================================ ;; Testing basic Scheme interop (scm-eval "(+ 1 1)") ;=>2 (scm-eval "(begin (display \"Hello World!\") (newline) 7)") ;/Hello World! ;=>7 (scm-eval "(string->list \"MAL\")") ;=>("M" "A" "L") (scm-eval "(map + '(1 2 3) '(4 5 6))") ;=>(5 7 9) (scm-eval "(string-map (lambda (c) (integer->char (+ 65 (modulo (+ (- (char->integer c) 65) 13) 26)))) \"ZNY\")") ;=>"MAL" ================================================ FILE: impls/skew/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install npm ENV NPM_CONFIG_CACHE /mal/.npm # Skew RUN DEBIAN_FRONTEND=noninteractive npm install -g skew ================================================ FILE: impls/skew/Makefile ================================================ STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ step5_tco step6_file step7_quote step8_macros step9_try stepA_mal SOURCES_BASE = util.sk types.sk reader.sk printer.sk STEP3_DEPS = $(SOURCES_BASE) env.sk STEP4_DEPS = $(STEP3_DEPS) core.sk all: $(foreach s,$(STEPS),$(s).js) dist dist: mal step0_repl.js step1_read_print.js step2_eval.js step3_env.js: $(STEP3_DEPS) step4_if_fn_do.js step5_tco.js step6_file.js step7_quote.js step8_macros.js step9_try.js stepA_mal.js: $(STEP4_DEPS) %.js: %.sk skewc --target=js --release --output-file=$@ $^ mal: stepA_mal.js echo "#!/usr/bin/env node" > $@ cat $< >> $@ chmod +x $@ clean: rm -rf step*.js mal .PHONY: all dist clean ================================================ FILE: impls/skew/core.sk ================================================ def _printLn(s string) MalVal { printLn(s) return gNil } const ns StringMap) MalVal> = { "eval": (a List) => EVAL(a[0], repl_env), "=": (a List) => MalVal.fromBool(a[0].equal(a[1])), "throw": (a List) => { throw MalUserError.new(a[0]) }, "nil?": (a List) => MalVal.fromBool(a[0] is MalNil), "true?": (a List) => MalVal.fromBool(a[0] is MalTrue), "false?": (a List) => MalVal.fromBool(a[0] is MalFalse), "string?": (a List) => MalVal.fromBool(a[0] is MalString), "symbol": (a List) => MalSymbol.new((a[0] as MalString).val), "symbol?": (a List) => MalVal.fromBool(a[0] is MalSymbol), "keyword": (a List) => a[0] is MalKeyword ? a[0] : MalKeyword.new((a[0] as MalString).val), "keyword?": (a List) => MalVal.fromBool(a[0] is MalKeyword), "number?": (a List) => MalVal.fromBool(a[0] is MalNumber), "fn?": (a List) => MalVal.fromBool(a[0] is MalNativeFunc || (a[0] is MalFunc && !(a[0] as MalFunc).isMacro)), "macro?": (a List) => MalVal.fromBool(a[0] is MalFunc && (a[0] as MalFunc).isMacro), "pr-str": (a List) => MalString.new(" ".join(a.map(e => pr_str(e, true)))), "str": (a List) => MalString.new("".join(a.map(e => pr_str(e, false)))), "prn": (a List) => _printLn(" ".join(a.map(e => pr_str(e, true)))), "println": (a List) => _printLn(" ".join(a.map(e => pr_str(e, false)))), "read-string": (a List) => read_str((a[0] as MalString).val), "readline": (a List) => { const line = readLine((a[0] as MalString).val) return line == null ? gNil : MalString.new(line) }, "slurp": (a List) => MalString.new(readFile((a[0] as MalString).val)), "<": (a List) => MalVal.fromBool((a[0] as MalNumber).val < (a[1] as MalNumber).val), "<=": (a List) => MalVal.fromBool((a[0] as MalNumber).val <= (a[1] as MalNumber).val), ">": (a List) => MalVal.fromBool((a[0] as MalNumber).val > (a[1] as MalNumber).val), ">=": (a List) => MalVal.fromBool((a[0] as MalNumber).val >= (a[1] as MalNumber).val), "+": (a List) => MalNumber.new((a[0] as MalNumber).val + (a[1] as MalNumber).val), "-": (a List) => MalNumber.new((a[0] as MalNumber).val - (a[1] as MalNumber).val), "*": (a List) => MalNumber.new((a[0] as MalNumber).val * (a[1] as MalNumber).val), "/": (a List) => MalNumber.new((a[0] as MalNumber).val / (a[1] as MalNumber).val), "time-ms": (a List) => MalNumber.new(timeMs), "list": (a List) => MalList.new(a), "list?": (a List) => MalVal.fromBool(a[0] is MalList), "vector": (a List) => MalVector.new(a), "vector?": (a List) => MalVal.fromBool(a[0] is MalVector), "hash-map": (a List) => MalHashMap.fromList(a), "map?": (a List) => MalVal.fromBool(a[0] is MalHashMap), "assoc": (a List) => (a[0] as MalHashMap).assoc(a.slice(1)), "dissoc": (a List) => (a[0] as MalHashMap).dissoc(a.slice(1)), "get": (a List) => a[0] is MalNil ? gNil : (a[0] as MalHashMap).get(a[1]), "contains?": (a List) => MalVal.fromBool((a[0] as MalHashMap).contains(a[1])), "keys": (a List) => MalList.new((a[0] as MalHashMap).keys), "vals": (a List) => MalList.new((a[0] as MalHashMap).vals), "sequential?": (a List) => MalVal.fromBool(a[0] is MalSequential), "cons": (a List) => { var list List = (a[1] as MalSequential).val.clone list.prepend(a[0]) return MalList.new(list) }, "concat": (a List) => { var list List = [] 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, "empty?": (a List) => MalVal.fromBool((a[0] as MalSequential).count == 0), "count": (a List) => a[0] is MalNil ? MalNumber.new(0) : MalNumber.new((a[0] as MalSequential).count), "apply": (a List) => { const f = a[0] as MalCallable var args = a.slice(1, a.count - 1) args.append((a[a.count - 1] as MalSequential).val) return f.call(args) }, "map": (a List) => { const f = a[0] as MalCallable return MalList.new((a[1] as MalSequential).val.map(e => f.call([e]))) }, "conj": (a List) => (a[0] as MalSequential).conj(a.slice(1)), "seq": (a List) => a[0].seq, "meta": (a List) => a[0].meta, "with-meta": (a List) => a[0].withMeta(a[1]), "atom": (a List) => MalAtom.new(a[0]), "atom?": (a List) => MalVal.fromBool(a[0] is MalAtom), "deref": (a List) => (a[0] as MalAtom).val, "reset!": (a List) => (a[0] as MalAtom).resetBang(a[1]), "swap!": (a List) => { var atom = a[0] as MalAtom const oldVal = atom.val var callArgs = a.slice(2) callArgs.prepend(oldVal) const newVal = (a[1] as MalCallable).call(callArgs) return atom.resetBang(newVal) }, } ================================================ FILE: impls/skew/env.sk ================================================ class Env { const _outer Env var _data StringMap = {} def new(outer Env) { _outer = outer } def new(outer Env, binds List, exprs List) { _outer = outer for i in 0..binds.count { const name = (binds[i] as MalSymbol).val if name == "&" { const restName = (binds[i + 1] as MalSymbol).val _data[restName] = MalList.new(exprs.slice(i)) break } else { _data[name] = exprs[i] } } } def get(key string) MalVal { if key in _data { return _data[key] } return _outer?.get(key) } def set(key MalSymbol, value MalVal) MalVal { _data[key.val] = value return value } } ================================================ FILE: impls/skew/printer.sk ================================================ def pr_str(obj MalVal, readable bool) string { return obj.print(readable) } ================================================ FILE: impls/skew/reader.sk ================================================ class Reader { const tokens List var position = 0 def peek string { if position >= tokens.count { return null } return tokens[position] } def next string { const token = peek position++ return token } } def tokenize(str string) List { var re = RegExp.new("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)", "g") var tokens List = [] var match string while (match = re.exec(str)[1]) != "" { if match[0] == ';' { continue } tokens.append(match) } return tokens } def unescape(s string) string { return s.replaceAll("\\\\", "\x01").replaceAll("\\\"", "\"").replaceAll("\\n", "\n").replaceAll("\x01", "\\") } def read_atom(rdr Reader) MalVal { var sre = RegExp.new("^\"(?:\\\\.|[^\\\\\"])*\"$") const token = rdr.peek if token == "nil" { rdr.next return gNil } if token == "true" { rdr.next return gTrue } if token == "false" { rdr.next return gFalse } switch token[0] { case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' { return MalNumber.new(stringToInt(rdr.next)) } case '-' { if token.count <= 1 { return MalSymbol.new(rdr.next) } switch token[1] { case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' { return MalNumber.new(stringToInt(rdr.next)) } default { return MalSymbol.new(rdr.next) } } } case '"' { const s = rdr.next if sre.exec(s) { return MalString.new(unescape(s.slice(1, s.count - 1))) } else { throw MalError.new("expected '\"', got EOF") } } case ':' { return MalKeyword.new(rdr.next.slice(1)) } default { return MalSymbol.new(rdr.next) } } } def read_sequence(rdr Reader, open string, close string) List { if rdr.next != open { throw MalError.new("expected '" + open + "'") } var token string var items List = [] while (token = rdr.peek) != close { if token == null { throw MalError.new("expected '" + close + "', got EOF") } items.append(read_form(rdr)) } rdr.next # consume the close paren/bracket/brace return items } def read_list(rdr Reader) MalList { return MalList.new(read_sequence(rdr, "(", ")")) } def read_vector(rdr Reader) MalVector { return MalVector.new(read_sequence(rdr, "[", "]")) } def read_hash_map(rdr Reader) MalHashMap { return MalHashMap.fromList(read_sequence(rdr, "{", "}")) } def reader_macro(rdr Reader, symbol_name string) MalVal { rdr.next return MalList.new([MalSymbol.new(symbol_name), read_form(rdr)]) } def read_form(rdr Reader) MalVal { switch rdr.peek[0] { case '\'' { return reader_macro(rdr, "quote") } case '`' { return reader_macro(rdr, "quasiquote") } case '~' { if rdr.peek == "~" { return reader_macro(rdr, "unquote") } else if rdr.peek == "~@" { return reader_macro(rdr, "splice-unquote") } else { return read_atom(rdr) } } case '^' { rdr.next const meta = read_form(rdr) return MalList.new([MalSymbol.new("with-meta"), read_form(rdr), meta]) } case '@' { return reader_macro(rdr, "deref") } case ')' { throw MalError.new("unexpected ')'") } case '(' { return read_list(rdr) } case ']' { throw MalError.new("unexpected ']'") } case '[' { return read_vector(rdr) } case '}' { throw MalError.new("unexpected '}'") } case '{' { return read_hash_map(rdr) } default { return read_atom(rdr) } } } def read_str(str string) MalVal { const tokens = tokenize(str) if tokens.isEmpty { return null } var rdr = Reader.new(tokens) return read_form(rdr) } @import { const RegExp dynamic } ================================================ FILE: impls/skew/run ================================================ #!/usr/bin/env bash exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ================================================ FILE: impls/skew/step0_repl.sk ================================================ def READ(str string) string { return str } def EVAL(ast string, env StringMap) string { return ast } def PRINT(exp string) string { return exp } def REP(str string) string { return PRINT(EVAL(READ(str), {})) } @entry def main { var line string while (line = readLine("user> ")) != null { if line == "" { continue } printLn(REP(line)) } } ================================================ FILE: impls/skew/step1_read_print.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env StringMap) MalVal { return ast } def PRINT(exp MalVal) string { return exp?.print(true) } def REP(str string) string { return PRINT(EVAL(READ(str), {})) } @entry def main { var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step2_eval.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env StringMap) MalVal { # printLn("EVAL: " + PRINT(ast)) if ast is MalSymbol { const name = (ast as MalSymbol).val if !(name in env) { throw MalError.new("'" + name + "' not found") } return env[name] } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } var astList = ast as MalList if astList.isEmpty { return ast } const evaledList = astList.val.map(e => EVAL(e, env)) var fn = evaledList[0] as MalNativeFunc return fn.call(evaledList.slice(1)) } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env StringMap = { "+": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val + (args[1] as MalNumber).val)), "-": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val - (args[1] as MalNumber).val)), "*": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val * (args[1] as MalNumber).val)), "/": MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val / (args[1] as MalNumber).val)), } def REP(str string) string { return PRINT(EVAL(READ(str), repl_env)) } @entry def main { var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step3_env.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env Env) MalVal { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } return EVAL(astList[2], letenv) } else { const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] as MalNativeFunc return fn.call(evaledList.slice(1)) } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def REP(str string) string { return PRINT(EVAL(READ(str), repl_env)) } @entry def main { repl_env.set(MalSymbol.new("+"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val + (args[1] as MalNumber).val))) repl_env.set(MalSymbol.new("-"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val - (args[1] as MalNumber).val))) repl_env.set(MalSymbol.new("*"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val * (args[1] as MalNumber).val))) repl_env.set(MalSymbol.new("/"), MalNativeFunc.new((args List) MalVal => MalNumber.new((args[0] as MalNumber).val / (args[1] as MalNumber).val))) var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step4_if_fn_do.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env Env) MalVal { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } return EVAL(astList[2], letenv) } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } return EVAL(astList[astList.count - 1], env) } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { return astList.count > 3 ? EVAL(astList[3], env) : gNil } else { return EVAL(astList[2], env) } } else if a0sym.val == "fn*" { const argsNames = (astList[1] as MalSequential).val return MalNativeFunc.new((args List) => EVAL(astList[2], Env.new(env, argsNames, args))) } else { const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] as MalNativeFunc return fn.call(evaledList.slice(1)) } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step5_tco.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step6_file.sk ================================================ def READ(str string) MalVal { return read_str(str) } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if argv.count > 0 { RE("(load-file \"" + argv[0] + "\")") return } var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step7_quote.sk ================================================ def READ(str string) MalVal { return read_str(str) } 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 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) } } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "quote" { return astList[1] } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const evaledList = astList.val.map(e => EVAL(e, env)) const fn = evaledList[0] const callArgs = evaledList.slice(1) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if argv.count > 0 { RE("(load-file \"" + argv[0] + "\")") return } var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step8_macros.sk ================================================ def READ(str string) MalVal { return read_str(str) } 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 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) } } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "quote" { return astList[1] } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO } else if a0sym.val == "defmacro!" { var fn = EVAL(astList[2], env) as MalFunc var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) macro.setAsMacro return env.set(astList[1] as MalSymbol, macro) } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const fn = EVAL(astList[0], env) const args = astList.val.slice(1) if fn is MalFunc && (fn as MalFunc).isMacro { ast = (fn as MalFunc).call(args) continue # TCO } const callArgs = args.map(e => EVAL(e, env)) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if argv.count > 0 { RE("(load-file \"" + argv[0] + "\")") return } var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/step9_try.sk ================================================ def READ(str string) MalVal { return read_str(str) } 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 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) } } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "quote" { return astList[1] } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO } else if a0sym.val == "defmacro!" { var fn = EVAL(astList[2], env) as MalFunc var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) macro.setAsMacro return env.set(astList[1] as MalSymbol, macro) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) } var exc MalVal try { return EVAL(astList[1], env) } catch e MalUserError { exc = e.data } catch e MalError { exc = MalString.new(e.message) } catch e Error { exc = MalString.new(e.message) } const catchClause = astList[2] as MalList var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const fn = EVAL(astList[0], env) const args = astList.val.slice(1) if fn is MalFunc && (fn as MalFunc).isMacro { ast = (fn as MalFunc).call(args) continue # TCO } const callArgs = args.map(e => EVAL(e, env)) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) # core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if argv.count > 0 { RE("(load-file \"" + argv[0] + "\")") return } var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalUserError { printLn("Error: \(e.data.print(false))") } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/stepA_mal.sk ================================================ def READ(str string) MalVal { return read_str(str) } 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 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) } } def EVAL(ast MalVal, env Env) MalVal { while true { const dbgeval = env.get("DEBUG-EVAL") if dbgeval != null && !(dbgeval is MalNil) && !(dbgeval is MalFalse) { printLn("EVAL: " + PRINT(ast)) } if ast is MalSymbol { const key = (ast as MalSymbol).val const val = env.get(key) if val == null { throw MalError.new("'" + key + "' not found") } return val } else if ast is MalList { # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { var result List = [] (ast as MalHashMap).val.each((k string, v MalVal) => { result.append(MalVal.fromHashKey(k)) result.append(EVAL(v, env)) }) return MalHashMap.fromList(result) } else { return ast } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol if a0sym.val == "def!" { return env.set(astList[1] as MalSymbol, EVAL(astList[2], env)) } else if a0sym.val == "let*" { var letenv = Env.new(env) const assigns = astList[1] as MalSequential for i = 0; i < assigns.count; i += 2 { letenv.set(assigns[i] as MalSymbol, EVAL(assigns[i + 1], letenv)) } ast = astList[2] env = letenv continue # TCO } else if a0sym.val == "quote" { return astList[1] } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO } else if a0sym.val == "defmacro!" { var fn = EVAL(astList[2], env) as MalFunc var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) macro.setAsMacro return env.set(astList[1] as MalSymbol, macro) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) } var exc MalVal try { return EVAL(astList[1], env) } catch e MalUserError { exc = e.data } catch e MalError { exc = MalString.new(e.message) } catch e Error { exc = MalString.new(e.message) } const catchClause = astList[2] as MalList var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { for i = 1; i < astList.count - 1; i += 1 { EVAL(astList[i], env) } ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) if condRes is MalNil || condRes is MalFalse { ast = astList.count > 3 ? astList[3] : gNil } else { ast = astList[2] } continue # TCO } else if a0sym.val == "fn*" { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { const fn = EVAL(astList[0], env) const args = astList.val.slice(1) if fn is MalFunc && (fn as MalFunc).isMacro { ast = (fn as MalFunc).call(args) continue # TCO } const callArgs = args.map(e => EVAL(e, env)) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { const f = fn as MalFunc ast = f.ast env = Env.new(f.env, f.params.val, callArgs) continue # TCO } else { throw MalError.new("Expected function as head of list") } } } } def PRINT(exp MalVal) string { return exp?.print(true) } var repl_env = Env.new(null) def RE(str string) MalVal { return EVAL(READ(str), repl_env) } def REP(str string) string { return PRINT(RE(str)) } @entry def main { # core.sk: defined using Skew ns.each((name, func) => repl_env.set(MalSymbol.new(name), MalNativeFunc.new(func))) repl_env.set(MalSymbol.new("*ARGV*"), MalList.new(argv.isEmpty ? [] : argv.slice(1).map(e => MalString.new(e)))) # core.mal: defined using the language itself RE("(def! *host-language* \"skew\")") RE("(def! not (fn* (a) (if a false true)))") RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if argv.count > 0 { RE("(load-file \"" + argv[0] + "\")") return } RE("(println (str \"Mal [\" *host-language* \"]\"))") var line string while (line = readLine("user> ")) != null { if line == "" { continue } try { printLn(REP(line)) } catch e MalUserError { printLn("Error: \(e.data.print(false))") } catch e MalError { printLn("Error: \(e.message)") } catch e Error { printLn("Error: \(e.message)") } } } ================================================ FILE: impls/skew/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/skew/types.sk ================================================ class MalError { const message string } class MalUserError { const data MalVal } class MalVal { var _meta MalVal = gNil def toHashKey string { throw MalError.new("Not allowed as hash map key") } def print(readable bool) string def equal(o MalVal) bool def isSymbol(name string) bool { return false } def seq MalVal { throw MalError.new("seq: called on non-sequence") } def meta MalVal { return _meta } def _setMeta(newMeta MalVal) { _meta = newMeta } def withMeta(newMeta MalVal) MalVal { var res = self.clone res._setMeta(newMeta) return res } def clone MalVal } namespace MalVal { def fromHashKey(key string) MalVal { if key.startsWith("S_") { return MalString.new(key.slice(2)) } else if key.startsWith("K_") { return MalKeyword.new(key.slice(2)) } else { throw "Illegal hash key string" } } def fromBool(b bool) MalVal { return b ? gTrue : gFalse } } class MalNil : MalVal { over print(readable bool) string { return "nil" } over equal(o MalVal) bool { return o is MalNil } over seq MalVal { return gNil } over clone MalVal { return self } } const gNil = MalNil.new class MalTrue : MalVal { over print(readable bool) string { return "true" } over equal(o MalVal) bool { return o is MalTrue } over clone MalVal { return self } } const gTrue = MalTrue.new class MalFalse : MalVal { over print(readable bool) string { return "false" } over equal(o MalVal) bool { return o is MalFalse } over clone MalVal { return self } } const gFalse = MalFalse.new class MalNumber : MalVal { const _data int over print(readable bool) string { return _data.toString } def val int { return _data } over equal(o MalVal) bool { return o is MalNumber && (o as MalNumber).val == val } over clone MalVal { return self } } class MalSymbol : MalVal { const _data string over print(readable bool) string { return _data } def val string { return _data } over equal(o MalVal) bool { return o is MalSymbol && (o as MalSymbol).val == val } over isSymbol(name string) bool { return _data == name } over clone MalVal { return MalSymbol.new(_data) } } class MalString : MalVal { const _data string over print(readable bool) string { return readable ? "\"\(escaped_data)\"" : _data } over toHashKey string { return "S_\(_data)" } def val string { return _data } over equal(o MalVal) bool { return o is MalString && (o as MalString).val == val } def escaped_data string { return _data.replaceAll("\\", "\\\\").replaceAll("\"", "\\\"").replaceAll("\n", "\\n") } over seq MalVal { return _data.count == 0 ? gNil : MalList.new(_data.split("").map(e => MalString.new(e))) } over clone MalVal { return MalString.new(_data) } } class MalKeyword : MalVal { const _data string over print(readable bool) string { return ":\(_data)" } over toHashKey string { return "K_\(_data)" } def val string { return _data } over equal(o MalVal) bool { return o is MalKeyword && (o as MalKeyword).val == val } over clone MalVal { return MalKeyword.new(_data) } } class MalSequential : MalVal { const _data List def val List { return _data } def isEmpty bool { return _data.isEmpty } def asOneString(readable bool) string { return " ".join(_data.map(v => v.print(readable))) } def count int { return _data.count } def [](index int) MalVal { return _data[index] } over equal(o MalVal) bool { if !(o is MalSequential) { return false } const oval = (o as MalSequential).val if val.count != oval.count { return false } for i in 0..val.count { if !val[i].equal(oval[i]) { return false } } return true } def nth(position int) MalVal { if position >= count { throw MalError.new("nth: index out of range") } return val[position] } def first MalVal { if isEmpty { return gNil } return val[0] } def rest MalVal { if isEmpty { return MalList.new([]) } return MalList.new(val.slice(1)) } def conj(args List) MalVal } class MalList : MalSequential { over print(readable bool) string { return "(" + asOneString(readable) + ")" } over seq MalVal { return isEmpty ? gNil : self } over conj(args List) MalVal { var res = args.clone res.reverse res.append(_data) return MalList.new(res) } over clone MalVal { return MalList.new(_data) } } class MalVector : MalSequential { over print(readable bool) string { return "[" + asOneString(readable) + "]" } over seq MalVal { return isEmpty ? gNil : MalList.new(_data) } over conj(args List) MalVal { var res = _data.clone res.append(args) return MalVector.new(res) } over clone MalVal { return MalVector.new(_data) } } class MalHashMap : MalVal { const _data StringMap over print(readable bool) string { var pairs List = [] _data.each((k string, v MalVal) => pairs.append("\(MalVal.fromHashKey(k).print(readable)) \(v.print(readable))")) return "{" + " ".join(pairs) + "}" } def val StringMap { return _data } over equal(o MalVal) bool { if !(o is MalHashMap) { return false } const oh = o as MalHashMap if oh.val.count != val.count { return false } var allEqual = true _data.each((k string, v MalVal) => { if !(k in oh.val) || !(v.equal(oh.val[k])) { allEqual = false } }) return allEqual } def assoc(kv_list List) MalVal { var new_data = _data.clone for i = 0; i < kv_list.count; i += 2 { new_data[kv_list[i].toHashKey] = kv_list[i + 1] } return MalHashMap.new(new_data) } def dissoc(keys List) MalVal { var new_data = _data.clone for key in keys { new_data.remove(key.toHashKey) } return MalHashMap.new(new_data) } def get(key MalVal) MalVal { return _data.get(key.toHashKey, gNil) } def contains(key MalVal) bool { return key.toHashKey in _data } def keys List { return _data.keys.map(k => MalVal.fromHashKey(k)) } def vals List { return _data.values } over clone MalVal { return MalHashMap.new(_data) } } namespace MalHashMap { def fromList(kv_list List) MalHashMap { var result StringMap = {} for i = 0; i < kv_list.count; i += 2 { result[kv_list[i].toHashKey] = kv_list[i + 1] } return MalHashMap.new(result) } } class MalCallable : MalVal { const func fn(List) MalVal def call(args List) MalVal { return func(args) } } class MalNativeFunc : MalCallable { over print(readable bool) string { return "#" } over equal(o MalVal) bool { return false } over clone MalVal { return MalNativeFunc.new(func) } } class MalFunc : MalCallable { const ast MalVal const params MalSequential const env Env var _macro bool = false def new(aAst MalVal, aParams MalSequential, aEnv Env, aFunc fn(List) MalVal) { super(aFunc) ast = aAst params = aParams env = aEnv } def isMacro bool { return _macro } def setAsMacro { _macro = true } over print(readable bool) string { return "#" } over equal(o MalVal) bool { return false } over clone MalVal { var f = MalFunc.new(ast, params, env, func) if isMacro { f.setAsMacro } return f } } class MalAtom : MalVal { var _data MalVal over print(readable bool) string { return "(atom \(_data.print(readable)))" } def val MalVal { return _data } over equal(o MalVal) bool { return o is MalAtom && val.equal((o as MalAtom).val) } def resetBang(newData MalVal) MalVal { _data = newData return _data } over clone MalVal { return MalAtom.new(_data) } } ================================================ FILE: impls/skew/util.sk ================================================ def argv List { return process.argv.slice(2) } def timeMs int { return Date.new.getTime() } var fs = require("fs") def readFile(filename string) string { return fs.readFileSync(filename, "utf-8") } def writeString(s string) { fs.writeSync(1, s) } def printLn(s string) { writeString(s) writeString("\n") } def readLine(prompt string) string { writeString(prompt) var buffer = Buffer.new(1024) # in newer Node this should be Buffer.alloc var stdin = fs.openSync("/dev/stdin", "rs") var bytesread int var anycharseen = false var total = 0 while (bytesread = fs.readSync(stdin, buffer, total, 1)) > 0 { anycharseen = true var lastchar = buffer.slice(total, total + bytesread).toString() if lastchar == "\n" { break } total += bytesread } fs.closeSync(stdin) return anycharseen ? buffer.slice(0, total).toString() : null } def stringToInt(str string) int { return parseInt(str) } @import { const process dynamic const Buffer dynamic const Date dynamic const Error dynamic def parseInt(str string) int def require(name string) dynamic } ================================================ FILE: impls/sml/.gitignore ================================================ .smlmode .step* *.ui *.uo ================================================ FILE: impls/sml/Dockerfile ================================================ # We need focal for the Moscow ML PPA FROM ubuntu:focal ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update RUN apt-get -y install make python3 RUN ln -s /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install software-properties-common RUN apt-get -y install polyml libpolyml-dev RUN apt-get -y install mlton RUN add-apt-repository -y ppa:kflarsen/mosml RUN apt-get -y install mosml ================================================ FILE: impls/sml/LargeInt.sml ================================================ (* Moscow ML does not have the LargeInt structure, * but its Int is 64 bit on 64 bit systems. * We need 64 bit integers for the `time-ms` core function. *) structure LargeInt = Int ================================================ FILE: impls/sml/Makefile ================================================ STEP_BINS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step6_file step7_quote step8_macros step9_try stepA_mal sml_MODE_DEFAULT = polyml sml_MODE_CONFIG = .smlmode ifeq ($(sml_MODE),) sml_MODE = $(sml_MODE_DEFAULT) endif # some hackery to let Make know if it needs to rebuild when sml_MODE changes ifneq ($(sml_MODE),$(shell cat $(sml_MODE_CONFIG) 2> /dev/null)) $(shell rm $(sml_MODE_CONFIG) 2> /dev/null) endif ifeq ($(sml_MODE),mlton) SMLC = mlton SMLCOUTFLAG = -output BUILD_FILE = %.mlb build_args = $1 endif ifeq ($(sml_MODE),mosml) SMLC = mosmlc SMLCOUTFLAG = -o BUILD_FILE = %.mlb build_args = LargeInt.sml -toplevel $(shell grep "\\.sml" $1) endif ifeq ($(sml_MODE),polyml) SMLC = polyc SMLCOUTFLAG = -o BUILD_FILE = .%.poly.sml build_args = $1 endif all: $(STEP_BINS) dist: mal mal: stepA_mal cp $< $@ .%.dep: %.mlb @echo sml-deps -o $@ $< $(eval DEPS := $(shell grep "\\.sml" $<)) @echo "$(@:.%.dep=%) $@: $(DEPS)" > $@ include $(STEP_BINS:%=.%.dep) .%.poly.sml: %.mlb @echo generate-sml -o $@ $< @grep "\\.sml" $< | grep -v main | xargs printf "use \"%s\";\n" > $@ # some hackery to let Make track changes in sml_MODE $(sml_MODE_CONFIG): @echo $(sml_MODE) > $@ $(STEP_BINS): %: $(BUILD_FILE) $(sml_MODE_CONFIG) $(SMLC) $(SMLCOUTFLAG) $@ $(call build_args,$<) clean: rm -f $(STEP_BINS) .*.dep *.ui *.uo .*.poly.sml $(sml_MODE_CONFIG) .PHONY: all clean ================================================ FILE: impls/sml/README.md ================================================ # SML-MAL This is Make-A-Lisp in Standard ML. ## Building Just run `make`. Building requires a Standard ML compiler with basis library. This MAL implementation has been tested and works with Poly/ML, MLton, and Moscow ML. On Ubuntu, you can run `apt-get install polyml libpolyml-dev`. By setting `sml_MODE` to `polyml`, `mosml`, or `mlton` on invoking `make` you can select which compiler to use. The Makefile has some hacks to figure out how to make the different compilers build everything. ## Running You can build a `mal` binary from the final step with `make dist`: ``` $ make dist $ ./mal Mal [sml] user> (map (fn* (x) (println "Odelay!")) [1 2 3 4 5]) Odelay! Odelay! Odelay! Odelay! Odelay! (nil nil nil nil nil) user> ``` ================================================ FILE: impls/sml/core.sml ================================================ exception NotDefined of string exception NotApplicable of string exception OutOfBounds of string exception MalException of mal_type (* * Some helper functions *) fun buildMap (k::v::rest) acc = buildMap rest (malAssoc acc k v) | buildMap [] acc = malMap (rev acc) | buildMap _ _ = raise NotApplicable "maps can only be constructed from an even number of arguments" fun collectLists ls = collectLists' ls [] and collectLists' (LIST (l,_)::rest) acc = collectLists' rest (l::acc) | collectLists' (VECTOR (v,_)::rest) acc = collectLists' rest (v::acc) | collectLists' [] acc = rev acc | collectLists' _ _ = raise NotApplicable "invalid arguments" fun arithFolder n f (INT next, INT prev) = INT (f (prev, next)) | arithFolder n _ _ = raise NotApplicable ("'" ^ n ^ "' requires integer arguments") fun cmpFolder n c (INT next, (INT prev, acc)) = (INT next, acc andalso (c (prev, next))) | cmpFolder n _ _ = raise NotApplicable ("'" ^ n ^ "' requires integer arguments") fun cmpFold n c (x::xs) = foldl (cmpFolder n c) (x, true) xs |> #2 |> BOOL | cmpFold n _ _ = raise NotApplicable ("'" ^ n ^ "' requires arguments") fun splatArgs [LIST (l,_)] = l | splatArgs [VECTOR (v,_)] = v | splatArgs (x::xs) = x::(splatArgs xs) | splatArgs [] = [] fun slurp lines strm = case TextIO.inputLine strm of SOME l => slurp (l::lines) strm | NONE => (TextIO.closeIn strm; rev lines) fun malPrint s = ( TextIO.print (s ^ "\n"); NIL ) fun readLine prompt = ( TextIO.print prompt; TextIO.inputLine TextIO.stdIn |> Option.map (trimr 1) ) fun strJoin separator strings = String.concatWith separator strings (* * Core primitives *) fun prim name f = let val badArgs = STRING ("incorrect arguments passed to '" ^ name ^ "'") in [SYMBOL name, FN (fn args => f args handle Domain => raise MalException badArgs, NO_META)] end val coreNs = List.concat [ (* Maths *) prim "+" (fn args => foldl (arithFolder "+" (op +)) (INT 0) args), prim "*" (fn args => foldl (arithFolder "*" (op * )) (INT 1) args), prim "/" (fn (x::xs) => foldl (arithFolder "/" (op div)) x xs | _ => raise Domain), prim "-" (fn (x::xs) => foldl (arithFolder "-" (op -)) x xs | _ => raise Domain), (* Comparisons *) prim "<" (cmpFold "<" (op <)), prim "<=" (cmpFold "<=" (op <=)), prim ">=" (cmpFold ">=" (op >=)), prim ">" (cmpFold ">" (op >)), prim "=" (fn (x::xs) => foldl (fn (n,(p,acc)) => (n,acc andalso (malEq (n, p)))) (x, true) xs |> #2 |> BOOL | _ => raise Domain), (* Predicates *) prim "nil?" (fn [NIL] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "true?" (fn [BOOL true] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "false?" (fn [BOOL false] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "symbol?" (fn [SYMBOL _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "keyword?" (fn [KEYWORD _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "vector?" (fn [VECTOR _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "map?" (fn [MAP _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "fn?" (fn [FN _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "macro?" (fn [MACRO _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "string?" (fn [STRING _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "number?" (fn [INT _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "atom?" (fn [ATOM _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "list?" (fn [LIST _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "sequential?" (fn [LIST _] => BOOL true | [VECTOR _] => BOOL true | [_] => BOOL false | _ => raise Domain), prim "empty?" (fn [LIST (l,_)] => BOOL (length l = 0) | [VECTOR (v,_)] => BOOL (length v = 0) | _ => raise Domain), prim "contains?" (fn [MAP (m,_), k] => BOOL (List.exists (fn (k', _) => malEq (k, k')) m) | _ => raise Domain), (* I/O *) prim "slurp" (fn [STRING filename] => TextIO.openIn filename |> slurp [] |> strJoin "" |> STRING | _ => raise Domain), prim "prn" (fn args => args |> map prReadableStr |> strJoin " " |> malPrint), prim "println" (fn args => args |> map prStr |> strJoin " " |> malPrint), prim "readline" (fn [STRING prompt] => valOrElse (readLine prompt |> Option.map STRING) (fn () => NIL) | _ => raise Domain), (* Strings and stringoids *) prim "str" (fn args => args |> map prStr |> strJoin "" |> STRING), prim "pr-str" (fn args => args |> map prReadableStr |> strJoin " " |> STRING), prim "symbol" (fn [STRING s] => SYMBOL s | _ => raise Domain), prim "keyword" (fn [STRING s] => KEYWORD s | [kw as KEYWORD _] => kw | _ => raise Domain), (* Atoms *) prim "atom" (fn [x] => ATOM (ref x) | _ => raise Domain), prim "deref" (fn [ATOM a] => !a | _ => raise Domain), prim "reset!" (fn [ATOM a, x] => (a := x; x) | _ => raise Domain), prim "swap!" (fn (ATOM a::(FN (f,_))::args) => let val x = f ((!a)::args) in (a := x; x) end | _ => raise Domain), (* Listoids *) prim "list" (fn args => malList args), prim "vector" (fn args => malVector (args)), prim "vec" (fn [LIST (xs,_)] => malVector (xs) | [v as VECTOR _] => v | _ => raise Domain), prim "concat" (fn args => malList (List.concat (collectLists args))), prim "cons" (fn [hd, LIST (tl,_)] => malList (hd::tl) | [hd, VECTOR (tl,_)] => malList (hd::tl) | _ => raise Domain), prim "conj" (fn (LIST (l,_)::args) => malList (rev args @ l) | (VECTOR (v,_)::args) => malVector (v @ args) | _ => raise Domain), prim "seq" (fn [LIST ([],_)] => NIL | [l as LIST _] => l | [VECTOR ([],_)] => NIL | [VECTOR (v,_)] => malList v | [STRING ""] => NIL | [STRING s] => String.explode s |> List.map (STRING o String.str) |> malList | [NIL] => NIL | _ => raise Domain), prim "count" (fn [LIST (l,_)] => INT (length l |> LargeInt.fromInt) | [VECTOR (v,_)] => INT (length v |> LargeInt.fromInt) | [NIL] => INT 0 | _ => raise Domain), prim "nth" (fn [LIST (l,_), INT n] => (List.nth (l, (Int.fromLarge n)) handle Subscript => raise OutOfBounds "index out of bounds") | [VECTOR (v,_), INT n] => (List.nth (v, (Int.fromLarge n)) handle Subscript => raise OutOfBounds "index out of bounds") | _ => raise Domain), prim "first" (fn [LIST (l,_)] => (case l of (x::_) => x | _ => NIL) | [VECTOR (v,_)] => (case v of (x::_) => x | _ => NIL) | [NIL] => NIL | _ => raise Domain), prim "rest" (fn [LIST (l,_)] => malList (case l of (_::xs) => xs | _ => []) | [VECTOR (v,_)] => malList (case v of (_::xs) => xs | _ => []) | [NIL] => malList ([]) | _ => raise Domain), prim "map" (fn [FN (f,_), LIST (l,_)] => malList (List.map (fn x => f [x]) l) | [FN (f,_), VECTOR (v,_)] => malList (List.map (fn x => f [x]) v) | _ => raise Domain), (* Maps *) prim "hash-map" (fn args => buildMap args []), prim "assoc" (fn (MAP (m,_)::(args as _::_)) => buildMap args m | _ => raise Domain), prim "dissoc" (fn (MAP (m,_)::(args as _::_)) => malMap (foldl (fn (k, acc) => malDissoc acc k) m args) | _ => raise Domain), prim "get" (fn [MAP (m,_), k] => valOrElse (malGet m k) (fn () => NIL) | [NIL, _] => NIL | _ => raise Domain), prim "keys" (fn [MAP (m,_)] => malList (map #1 m) | _ => raise Domain), prim "vals" (fn [MAP (m,_)] => malList (map #2 m) | _ => raise Domain), (* Metaprogramming and metadata *) prim "read-string" (fn [STRING s] => readStr s | _ => raise Domain), prim "apply" (fn (FN (f,_)::args) => f (splatArgs args) | (MACRO f::args) => f (splatArgs args) | _ => raise Domain), prim "meta" (fn [ FN (_, META m)] => m | [ LIST (_, META m)] => m | [VECTOR (_, META m)] => m | [ MAP (_, META m)] => m | [_] => NIL | _ => raise Domain), prim "with-meta" (fn [FN (f,_), meta] => FN (f, META meta) | [LIST (l,_), meta] => LIST (l, META meta) | [VECTOR (v,_), meta] => VECTOR (v, META meta) | [MAP (m,_), meta] => MAP (m, META meta) | [x] => x | _ => raise Domain), (* Odds and ends *) prim "throw" (fn [x] => raise MalException x | _ => raise Domain), prim "time-ms" (fn _ => INT (Time.now () |> Time.toMilliseconds)) ] ================================================ FILE: impls/sml/env.sml ================================================ fun set s v (NS d) = d := (s, v) :: (!d |> List.filter (not o eq s o #1)) fun get (NS d) s = !d |> List.find (eq s o #1) |> Option.map #2 fun def s v (ENV ns) = set s v ns | def s v (INNER (ns, _)) = set s v ns fun lookup (ENV ns) s = get ns s | lookup (INNER (ns, outer)) s = optOrElse (get ns s) (fn () => lookup outer s) fun inside outer = INNER (NS (ref []), outer) ================================================ FILE: impls/sml/main.sml ================================================ val _ = main () ================================================ FILE: impls/sml/printer.sml ================================================ fun prStr NIL = "nil" | prStr (SYMBOL s) = s | prStr (BOOL true) = "true" | prStr (BOOL false) = "false" | prStr (ATOM x) = "# (" ^ (prStr (!x)) ^ ")" | prStr (INT i) = if i >= 0 then LargeInt.toString i else "-" ^ (LargeInt.toString (LargeInt.abs i)) | prStr (STRING s) = s | prStr (KEYWORD s) = ":" ^ s | prStr (LIST (l,_)) = "(" ^ (String.concatWith " " (map prStr l)) ^ ")" (* N.B. not tail recursive *) | prStr (VECTOR (v,_)) = "[" ^ (String.concatWith " " (map prStr v)) ^ "]" (* N.B. not tail recursive *) | prStr (MAP (m,_)) = "{" ^ (String.concatWith " " (map prKvp m)) ^ "}" (* N.B. not tail recursive *) | prStr (FN _) = "#" | prStr (MACRO _) = "#" and prKvp (k, v) = (prStr k) ^ " " ^ (prStr v) fun prReadableStr (STRING s) = "\"" ^ (malEscape s) ^ "\"" | prReadableStr (ATOM x) = "(atom " ^ (prReadableStr (!x)) ^ ")" | prReadableStr (LIST (l,_)) = "(" ^ (String.concatWith " " (map prReadableStr l)) ^ ")" (* N.B. not tail recursive *) | prReadableStr (VECTOR (v,_)) = "[" ^ (String.concatWith " " (map prReadableStr v)) ^ "]" (* N.B. not tail recursive *) | prReadableStr (MAP (m,_)) = "{" ^ (String.concatWith " " (map prReadableKvp m)) ^ "}" (* N.B. not tail recursive *) | prReadableStr x = prStr x and prReadableKvp (k, v) = (prReadableStr k) ^ " " ^ (prReadableStr v) ================================================ FILE: impls/sml/reader.sml ================================================ exception Nothing exception SyntaxError of string exception ReaderError of string structure Ss = Substring datatype token = SPACE | COMMENT of string | BRACKET_LEFT | BRACKET_RIGHT | BRACE_LEFT | BRACE_RIGHT | PAREN_LEFT | PAREN_RIGHT | QUOTE | BACK_TICK | TILDE | TILDE_AT | CARET | AT | LIT_ATOM of string | LIT_STR of string fun tokenString SPACE = "SPACE" | tokenString (COMMENT s) = "COMMENT (" ^ s ^ ")" | tokenString BRACKET_LEFT = "BRACKET_LEFT" | tokenString BRACKET_RIGHT = "BRACKET_RIGHT" | tokenString BRACE_LEFT = "BRACE_LEFT" | tokenString BRACE_RIGHT = "BRACE_RIGHT" | tokenString PAREN_LEFT = "PAREN_LEFT" | tokenString PAREN_RIGHT = "PAREN_RIGHT" | tokenString QUOTE = "QUOTE" | tokenString BACK_TICK = "BACK_TICK" | tokenString TILDE = "TILDE" | tokenString TILDE_AT = "TILDE_AT" | tokenString CARET = "CARET" | tokenString AT = "AT" | tokenString (LIT_ATOM s) = "LIT_ATOM (" ^ s ^ ")" | tokenString (LIT_STR s) = "LIT_STR \"" ^ s ^ "\"" datatype reader = READER of token list fun next (READER (x::xs)) = SOME (x, READER xs) | next r = NONE fun peek (READER (x::_)) = SOME x | peek r = NONE fun rest (READER (_::xs)) = READER xs | rest r = raise ReaderError "out of tokens" fun findSpecial #"[" = SOME BRACKET_LEFT | findSpecial #"]" = SOME BRACKET_RIGHT | findSpecial #"(" = SOME PAREN_LEFT | findSpecial #")" = SOME PAREN_RIGHT | findSpecial #"{" = SOME BRACE_LEFT | findSpecial #"}" = SOME BRACE_RIGHT | findSpecial #"'" = SOME QUOTE | findSpecial #"`" = SOME BACK_TICK | findSpecial #"~" = SOME TILDE | findSpecial #"^" = SOME CARET | findSpecial #"@" = SOME AT | findSpecial _ = NONE fun scanSpace ss = let fun isSpace c = Char.isSpace c orelse c = #"," val (tok, rest) = Ss.splitl isSpace ss in if Ss.isEmpty tok then NONE else SOME (SPACE, rest) end fun scanComment ss = case Ss.getc ss of SOME (#";", rest) => let val (comment, rest) = Ss.splitl (fn (c) => c <> #"\n") rest in SOME (COMMENT (Ss.string comment), rest) end | _ => NONE fun scanSpecial ss = if Ss.isPrefix "~@" ss then SOME (TILDE_AT, Ss.slice (ss, 2, NONE)) else let fun findToken (c, rest) = findSpecial c |> Option.map (fn t => (t, rest)) in Option.composePartial (findToken, Ss.getc) ss end fun scanString ss = Ss.getc ss |> Option.mapPartial (fn (#"\"", rest) => spanString rest rest | _ => NONE) and spanString from to = case Ss.getc to of SOME (#"\\", rest) => Ss.getc rest |> Option.mapPartial (fn (_, more) => spanString from more) | SOME (#"\"", rest) => SOME (LIT_STR (spanString' from to), rest) | SOME (_, rest) => spanString from rest | NONE => raise SyntaxError "end of input reached when parsing string literal" and spanString' from stop = Ss.span (from, Ss.slice (stop, 0, SOME 0)) |> Ss.string fun scanAtom ss = let fun isAtomChar c = Char.isGraph c andalso (findSpecial c = NONE) val (tok, rest) = Ss.splitl isAtomChar ss in if Ss.isEmpty tok then NONE else SOME (LIT_ATOM (Ss.string tok), rest) end fun scanToken ss = let val scanners = [scanSpace, scanComment, scanSpecial, scanString, scanAtom] val findScanner = List.find (fn f => isSome (f ss)) fun applyScanner s = s ss in Option.composePartial (applyScanner, findScanner) scanners end fun tokenize s = tokenize' [] (Ss.full s) and tokenize' acc ss = case scanToken ss of SOME (token, rest) => tokenize' (token::acc) rest | NONE => rev acc fun readAtom r = case next r of SOME (LIT_ATOM "nil", r') => (NIL, r') | SOME (LIT_ATOM "true", r') => (BOOL true, r') | SOME (LIT_ATOM "false", r') => (BOOL false, r') | SOME (LIT_ATOM s, r') => (LargeInt.fromString s |> Option.map INT |> optIfNone (fn () => Option.filter (String.isPrefix ":") s |> Option.map (KEYWORD o (triml 1))) |> valIfNone (fn () => SYMBOL s), r') | SOME (LIT_STR s, r') => (malUnescape s |> STRING, r') | SOME (CARET, r') => readWithMeta r' | SOME (token, _) => raise SyntaxError ("unexpected token reading atom: " ^ (tokenString token)) | NONE => raise SyntaxError "end of input reached when reading atom" and readForm r = case peek r of SOME PAREN_LEFT => readList [] (rest r) | SOME BRACKET_LEFT => readVector [] (rest r) | SOME BRACE_LEFT => readMap [] (rest r) | SOME AT => let val (a, r') = readAtom (rest r) in (malList [SYMBOL "deref", a], r') end | SOME QUOTE => let val (a, r') = readForm (rest r) in (malList [SYMBOL "quote", a], r') end | SOME BACK_TICK => let val (a, r') = readForm (rest r) in (malList [SYMBOL "quasiquote", a], r') end | SOME TILDE => let val (a, r') = readForm (rest r) in (malList [SYMBOL "unquote", a], r') end | SOME TILDE_AT => let val (a, r') = readForm (rest r) in (malList [SYMBOL "splice-unquote", a], r') end | _ => readAtom r and readWithMeta r = let val (m, r') = readForm r val (v, r'') = readForm r' in (malList [SYMBOL "with-meta", v, m], r'') end and readList acc r = if peek r = SOME PAREN_RIGHT then (LIST (rev acc, NO_META), (rest r)) else let val (a, r') = readForm r in readList (a::acc) r' end and readVector acc r = if peek r = SOME BRACKET_RIGHT then (VECTOR (rev acc, NO_META), (rest r)) else let val (a, r') = readForm r in readVector (a::acc) r' end and readMap acc r = if peek r = SOME BRACE_RIGHT then (MAP (rev acc, NO_META), (rest r)) else let val (k, r') = readForm r val (v, r'') = readForm r' in readMap (malAssoc acc k v) r'' end fun clean ts = ts |> List.filter (fn x => x <> SPACE) |> List.filter (fn COMMENT _ => false | _ => true) fun readStr s = case tokenize s |> clean of [] => raise Nothing | ts => ts |> READER |> readForm |> #1 ================================================ FILE: impls/sml/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/sml/step0_repl.mlb ================================================ local $(SML_LIB)/basis/basis.mlb step0_repl.sml in main.sml end ================================================ FILE: impls/sml/step0_repl.sml ================================================ fun read s: string = s fun eval s: string = s fun print s: string = s fun rep s: string = (print o eval o read) s fun repl () = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => ( print(rep(line) ^ "\n"); repl () ) | NONE => () ) end fun main () = repl () ================================================ FILE: impls/sml/step1_read_print.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml step1_read_print.sml in main.sml end ================================================ FILE: impls/sml/step1_read_print.sml ================================================ fun read s = readStr s fun eval f = f fun print f = prReadableStr f fun rep s = s |> read |> eval |> print handle SyntaxError msg => "SYNTAX ERROR: " ^ msg | Nothing => "" fun repl () = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => ( print(rep(line) ^ "\n"); repl () ) | NONE => () ) end fun main () = repl () ================================================ FILE: impls/sml/step2_eval.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml step2_eval.sml in main.sml end ================================================ FILE: impls/sml/step2_eval.sml ================================================ exception NotDefined of string exception NotApplicable of string fun read s = readStr s (* TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") *) fun eval e ast = case ast of LIST (_::_,_) => evalApply e ast | _ => evalAst e ast and evalAst e ast = case ast of SYMBOL s => (case lookup e s of SOME v => v | NONE => raise NotDefined ("unable to resolve symbol '" ^ s ^ "'")) | LIST (l,_) => LIST (List.map (eval e) l, NO_META) | VECTOR (v,_) => VECTOR (List.map (eval e) v, NO_META) | MAP (m,_) => MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | _ => ast and evalApply e ast = case evalAst e ast of LIST ((FN (f,_))::args, _) => f args | _ => raise NotApplicable "eval_apply needs a non-empty list" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | e => "ERROR: " ^ (exnMessage e) fun malPlus (INT a, INT b) = INT (a + b) | malPlus _ = raise NotApplicable "can only add integers" fun malTimes (INT a, INT b) = INT (a * b) | malTimes _ = raise NotApplicable "can only multiply integers" fun malMinus (INT b, INT a) = INT (a - b) | malMinus _ = raise NotApplicable "can only subtract integers" fun malDiv (INT b, INT a) = INT (a div b) | malDiv _ = raise NotApplicable "can only divide integers" val replEnv = ENV (NS (ref [ ("+", FN (foldl malPlus (INT 0), NO_META)), ("*", FN (foldl malTimes (INT 1), NO_META)), ("-", FN ( fn [x] => malMinus (x, INT 0) | x::xs => foldr malMinus x xs | _ => raise NotApplicable "'-' requires at least one argument" , NO_META )), ("/", FN ( fn [x] => malDiv (x, INT 1) | x::xs => foldr malDiv x xs | _ => raise NotApplicable "'/' requires at least one argument" , NO_META )) ])) fun repl () = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => ( print((rep replEnv line) ^ "\n"); repl () ) | NONE => () ) end fun main () = repl () ================================================ FILE: impls/sml/step3_env.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml step3_env.sml in main.sml end ================================================ FILE: impls/sml/step3_env.sml ================================================ exception NotDefined of string exception NotApplicable of string fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bind bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bind bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply _ a args = raise NotApplicable (prStr a ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) and bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e) | bind [] e = e | bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg fun malPlus (INT a, INT b) = INT (a + b) | malPlus _ = raise NotApplicable "can only add integers" fun malTimes (INT a, INT b) = INT (a * b) | malTimes _ = raise NotApplicable "can only multiply integers" fun malMinus (INT b, INT a) = INT (a - b) | malMinus _ = raise NotApplicable "can only subtract integers" fun malDiv (INT b, INT a) = INT (a div b) | malDiv _ = raise NotApplicable "can only divide integers" val replEnv = ENV (NS (ref [])) |> bind [ SYMBOL "+", FN (foldl malPlus (INT 0), NO_META), SYMBOL "*", FN (foldl malTimes (INT 1), NO_META), SYMBOL "-", FN (fn [x] => malMinus (x, INT 0) | x::xs => foldr malMinus x xs | _ => raise NotApplicable "'-' requires arguments" , NO_META), SYMBOL "/", FN (fn [x] => malDiv (x, INT 1) | x::xs => foldr malDiv x xs | _ => raise NotApplicable "'/' requires arguments" , NO_META) ] fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end fun main () = repl replEnv ================================================ FILE: impls/sml/step4_if_fn_do.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml step4_if_fn_do.sml in main.sml end ================================================ FILE: impls/sml/step4_if_fn_do.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [LIST (binds,_),body] = makeFn e binds body | evalFn e [VECTOR (binds,_),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs), NO_META)) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST ([], NO_META)) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \(def! not (fn* (a) (if a false true)))" fun main () = ( rep replEnv ("(do " ^ prelude ^ " nil)"); repl replEnv ) ================================================ FILE: impls/sml/step6_file.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml step6_file.sml in main.sml end ================================================ FILE: impls/sml/step6_file.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [LIST (binds,_),body] = makeFn e binds body | evalFn e [VECTOR (binds,_),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST (args, NO_META))) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs), NO_META)) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST ([], NO_META)) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \(def! not (fn* (a) (if a false true))) \ \(def! \ \ load-file \ \ (fn* (f) \ \ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" fun main () = ( bind [ SYMBOL "eval", FN (fn ([x]) => eval replEnv x | _ => raise NotApplicable "'eval' requires one argument", NO_META) ] replEnv; rep replEnv ("(do " ^ prelude ^ " nil)"); case CommandLine.arguments () of prog::args => ( def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv; rep replEnv ("(load-file \"" ^ prog ^ "\")"); () ) | args => ( def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv; repl replEnv ) ) ================================================ FILE: impls/sml/step7_quote.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml step7_quote.sml in main.sml end ================================================ FILE: impls/sml/step7_quote.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [LIST (binds,_),body] = makeFn e binds body | evalFn e [VECTOR (binds,_),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalQuote e [x] = x | evalQuote _ _ = raise NotApplicable "quote needs one argument" and evalQuasiquote e args = eval e (expandQuasiquote args) and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] | expandQuasiquote [m as MAP _] = malList ([SYMBOL "quote", m]) | expandQuasiquote [s as SYMBOL _] = malList ([SYMBOL "quote", s]) | expandQuasiquote [x] = x | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \(def! not (fn* (a) (if a false true))) \ \(def! \ \ load-file \ \ (fn* (f) \ \ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" fun main () = ( bind [ SYMBOL "eval", FN (fn ([x]) => eval replEnv x | _ => raise NotApplicable "'eval' requires one argument", NO_META) ] replEnv; rep replEnv ("(do " ^ prelude ^ " nil)"); case CommandLine.arguments () of prog::args => ( def "*ARGV*" (malList (map STRING args)) replEnv; rep replEnv ("(load-file \"" ^ prog ^ "\")"); () ) | args => ( def "*ARGV*" (malList (map STRING args)) replEnv; repl replEnv ) ) ================================================ FILE: impls/sml/step8_macros.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml step8_macros.sml in main.sml end ================================================ FILE: impls/sml/step8_macros.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [LIST (binds,_),body] = makeFn e binds body | evalFn e [VECTOR (binds,_),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalQuote e [x] = x | evalQuote _ _ = raise NotApplicable "quote needs one argument" and evalQuasiquote e args = eval e (expandQuasiquote args) and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] | expandQuasiquote [x] = x | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply e (MACRO m) args = eval e (m args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg | e => "ERROR: " ^ (exnMessage e) val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \\ \(def! not (fn* (a) (if a false true))) \ \\ \(def! \ \ load-file \ \ (fn* (f) \ \ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ \\ \(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)))))))" fun main () = ( bind [ SYMBOL "eval", FN (fn ([x]) => eval replEnv x | _ => raise NotApplicable "'eval' requires one argument", NO_META) ] replEnv; rep replEnv ("(do " ^ prelude ^ " nil)"); case CommandLine.arguments () of prog::args => ( def "*ARGV*" (malList (map STRING args)) replEnv; rep replEnv ("(load-file \"" ^ prog ^ "\")"); () ) | args => ( def "*ARGV*" (malList (map STRING args)) replEnv; repl replEnv ) ) ================================================ FILE: impls/sml/step9_try.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml step9_try.sml in main.sml end ================================================ FILE: impls/sml/step9_try.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro | specialEval (SYMBOL "try*") = SOME evalTry | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [(LIST (binds,_)),body] = makeFn e binds body | evalFn e [(VECTOR (binds,_)),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalQuote e [x] = x | evalQuote _ _ = raise NotApplicable "quote needs one argument" and evalQuasiquote e args = eval e (expandQuasiquote args) and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] | expandQuasiquote [x] = x | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and evalTry e [a, LIST ([SYMBOL "catch*", b, c],_)] = (eval e a handle ex => evalCatch (inside e) b ex c) | evalTry e [a] = eval e a | evalTry _ _ = raise NotApplicable "try* needs a form to evaluate" and evalCatch e b ex body = eval (bind [b, exnVal ex] e) body and exnVal (MalException x) = x | exnVal (SyntaxError msg) = STRING msg | exnVal (NotDefined msg) = STRING msg | exnVal (NotApplicable msg) = STRING msg | exnVal (OutOfBounds msg) = STRING msg | exnVal exn = STRING (exnMessage exn) and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply e (MACRO m) args = eval e (m args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("'" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg | MalException e => "ERROR: " ^ (prStr e) | e => "ERROR: " ^ (exnMessage e) val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \\ \(def! not (fn* (a) (if a false true))) \ \\ \(def! \ \ load-file \ \ (fn* (f) \ \ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ \\ \(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)))))))" fun main () = ( bind [ SYMBOL "eval", FN (fn ([x]) => eval replEnv x | _ => raise NotApplicable "'eval' requires one argument", NO_META) ] replEnv; rep replEnv ("(do " ^ prelude ^ " nil)"); case CommandLine.arguments () of prog::args => ( def "*ARGV*" (malList (map STRING args)) replEnv; rep replEnv ("(load-file \"" ^ prog ^ "\")"); () ) | args => ( def "*ARGV*" (malList (map STRING args)) replEnv; repl replEnv ) ) ================================================ FILE: impls/sml/stepA_mal.mlb ================================================ local $(SML_LIB)/basis/basis.mlb util.sml types.sml printer.sml reader.sml env.sml core.sml stepA_mal.sml in main.sml end ================================================ FILE: impls/sml/stepA_mal.sml ================================================ fun read s = readStr s fun eval e ast = ( case lookup e "DEBUG-EVAL" of SOME(x) => if truthy x then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") else () | NONE => (); eval' e ast) and eval' e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) | eval' e (SYMBOL s) = evalSymbol e s | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) | eval' e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet | specialEval (SYMBOL "do") = SOME evalDo | specialEval (SYMBOL "if") = SOME evalIf | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro | specialEval (SYMBOL "try*") = SOME evalTry | specialEval _ = NONE and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end | evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" and evalLet e [LIST (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet e [VECTOR (bs,_), ast] = eval (bindLet bs (inside e)) ast | evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs | evalDo _ _ = raise NotApplicable "do needs at least one argument" and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b | evalIf e [c,a] = evalIf e [c,a,NIL] | evalIf _ _ = raise NotApplicable "if needs two or three arguments" and evalFn e [(LIST (binds,_)),body] = makeFn e binds body | evalFn e [(VECTOR (binds,_)),body] = makeFn e binds body | evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body" and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body, NO_META) and evalQuote e [x] = x | evalQuote _ _ = raise NotApplicable "quote needs one argument" and evalQuasiquote e args = eval e (expandQuasiquote args) and expandQuasiquote [LIST ([SYMBOL "unquote", x],_)] = x | expandQuasiquote [LIST (l,_)] = malList (foldr quasiFolder [] l) | expandQuasiquote [VECTOR (v,_)] = malList [SYMBOL "vec", malList (foldr quasiFolder [] v)] | expandQuasiquote [m as MAP _] = malList [SYMBOL "quote", m] | expandQuasiquote [s as SYMBOL _] = malList [SYMBOL "quote", s] | expandQuasiquote [x] = x | expandQuasiquote _ = raise NotApplicable "quasiquote needs one argument" and quasiFolder (LIST ([SYMBOL "splice-unquote", x],_), acc) = [SYMBOL "concat", x, malList acc] | quasiFolder (x, acc) = [SYMBOL "cons", expandQuasiquote [x], malList acc] and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) | evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" and evalTry e [a, LIST ([SYMBOL "catch*", b, c],_)] = (eval e a handle ex => evalCatch (inside e) b ex c) | evalTry e [a] = eval e a | evalTry _ _ = raise NotApplicable "try* needs a form to evaluate" and evalCatch e b ex body = eval (bind [b, exnVal ex] e) body and exnVal (MalException x) = x | exnVal (SyntaxError msg) = STRING msg | exnVal (NotDefined msg) = STRING msg | exnVal (NotApplicable msg) = STRING msg | exnVal (OutOfBounds msg) = STRING msg | exnVal exn = STRING (exnMessage exn) and evalApply e (FN (f,_)) args = f (map (eval e) args) | evalApply e (MACRO m) args = eval e (m args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) and evalSymbol e s = valOrElse (lookup e s) (fn _ => raise NotDefined ("'" ^ s ^ "' not found")) and bindLet args e = bind' (eval e) args e and bind args e = bind' identity args e and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (malList (map evl (v::vs))) e; e) | bind' _ [SYMBOL "&", SYMBOL s] e = (def s (malList []) e; e) | bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e) | bind' _ [] e = e | bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun print f = prReadableStr f fun rep e s = s |> read |> eval e |> print handle Nothing => "" | SyntaxError msg => "SYNTAX ERROR: " ^ msg | NotApplicable msg => "CANNOT APPLY: " ^ msg | NotDefined msg => "NOT DEFINED: " ^ msg | MalException e => "ERROR: " ^ (prStr e) | e => "ERROR: " ^ (exnMessage e) val replEnv = ENV (NS (ref [])) |> bind coreNs fun repl e = let open TextIO in ( print("user> "); case inputLine(stdIn) of SOME(line) => let val s = rep e line val _ = print(s ^ "\n") in repl e end | NONE => () ) end val prelude = " \ \\ \(def! not (fn* (a) (if a false true))) \ \\ \(def! \ \ load-file \ \ (fn* (f) \ \ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))\ \\ \(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)))))))" fun main () = ( def "*host-language*" (STRING "sml") replEnv; bind [ SYMBOL "eval", FN (fn ([x]) => eval replEnv x | _ => raise NotApplicable "'eval' requires one argument", NO_META) ] replEnv; rep replEnv ("(do " ^ prelude ^ " nil)"); case CommandLine.arguments () of prog::args => ( def "*ARGV*" (malList (map STRING args)) replEnv; rep replEnv ("(load-file \"" ^ prog ^ "\")"); () ) | args => ( def "*ARGV*" (malList (map STRING args)) replEnv; rep replEnv "(println (str \"Mal [\" *host-language* \"]\"))"; repl replEnv ) ) ================================================ FILE: impls/sml/types.sml ================================================ datatype mal_type = NIL | SYMBOL of string | BOOL of bool | INT of LargeInt.int | STRING of string | KEYWORD of string | LIST of (mal_type list * mal_meta) | VECTOR of (mal_type list * mal_meta) | MAP of ((mal_type * mal_type) list * mal_meta) | ATOM of mal_type ref | FN of (mal_type list -> mal_type) * mal_meta | MACRO of mal_type list -> mal_type and mal_meta = META of mal_type | NO_META and mal_ns = NS of (string * mal_type) list ref and mal_env = ENV of mal_ns | INNER of mal_ns * mal_env fun truthy (BOOL false) = false | truthy NIL = false | truthy _ = true fun malEq ( NIL, NIL) = true | malEq ( SYMBOL a, SYMBOL b) = a = b | malEq ( BOOL a, BOOL b) = a = b | malEq ( INT a, INT b) = a = b | malEq ( STRING a, STRING b) = a = b | malEq ( KEYWORD a, KEYWORD b) = a = b | malEq ( LIST (a,_), LIST (b,_)) = ListPair.allEq malEq (a, b) | malEq (VECTOR (a,_), VECTOR (b,_)) = ListPair.allEq malEq (a, b) | malEq ( LIST (a,_), VECTOR (b,_)) = ListPair.allEq malEq (a, b) | malEq (VECTOR (a,_), LIST (b,_)) = ListPair.allEq malEq (a, b) | malEq ( MAP (a,_), MAP (b,_)) = mapEq a b | malEq _ = false and mapEq a b = a |> List.map (fn (k,va) => (va, malGet b k)) |> List.all (fn (va,SOME vb) => malEq (va, vb) | _ => false) andalso b |> List.map (fn (k,vb) => (vb, malGet a k)) |> List.all (fn (vb,SOME va) => malEq (vb, va) | _ => false) and malGet m k = m |> List.find (fn (k',_) => malEq (k, k')) |> Option.map #2 and malAssoc m k v = (k, v) :: (malDissoc m k) and malDissoc m k = m |> List.filter (not o (fn (k', _) => malEq (k, k'))) fun malList xs = LIST (xs, NO_META) fun malVector xs = VECTOR (xs, NO_META) fun malMap kvps = MAP (kvps, NO_META) ================================================ FILE: impls/sml/util.sml ================================================ fun takeWhile f xs = takeWhile' f [] xs and takeWhile' f acc [] = rev acc | takeWhile' f acc (x::xs) = if f x then takeWhile' f (x::acc) xs else rev acc infix 3 |> fun x |> f = f x fun eq a b = a = b fun optOrElse NONE b = b () | optOrElse a _ = a fun valOrElse (SOME x) _ = x | valOrElse a b = b () fun optIfNone b NONE = b () | optIfNone _ a = a fun valIfNone _ (SOME a) = a | valIfNone b _ = b () fun interleave (x::xs) (y::ys) = x :: y :: interleave xs ys | interleave [] ys = ys | interleave xs [] = xs fun identity x = x fun triml k s = String.extract (s, k, NONE) fun trimr k s = String.substring (s, 0, String.size s - k) fun malEscape s = String.translate (fn #"\"" => "\\\"" | #"\n" => "\\n" | #"\\" => "\\\\" | c => String.str c) s fun malUnescape s = malUnescape' (String.explode s) and malUnescape' (#"\\"::(#"\""::rest)) = "\"" ^ malUnescape' rest | malUnescape' (#"\\"::(#"n" ::rest)) = "\n" ^ malUnescape' rest | malUnescape' (#"\\"::(#"\\"::rest)) = "\\" ^ malUnescape' rest | malUnescape' (c::rest) = (String.str c) ^ malUnescape' rest | malUnescape' ([]) = "" ================================================ FILE: impls/swift3/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Swift RUN apt-get -y install clang-3.6 cmake pkg-config \ git ninja-build uuid-dev libicu-dev icu-devtools \ libbsd-dev libedit-dev libxml2-dev libsqlite3-dev \ swig libpython-dev libncurses5-dev # TODO: better way to do this? RUN ln -sf /usr/lib/llvm-3.6/bin/clang++ /usr/bin/clang++ RUN ln -sf /usr/lib/llvm-3.6/bin/clang /usr/bin/clang ENV SWIFT_PREFIX swift-3.1.1-RELEASE ENV SWIFT_RELEASE ${SWIFT_PREFIX}-ubuntu16.04 RUN cd /opt && \ curl -O https://download.swift.org/swift-3.1.1-release/ubuntu1604/${SWIFT_PREFIX}/${SWIFT_RELEASE}.tar.gz && \ tar xvzf ${SWIFT_RELEASE}.tar.gz && \ rm ${SWIFT_RELEASE}.tar.gz ENV PATH /opt/${SWIFT_RELEASE}/usr/bin/:$PATH ================================================ FILE: impls/swift3/Makefile ================================================ ifneq ($(shell which xcrun),) SWIFT = xcrun -sdk macosx swiftc else SWIFT = swiftc endif STEP3_DEPS = Sources/types.swift Sources/reader.swift Sources/printer.swift Sources/env.swift STEP4_DEPS = $(STEP3_DEPS) Sources/core.swift STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal all: $(STEPS) dist: mal mal: stepA_mal cp $< $@ step1_read_print step2_eval step3_env: $(STEP3_DEPS) step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) step%: Sources/step%/main.swift $(SWIFT) $+ -o $@ clean: rm -f $(STEPS) mal ================================================ FILE: impls/swift3/Sources/core.swift ================================================ // TODO: remove this once time-ms and slurp use standard library calls #if os(Linux) import Glibc #else import Darwin #endif func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { switch (a, b) { case (MV.MalInt(let i1), MV.MalInt(let i2)): return MV.MalInt(op(i1, i2)) default: throw MalError.General(msg: "Invalid IntOp call") } } func CmpOp(_ op: (Int, Int) -> Bool, _ a: MalVal, _ b: MalVal) throws -> MalVal { switch (a, b) { case (MV.MalInt(let i1), MV.MalInt(let i2)): return wraptf(op(i1, i2)) default: throw MalError.General(msg: "Invalid CmpOp call") } } let core_ns: Dictionary) throws -> MalVal> = [ "=": { wraptf(equal_Q($0[0], $0[1])) }, "throw": { throw MalError.MalException(obj: $0[0]) }, "nil?": { switch $0[0] { case MV.MalNil(_): return MV.MalTrue default: return MV.MalFalse } }, "true?": { switch $0[0] { case MV.MalTrue(_): return MV.MalTrue default: return MV.MalFalse } }, "false?": { switch $0[0] { case MV.MalFalse(_): return MV.MalTrue default: return MV.MalFalse } }, "string?": { switch $0[0] { case MV.MalString(let s) where s.characters.count == 0: return MV.MalTrue case MV.MalString(let s): return wraptf(s[s.startIndex] != "\u{029e}") default: return MV.MalFalse } }, "symbol": { switch $0[0] { case MV.MalSymbol(_): return $0[0] case MV.MalString(let s): return MV.MalSymbol(s) default: throw MalError.General(msg: "Invalid symbol call") } }, "symbol?": { switch $0[0] { case MV.MalSymbol(_): return MV.MalTrue default: return MV.MalFalse } }, "keyword": { switch $0[0] { case MV.MalString(let s) where s.characters.count > 0: if s[s.startIndex] == "\u{029e}" { return $0[0] } else { return MV.MalString("\u{029e}\(s)") } default: throw MalError.General(msg: "Invalid symbol call") } }, "keyword?": { switch $0[0] { case MV.MalString(let s) where s.characters.count > 0: return wraptf(s[s.startIndex] == "\u{029e}") default: return MV.MalFalse } }, "number?": { switch $0[0] { case MV.MalInt(_): return MV.MalTrue default: return MV.MalFalse } }, "fn?": { switch $0[0] { case MalVal.MalFunc(_, nil, _, _, _, _), MalVal.MalFunc(_, _, _, _, false, _): return MV.MalTrue default: return MV.MalFalse } }, "macro?": { switch $0[0] { case MalVal.MalFunc(_, _, _, _, true, _): return MV.MalTrue default: return MV.MalFalse } }, "pr-str": { // TODO: if the following two statements are combined into one, we get // the following error message. It's not clear to me that there's // actually any error, so this might be a compiler issue. // // Sources/core.swift:29:59: error: type of expression is ambiguous without more context // let core_ns: [String: (Array) throws -> MalVal] = [ // ^ let s = $0.map { pr_str($0,true) }.joined(separator: " ") return MV.MalString(s) }, "str": { // The comment for "pr-str" applies here, too. let s = $0.map { pr_str($0,false) }.joined(separator: "") return MV.MalString(s) }, "prn": { print($0.map { pr_str($0,true) }.joined(separator: " ")) return MV.MalNil }, "println": { print($0.map { pr_str($0,false) }.joined(separator: " ")) return MV.MalNil }, "read-string": { switch $0[0] { case MV.MalString(let str): return try read_str(str) default: throw MalError.General(msg: "Invalid read-string call") } }, "readline": { switch $0[0] { case MV.MalString(let prompt): print(prompt, terminator: "") let line = readLine(strippingNewline: true) if line == nil { return MV.MalNil } return MV.MalString(line!) default: throw MalError.General(msg: "Invalid readline call") } }, "slurp": { switch $0[0] { case MV.MalString(let file): let data = try String(contentsOfFile: file, encoding: String.Encoding.utf8) return MV.MalString(data) default: throw MalError.General(msg: "Invalid slurp call") } }, "<": { try CmpOp({ $0 < $1}, $0[0], $0[1]) }, "<=": { try CmpOp({ $0 <= $1}, $0[0], $0[1]) }, ">": { try CmpOp({ $0 > $1}, $0[0], $0[1]) }, ">=": { try CmpOp({ $0 >= $1}, $0[0], $0[1]) }, "+": { try IntOp({ $0 + $1}, $0[0], $0[1]) }, "-": { try IntOp({ $0 - $1}, $0[0], $0[1]) }, "*": { try IntOp({ $0 * $1}, $0[0], $0[1]) }, "/": { try IntOp({ $0 / $1}, $0[0], $0[1]) }, "time-ms": { let read = $0; // no parameters // TODO: replace with something more like this // return MV.MalInt(NSDate().timeIntervalSince1970 ) var tv:timeval = timeval(tv_sec: 0, tv_usec: 0) gettimeofday(&tv, nil) return MV.MalInt(tv.tv_sec * 1000 + Int(tv.tv_usec)/1000) }, "list": { list($0) }, "list?": { switch $0[0] { case MV.MalList: return MV.MalTrue default: return MV.MalFalse } }, "vector": { vector($0) }, "vector?": { switch $0[0] { case MV.MalVector: return MV.MalTrue default: return MV.MalFalse } }, "hash-map": { try hash_map($0) }, "map?": { switch $0[0] { case MV.MalHashMap: return MV.MalTrue default: return MV.MalFalse } }, "assoc": { switch $0[0] { case MV.MalHashMap(let dict, _): return hash_map(try _assoc(dict, Array($0[1..<$0.endIndex]))) default: throw MalError.General(msg: "Invalid assoc call") } }, "dissoc": { switch $0[0] { case MV.MalHashMap(let dict, _): return hash_map(try _dissoc(dict, Array($0[1..<$0.endIndex]))) default: throw MalError.General(msg: "Invalid dissoc call") } }, "get": { switch ($0[0], $0[1]) { case (MV.MalHashMap(let dict, _), MV.MalString(let k)): return dict[k] ?? MV.MalNil case (MV.MalNil, MV.MalString(let k)): return MV.MalNil default: throw MalError.General(msg: "Invalid get call") } }, "contains?": { switch ($0[0], $0[1]) { case (MV.MalHashMap(let dict, _), MV.MalString(let k)): return dict[k] != nil ? MV.MalTrue : MV.MalFalse case (MV.MalNil, MV.MalString(let k)): return MV.MalFalse default: throw MalError.General(msg: "Invalid contains? call") } }, "keys": { switch $0[0] { case MV.MalHashMap(let dict, _): return list(dict.keys.map { MV.MalString($0) }) default: throw MalError.General(msg: "Invalid keys call") } }, "vals": { switch $0[0] { case MV.MalHashMap(let dict, _): return list(dict.values.map { $0 }) default: throw MalError.General(msg: "Invalid vals call") } }, "sequential?": { switch $0[0] { case MV.MalList: return MV.MalTrue case MV.MalVector: return MV.MalTrue default: return MV.MalFalse } }, "cons": { if $0.count != 2 { throw MalError.General(msg: "Invalid cons call") } switch ($0[0], $0[1]) { case (let mv, MV.MalList(let lst, _)): return list([mv] + lst) case (let mv, MV.MalVector(let lst, _)): return list([mv] + lst) default: throw MalError.General(msg: "Invalid cons call") } }, "concat": { var res = Array() for seq in $0 { switch seq { case MV.MalList(let lst, _): res = res + lst case MV.MalVector(let lst, _): res = res + lst default: throw MalError.General(msg: "Invalid concat call") } } 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]) { case (MV.MalList(let lst, _), MV.MalInt(let idx)): if idx >= lst.count { throw MalError.General(msg: "nth: index out of range") } return try _nth($0[0], idx) case (MV.MalVector(let lst, _), MV.MalInt(let idx)): if idx >= lst.count { throw MalError.General(msg: "nth: index out of range") } return try _nth($0[0], idx) default: throw MalError.General(msg: "Invalid nth call") } }, "first": { switch $0[0] { case MV.MalList(let lst, _): return lst.count > 0 ? lst[0] : MV.MalNil case MV.MalVector(let lst, _): return lst.count > 0 ? lst[0] : MV.MalNil case MV.MalNil: return MV.MalNil default: throw MalError.General(msg: "Invalid first call") } }, "rest": { switch $0[0] { case MV.MalList(let lst, _): return lst.count > 0 ? try rest($0[0]) : list([]) case MV.MalVector(let lst, _): return lst.count > 0 ? try rest($0[0]) : list([]) case MV.MalNil: return list([]) default: throw MalError.General(msg: "Invalid rest call") } }, "empty?": { switch $0[0] { case MV.MalList(let lst, _): return lst.count == 0 ? MV.MalTrue : MV.MalFalse case MV.MalVector(let lst, _): return lst.count == 0 ? MV.MalTrue : MV.MalFalse case MV.MalNil: return MV.MalTrue default: throw MalError.General(msg: "Invalid empty? call") } }, "count": { switch $0[0] { case MV.MalList(let lst, _): return MV.MalInt(lst.count) case MV.MalVector(let lst, _): return MV.MalInt(lst.count) case MV.MalNil: return MV.MalInt(0) default: throw MalError.General(msg: "Invalid count call") } }, "apply": { let fn: (Array) throws -> MalVal switch $0[0] { case MV.MalFunc(let f, _, _, _, _, _): fn = f default: throw MalError.General(msg: "Invalid apply call") } var args = Array($0[1..<$0.endIndex-1]) switch $0[$0.endIndex-1] { case MV.MalList(let l, _): args = args + l case MV.MalVector(let l, _): args = args + l default: throw MalError.General(msg: "Invalid apply call") } return try fn(args) }, "map": { let fn: (Array) throws -> MalVal switch $0[0] { case MV.MalFunc(let f, _, _, _, _, _): fn = f default: throw MalError.General(msg: "Invalid map call") } var lst = Array() switch $0[1] { case MV.MalList(let l, _): lst = l case MV.MalVector(let l, _): lst = l default: throw MalError.General(msg: "Invalid map call") } var res = Array() for mv in lst { res.append(try fn([mv])) } return list(res) }, "conj": { if $0.count < 1 { throw MalError.General(msg: "Invalid conj call") } switch $0[0] { case MV.MalList(let lst, _): let a = Array($0[1..<$0.endIndex]).reversed() return list(a + lst) case MV.MalVector(let lst, _): return vector(lst + $0[1..<$0.endIndex]) default: throw MalError.General(msg: "Invalid conj call") } }, "seq": { if $0.count < 1 { throw MalError.General(msg: "Invalid seq call") } switch $0[0] { case MV.MalList(let lst, _): if lst.count == 0 { return MV.MalNil } return $0[0] case MV.MalVector(let lst, _): if lst.count == 0 { return MV.MalNil } return list(lst) case MV.MalString(let str): if str.characters.count == 0 { return MV.MalNil } return list(str.characters.map { MV.MalString(String($0)) }) case MV.MalNil: return MV.MalNil default: throw MalError.General(msg: "Invalid seq call") } }, "meta": { switch $0[0] { case MV.MalList(_, let m): return m != nil ? m![0] : MV.MalNil case MV.MalVector(_, let m): return m != nil ? m![0] : MV.MalNil case MV.MalHashMap(_, let m): return m != nil ? m![0] : MV.MalNil case MV.MalFunc(_, _, _, _, _, let m): return m != nil ? m![0] : MV.MalNil default: throw MalError.General(msg: "meta called on non-function") } }, "with-meta": { switch $0[0] { case MV.MalList(let l, _): return list(l, meta: $0[1]) case MV.MalVector(let l, _): return vector(l, meta: $0[1]) case MV.MalHashMap(let d, _): return hash_map(d, meta: $0[1]) case MV.MalFunc(let f, let a, let e, let p, let m, _): return malfunc(f, ast:a, env:e, params:p, macro:m, meta:$0[1]) //return MV.MalFunc(f,ast:a,env:e,params:p,macro:m,meta:[$0[1]]) default: throw MalError.General(msg: "with-meta called on non-collection") } }, "atom": { return MV.MalAtom(MutableAtom(val: $0[0])) }, "atom?": { switch $0[0] { case MV.MalAtom(_): return MV.MalTrue default: return MV.MalFalse } }, "deref": { switch $0[0] { case MV.MalAtom(let ma): return ma.val default: throw MalError.General(msg: "Invalid deref call") } }, "reset!": { switch $0[0] { case MV.MalAtom(var a): a.val = $0[1] return $0[1] default: throw MalError.General(msg: "Invalid reset! call") } }, "swap!": { switch ($0[0], $0[1]) { case (MV.MalAtom(var a), MV.MalFunc(let fn, _, _, _, _, _)): var args = [a.val] if $0.count > 2 { args = args + Array($0[2..<$0.endIndex]) } a.val = try fn(args) return a.val default: throw MalError.General(msg: "Invalid swap! call") } }, ] ================================================ FILE: impls/swift3/Sources/env.swift ================================================ class Env { var outer: Env? = nil var data: Dictionary = [:] init(_ outer: Env? = nil, binds: MalVal? = nil, exprs: MalVal? = nil) throws { self.outer = outer if binds != nil { var bs = Array(), es = Array() //print("binds: \(binds), exprs: \(exprs)") switch (binds!, exprs!) { case (MalVal.MalList(let l1, _), MalVal.MalList(let l2, _)): bs = l1; es = l2 case (MalVal.MalVector(let l1, _), MalVal.MalList(let l2, _)): bs = l1; es = l2 default: throw MalError.General(msg: "invalid Env init call") } var pos = bs.startIndex bhandle: while pos < bs.endIndex { let b = bs[pos] switch b { case MalVal.MalSymbol("&"): switch bs[bs.index(after: pos)] { case MalVal.MalSymbol(let sym): if pos < es.endIndex { let slc = es[pos.. MalVal? { return data[str] ?? outer?.get(str) } @discardableResult func set(_ key: MalVal, _ val: MalVal) throws -> MalVal { switch key { case MalVal.MalSymbol(let str): data[str] = val return val default: throw MalError.General(msg: "invalid Env.find call") } } } ================================================ FILE: impls/swift3/Sources/printer.swift ================================================ func pr_str(_ obj: MalVal, _ print_readably: Bool = true) -> String { switch obj { case MalVal.MalList(let lst, _): let elems = lst.map { pr_str($0, print_readably) } return "(" + elems.joined(separator: " ") + ")" case MalVal.MalVector(let lst, _): let elems = lst.map { pr_str($0, print_readably) } return "[" + elems.joined(separator: " ") + "]" case MalVal.MalHashMap(let dict, _): let elems = dict.map { pr_str(MalVal.MalString($0), print_readably) + " " + pr_str($1, print_readably) } return "{" + elems.joined(separator: " ") + "}" case MalVal.MalString(let str): //print("kw: '\(str[str.startIndex])'") if str.characters.count > 0 && str[str.startIndex] == "\u{029e}" { return ":" + str[str.index(after: str.startIndex).." case MalVal.MalFunc(_, let ast, _, let params, _, _): return "(fn* \(pr_str(params![0])) \(pr_str(ast![0])))" case MalVal.MalAtom(let ma): return "(atom \(pr_str(ma.val, print_readably)))" default: return String(describing:obj) } } ================================================ FILE: impls/swift3/Sources/reader.swift ================================================ let token_delim: Set = [ ";", ",", "\"", "`", " ", "\n", "{", "}", "(", ")", "[", "]" ] let int_char: Set = [ "-", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" ] let float_char: Set = [ ".", "-", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" ] let whitespace: Set = [" ", "\t", "\n", ","] class Reader { var str: String var pos: String.Index init(_ str: String) { self.str = str pos = str.startIndex } func next() { pos = str.index(after: pos) } } func read_int(_ rdr: Reader) -> MalVal { let start = rdr.pos var cidx = rdr.pos while cidx < rdr.str.endIndex { if !int_char.contains(rdr.str[cidx]) { break } cidx = rdr.str.index(after: cidx) rdr.pos = cidx } let matchStr = rdr.str.substring(with: start.. MalVal { let start = rdr.pos var escaped = false if rdr.str[rdr.pos] != "\"" { throw MalError.Reader(msg: "read_string call on non-string") } var cidx = rdr.str.index(after: rdr.pos) while cidx < rdr.str.endIndex { rdr.pos = rdr.str.index(after: cidx) if escaped { escaped = false cidx = rdr.pos continue } if rdr.str[cidx] == "\\" { escaped = true } if rdr.str[cidx] == "\"" { break } cidx = rdr.pos } if cidx >= rdr.str.endIndex || rdr.str[rdr.str.index(before: rdr.pos)] != "\"" { throw MalError.Reader(msg: "Expected '\"', got EOF") } let matchStr = rdr.str.substring(with: rdr.str.index(after: start).. String { let start = rdr.pos var cidx = rdr.pos while cidx < rdr.str.endIndex { rdr.pos = cidx if token_delim.contains(rdr.str[cidx]) { break } cidx = rdr.str.index(after: cidx) rdr.pos = cidx } return rdr.str.substring(with: start.. MalVal { let tok = read_token(rdr) switch tok { case "nil": return MalVal.MalNil case "true": return MalVal.MalTrue case "false": return MalVal.MalFalse default: return MalVal.MalSymbol(tok) } } func read_atom(_ rdr: Reader) throws -> MalVal { if rdr.str.characters.count == 0 { throw MalError.Reader(msg: "Empty string passed to read_atom") } switch rdr.str[rdr.pos] { case "-" where rdr.str.characters.count == 1 || !int_char.contains(rdr.str[rdr.str.index(after: rdr.pos)]): return try read_symbol(rdr) case let c where int_char.contains(c): return read_int(rdr) case "\"": return try read_string(rdr) case ":": rdr.next() return MalVal.MalString("\u{029e}\(read_token(rdr))") default: return try read_symbol(rdr) } } func read_list(_ rdr: Reader, start: Character = "(", end: Character = ")") throws -> Array { if rdr.str[rdr.pos] != start { throw MalError.Reader(msg: "expected '\(start)'") } rdr.next() skip_whitespace_and_comments(rdr) var lst: [MalVal] = [] while rdr.pos < rdr.str.endIndex { if (rdr.str[rdr.pos] == end) { break } lst.append(try read_form(rdr)) } if rdr.pos >= rdr.str.endIndex { throw MalError.Reader(msg: "Expected '\(end)', got EOF") } rdr.next() return lst } func read_form(_ rdr: Reader) throws -> MalVal { if rdr.str.characters.count == 0 { throw MalError.Reader(msg: "Empty string passed to read_form") } //print("read_form: \(rdr.pos): \(rdr.str[rdr.pos])") skip_whitespace_and_comments(rdr) var res: MalVal switch rdr.str[rdr.pos] { // reader macros/transforms case "'": rdr.next() return list([MalVal.MalSymbol("quote"), try read_form(rdr)]) case "`": rdr.next() return list([MalVal.MalSymbol("quasiquote"), try read_form(rdr)]) case "~": switch rdr.str[rdr.str.index(after: rdr.pos)] { case "@": rdr.next() rdr.next() return list([MalVal.MalSymbol("splice-unquote"), try read_form(rdr)]) default: rdr.next() return list([MalVal.MalSymbol("unquote"), try read_form(rdr)]) } case "^": rdr.next() let meta = try read_form(rdr) return list([MalVal.MalSymbol("with-meta"), try read_form(rdr), meta]) case "@": rdr.next() return list([MalVal.MalSymbol("deref"), try read_form(rdr)]) // list case "(": res = list(try read_list(rdr)) case ")": throw MalError.Reader(msg: "unexpected ')'") // vector case "[": res = vector(try read_list(rdr, start: "[", end: "]")) case "]": throw MalError.Reader(msg: "unexpected ']'") // hash-map case "{": res = try hash_map(try read_list(rdr, start: "{", end: "}")) case "}": throw MalError.Reader(msg: "unexpected '}'") // atom default: res = try read_atom(rdr) } skip_whitespace_and_comments(rdr) return res } func read_str(_ str: String) throws -> MalVal { return try read_form(Reader(str)) } ================================================ FILE: impls/swift3/Sources/step0_repl/main.swift ================================================ import Foundation while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } print("\(line!)") } ================================================ FILE: impls/swift3/Sources/step1_read_print/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ ast: MalVal, _ env: String) throws -> MalVal { return ast } // print func PRINT(_ exp: MalVal) -> String { return pr_str(exp, true) } // repl func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), "")) } while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } } ================================================ FILE: impls/swift3/Sources/step2_eval/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ ast: MalVal, _ env: Dictionary) throws -> MalVal { /* print("EVAL: " + PRINT(ast)) */ switch ast { case MalVal.MalSymbol(let sym): if let value = env[sym] { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } let raw_args = lst[1.. String { return pr_str(exp, true) } // repl func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { switch (a, b) { case (MalVal.MalInt(let i1), MalVal.MalInt(let i2)): return MalVal.MalInt(op(i1, i2)) default: throw MalError.General(msg: "Invalid IntOp call") } } var repl_env: Dictionary = [ "+": malfunc({ try IntOp({ $0 + $1}, $0[0], $0[1]) }), "-": malfunc({ try IntOp({ $0 - $1}, $0[0], $0[1]) }), "*": malfunc({ try IntOp({ $0 * $1}, $0[0], $0[1]) }), "/": malfunc({ try IntOp({ $0 / $1}, $0[0], $0[1]) }), ] while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } } ================================================ FILE: impls/swift3/Sources/step3_env/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ ast: MalVal, _ env: Env) throws -> MalVal { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } return try EVAL(lst[2], let_env) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } func IntOp(_ op: (Int, Int) -> Int, _ a: MalVal, _ b: MalVal) throws -> MalVal { switch (a, b) { case (MalVal.MalInt(let i1), MalVal.MalInt(let i2)): return MalVal.MalInt(op(i1, i2)) default: throw MalError.General(msg: "Invalid IntOp call") } } var repl_env: Env = try Env() try repl_env.set(MalVal.MalSymbol("+"), malfunc({ try IntOp({ $0 + $1}, $0[0], $0[1]) })) try repl_env.set(MalVal.MalSymbol("-"), malfunc({ try IntOp({ $0 - $1}, $0[0], $0[1]) })) try repl_env.set(MalVal.MalSymbol("*"), malfunc({ try IntOp({ $0 * $1}, $0[0], $0[1]) })) try repl_env.set(MalVal.MalSymbol("/"), malfunc({ try IntOp({ $0 / $1}, $0[0], $0[1]) })) while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } } ================================================ FILE: impls/swift3/Sources/step4_if_fn_do/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ ast: MalVal, _ env: Env) throws -> MalVal { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } return try EVAL(lst[2], let_env) case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { return try EVAL(lst[3], env) } else { return MalVal.MalNil } default: return try EVAL(lst[2], env) } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } // core.mal: defined using the language itself try rep("(def! not (fn* (a) (if a false true)))") while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/step5_tco/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } // core.mal: defined using the language itself try rep("(def! not (fn* (a) (if a false true)))") while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/step6_file/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } try repl_env.set(MalVal.MalSymbol("eval"), malfunc({ try EVAL($0[0], repl_env) })) let pargs = CommandLine.arguments.map { MalVal.MalString($0) } // TODO: weird way to get empty list, fix this var args = pargs[pargs.startIndex.. 1 { try rep("(load-file \"" + CommandLine.arguments[1] + "\")") exit(0) } while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/step7_quote/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { 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 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 } 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(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } try repl_env.set(MalVal.MalSymbol("eval"), malfunc({ try EVAL($0[0], repl_env) })) let pargs = CommandLine.arguments.map { MalVal.MalString($0) } // TODO: weird way to get empty list, fix this var args = pargs[pargs.startIndex.. 1 { try rep("(load-file \"" + CommandLine.arguments[1] + "\")") exit(0) } while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/step8_macros/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { 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 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 } 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(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): var mac = try EVAL(lst[2], env) switch mac { case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) default: throw MalError.General(msg: "invalid defmacro! form") } return try env.set(lst[1], mac) case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } try repl_env.set(MalVal.MalSymbol("eval"), malfunc({ try EVAL($0[0], repl_env) })) let pargs = CommandLine.arguments.map { MalVal.MalString($0) } // TODO: weird way to get empty list, fix this var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if CommandLine.arguments.count > 1 { try rep("(load-file \"" + CommandLine.arguments[1] + "\")") exit(0) } while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/step9_try/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { 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 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 } 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(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): var mac = try EVAL(lst[2], env) switch mac { case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) default: throw MalError.General(msg: "invalid defmacro! form") } return try env.set(lst[1], mac) case MalVal.MalSymbol("try*"): do { return try EVAL(_nth(ast, 1), env) } catch (let exc) { if lst.count > 2 { let a2 = lst[2] switch a2 { case MalVal.MalList(let a2lst, _): let a20 = a2lst[0] switch a20 { case MalVal.MalSymbol("catch*"): if a2lst.count < 3 { return MalVal.MalNil } let a21 = a2lst[1], a22 = a2lst[2] var err: MalVal switch exc { case MalError.Reader(let msg): err = MalVal.MalString(msg) case MalError.General(let msg): err = MalVal.MalString(msg) case MalError.MalException(let obj): err = obj default: err = MalVal.MalString(String(describing:exc)) } return try EVAL(a22, Env(env, binds: list([a21]), exprs: list([err]))) default: break } default: break } } throw exc } case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } try repl_env.set(MalVal.MalSymbol("eval"), malfunc({ try EVAL($0[0], repl_env) })) let pargs = CommandLine.arguments.map { MalVal.MalString($0) } // TODO: weird way to get empty list, fix this var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if CommandLine.arguments.count > 1 { try rep("(load-file \"" + CommandLine.arguments[1] + "\")") exit(0) } while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/stepA_mal/main.swift ================================================ import Foundation // read func READ(_ str: String) throws -> MalVal { return try read_str(str) } // eval func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { 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 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 } 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(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { var ast = orig_ast, env = orig_env while true { if let dbgeval = env.get("DEBUG-EVAL") { switch dbgeval { case MalVal.MalFalse, MalVal.MalNil: break default: print("EVAL: " + PRINT(ast)) } } switch ast { case MalVal.MalSymbol(let sym): if let value = env.get(sym) { return value } else { throw MalError.General(msg: "'\(sym)' not found") } case MalVal.MalVector(let lst, _): return vector(try lst.map { try EVAL($0, env) }) case MalVal.MalHashMap(let dict, _): var new_dict = Dictionary() for (k,v) in dict { new_dict[k] = try EVAL(v, env) } return hash_map(new_dict) case MalVal.MalList(let lst, _): if lst.count == 0 { return ast } switch lst[0] { case MalVal.MalSymbol("def!"): return try env.set(lst[1], try EVAL(lst[2], env)) case MalVal.MalSymbol("let*"): let let_env = try Env(env) var binds = Array() switch lst[1] { case MalVal.MalList(let l, _): binds = l case MalVal.MalVector(let l, _): binds = l default: throw MalError.General(msg: "Invalid let* bindings") } var idx = binds.startIndex while idx < binds.endIndex { let v = try EVAL(binds[binds.index(after: idx)], let_env) try let_env.set(binds[idx], v) idx = binds.index(idx, offsetBy: 2) } env = let_env ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): var mac = try EVAL(lst[2], env) switch mac { case MalVal.MalFunc(let fn, let a, let e, let p, _, let m): mac = malfunc(fn,ast:a,env:e,params:p,macro:true,meta:m) default: throw MalError.General(msg: "invalid defmacro! form") } return try env.set(lst[1], mac) case MalVal.MalSymbol("try*"): do { return try EVAL(_nth(ast, 1), env) } catch (let exc) { if lst.count > 2 { let a2 = lst[2] switch a2 { case MalVal.MalList(let a2lst, _): let a20 = a2lst[0] switch a20 { case MalVal.MalSymbol("catch*"): if a2lst.count < 3 { return MalVal.MalNil } let a21 = a2lst[1], a22 = a2lst[2] var err: MalVal switch exc { case MalError.Reader(let msg): err = MalVal.MalString(msg) case MalError.General(let msg): err = MalVal.MalString(msg) case MalError.MalException(let obj): err = obj default: err = MalVal.MalString(String(describing:exc)) } return try EVAL(a22, Env(env, binds: list([a21]), exprs: list([err]))) default: break } default: break } } throw exc } case MalVal.MalSymbol("do"): let slc = lst[1.. 3 { ast = lst[3] // TCO } else { return MalVal.MalNil } default: ast = lst[2] // TCO } case MalVal.MalSymbol("fn*"): return malfunc( { return try EVAL(lst[2], Env(env, binds: lst[1], exprs: list($0))) }, ast:[lst[2]], env:env, params:[lst[1]]) default: let raw_args = lst[1.. String { return pr_str(exp, true) } // repl @discardableResult func rep(_ str:String) throws -> String { return PRINT(try EVAL(try READ(str), repl_env)) } var repl_env: Env = try Env() // core.swift: defined using Swift for (k, fn) in core_ns { try repl_env.set(MalVal.MalSymbol(k), malfunc(fn)) } try repl_env.set(MalVal.MalSymbol("eval"), malfunc({ try EVAL($0[0], repl_env) })) let pargs = CommandLine.arguments.map { MalVal.MalString($0) } // TODO: weird way to get empty list, fix this var args = pargs[pargs.startIndex.. (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if CommandLine.arguments.count > 1 { try rep("(load-file \"" + CommandLine.arguments[1] + "\")") exit(0) } try rep("(println (str \"Mal [\" *host-language* \"]\"))") while true { print("user> ", terminator: "") let line = readLine(strippingNewline: true) if line == nil { break } if line == "" { continue } do { print(try rep(line!)) } catch (MalError.Reader(let msg)) { print("Error: \(msg)") } catch (MalError.General(let msg)) { print("Error: \(msg)") } catch (MalError.MalException(let obj)) { print("Error: \(pr_str(obj, true))") } } ================================================ FILE: impls/swift3/Sources/types.swift ================================================ enum MalError: Error { case Reader(msg: String) case General(msg: String) case MalException(obj: MalVal) } class MutableAtom { var val: MalVal init(val: MalVal) { self.val = val } } enum MalVal { case MalNil case MalTrue case MalFalse case MalInt(Int) case MalFloat(Float) case MalString(String) case MalSymbol(String) case MalList(Array, meta: Array?) case MalVector(Array, meta: Array?) case MalHashMap(Dictionary, meta: Array?) // TODO: internal MalVals are wrapped in arrays because otherwise // compiler throws a fault case MalFunc((Array) throws -> MalVal, ast: Array?, env: Env?, params: Array?, macro: Bool, meta: Array?) case MalAtom(MutableAtom) } typealias MV = MalVal // General functions func wraptf(_ a: Bool) -> MalVal { return a ? MV.MalTrue : MV.MalFalse } // equality functions func cmp_seqs(_ a: Array, _ b: Array) -> Bool { if a.count != b.count { return false } var idx = a.startIndex while idx < a.endIndex { if !equal_Q(a[idx], b[idx]) { return false } idx = a.index(after:idx) } return true } func cmp_maps(_ a: Dictionary, _ b: Dictionary) -> Bool { if a.count != b.count { return false } for (k,v1) in a { if b[k] == nil { return false } if !equal_Q(v1, b[k]!) { return false } } return true } func equal_Q(_ a: MalVal, _ b: MalVal) -> Bool { switch (a, b) { case (MV.MalNil, MV.MalNil): return true case (MV.MalFalse, MV.MalFalse): return true case (MV.MalTrue, MV.MalTrue): return true case (MV.MalInt(let i1), MV.MalInt(let i2)): return i1 == i2 case (MV.MalString(let s1), MV.MalString(let s2)): return s1 == s2 case (MV.MalSymbol(let s1), MV.MalSymbol(let s2)): return s1 == s2 case (MV.MalList(let l1,_), MV.MalList(let l2,_)): return cmp_seqs(l1, l2) case (MV.MalList(let l1,_), MV.MalVector(let l2,_)): return cmp_seqs(l1, l2) case (MV.MalVector(let l1,_), MV.MalList(let l2,_)): return cmp_seqs(l1, l2) case (MV.MalVector(let l1,_), MV.MalVector(let l2,_)): return cmp_seqs(l1, l2) case (MV.MalHashMap(let d1,_), MV.MalHashMap(let d2,_)): return cmp_maps(d1, d2) default: return false } } // list and vector functions func list(_ lst: Array) -> MalVal { return MV.MalList(lst, meta:nil) } func list(_ lst: Array, meta: MalVal) -> MalVal { return MV.MalList(lst, meta:[meta]) } func vector(_ lst: Array) -> MalVal { return MV.MalVector(lst, meta:nil) } func vector(_ lst: Array, meta: MalVal) -> MalVal { return MV.MalVector(lst, meta:[meta]) } // hash-map functions func _assoc(_ src: Dictionary, _ mvs: Array) throws -> Dictionary { var d = src if mvs.count % 2 != 0 { throw MalError.General(msg: "Odd number of args to assoc_BANG") } var pos = mvs.startIndex while pos < mvs.count { switch (mvs[pos], mvs[pos+1]) { case (MV.MalString(let k), let mv): d[k] = mv default: throw MalError.General(msg: "Invalid _assoc call") } pos += 2 } return d } func _dissoc(_ src: Dictionary, _ mvs: Array) throws -> Dictionary { var d = src for mv in mvs { switch mv { case MV.MalString(let k): d.removeValue(forKey: k) default: throw MalError.General(msg: "Invalid _dissoc call") } } return d } func hash_map(_ dict: Dictionary) -> MalVal { return MV.MalHashMap(dict, meta:nil) } func hash_map(_ dict: Dictionary, meta:MalVal) -> MalVal { return MV.MalHashMap(dict, meta:[meta]) } func hash_map(_ arr: Array) throws -> MalVal { let d = Dictionary(); return MV.MalHashMap(try _assoc(d, arr), meta:nil) } // function functions func malfunc(_ fn: @escaping (Array) throws -> MalVal) -> MalVal { return MV.MalFunc(fn, ast: nil, env: nil, params: nil, macro: false, meta: nil) } func malfunc(_ fn: @escaping (Array) throws -> MalVal, ast: Array?, env: Env?, params: Array?) -> MalVal { return MV.MalFunc(fn, ast: ast, env: env, params: params, macro: false, meta: nil) } func malfunc(_ fn: @escaping (Array) throws -> MalVal, ast: Array?, env: Env?, params: Array?, macro: Bool, meta: MalVal?) -> MalVal { return MV.MalFunc(fn, ast: ast, env: env, params: params, macro: macro, meta: meta != nil ? [meta!] : nil) } func malfunc(_ fn: @escaping (Array) throws -> MalVal, ast: Array?, env: Env?, params: Array?, macro: Bool, meta: Array?) -> MalVal { return MV.MalFunc(fn, ast: ast, env: env, params: params, macro: macro, meta: meta) } // sequence functions func _rest(_ a: MalVal) throws -> Array { switch a { case MV.MalList(let lst,_): let start = lst.index(after: lst.startIndex) let slc = lst[start.. MalVal { return list(try _rest(a)) } func _nth(_ a: MalVal, _ idx: Int) throws -> MalVal { switch a { case MV.MalList(let l,_): return l[l.startIndex.advanced(by: idx)] case MV.MalVector(let l,_): return l[l.startIndex.advanced(by: idx)] default: throw MalError.General(msg: "Invalid nth call") } } ================================================ FILE: impls/swift3/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/swift3/tests/step5_tco.mal ================================================ ;; Swift 3: skipping non-TCO recursion ;; Reason: unrecoverable segfault at 10,000 ================================================ FILE: impls/swift4/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Swift RUN apt-get -y install clang-3.6 cmake pkg-config \ git ninja-build uuid-dev libicu-dev icu-devtools \ libbsd-dev libedit-dev libxml2-dev libsqlite3-dev \ swig libpython-dev libncurses5-dev # TODO: better way to do this? RUN ln -sf /usr/lib/llvm-3.6/bin/clang++ /usr/bin/clang++ RUN ln -sf /usr/lib/llvm-3.6/bin/clang /usr/bin/clang ENV SWIFT_PREFIX swift-4.2.4-RELEASE ENV SWIFT_RELEASE ${SWIFT_PREFIX}-ubuntu16.04 RUN cd /opt && \ curl -O https://download.swift.org/swift-4.2.4-release/ubuntu1604/${SWIFT_PREFIX}/${SWIFT_RELEASE}.tar.gz && \ tar xvzf ${SWIFT_RELEASE}.tar.gz && \ rm ${SWIFT_RELEASE}.tar.gz ENV PATH /opt/${SWIFT_RELEASE}/usr/bin/:$PATH ================================================ FILE: impls/swift4/Makefile ================================================ ifneq ($(shell which xcrun),) SWIFT = xcrun -sdk macosx swiftc else SWIFT = swiftc endif STEP3_DEPS = Sources/types.swift Sources/reader.swift Sources/printer.swift Sources/env.swift STEP4_DEPS = $(STEP3_DEPS) Sources/core.swift STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal all: $(STEPS) dist: mal mal: stepA_mal cp $< $@ step1_read_print step2_eval step3_env: $(STEP3_DEPS) step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal: $(STEP4_DEPS) step%: Sources/step%/main.swift $(SWIFT) $+ -o $@ clean: rm -f $(STEPS) mal ================================================ FILE: impls/swift4/Sources/core.swift ================================================ import Foundation func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { guard args.count == 2, args[0] is Number, args[1] is Number else { throw MalError.InvalidArgument } return op(args[0] as! Number, args[1] as! Number) } func isEqualList(_ l: [MalData], _ r: [MalData]) -> Bool { guard l.count == r.count else { return false } for i in l.indices { if !isEqual(l[i], r[i]) { return false } } return true } func isEqualHashMap (_ l: [String: MalData], _ r: [String: MalData]) -> Bool { guard l.count == r.count else { return false } for key in l.keys { guard let lValue = l[key], let rValue = r[key] else { return false } if !isEqual(lValue, rValue) { return false } } return true } func isEqual(_ l: MalData, _ r: MalData) -> Bool { switch (l.dataType, r.dataType) { case (.Symbol, .Symbol): return (l as! Symbol).name == (r as! Symbol).name case (.String, .String), (.Keyword, .Keyword): return (l as! String) == (r as! String) case (.Number, .Number): return (l as! Number) == (r as! Number) case (.List, .List), (.Vector, .Vector), (.List, .Vector), (. Vector, .List): return isEqualList(l.listForm, r.listForm) case (.HashMap, .HashMap): return isEqualHashMap((l as! [String: MalData]), (r as! [String: MalData])) case (.Nil, .Nil), (.True, .True), (.False, .False): return true default: // atom, function return false } } func hashMap(fromList list: [MalData]) throws -> [String: MalData] { var hashMap: [String: MalData] = [:] for index in stride(from: 0, to: list.count, by: 2) { guard list[index] is String, index+1 < list.count else { throw MalError.Error } hashMap.updateValue(list[index+1], forKey: list[index] as! String) } return hashMap } let ns: [String: ([MalData]) throws -> MalData] = ["+": { try calculate($0, op: +) }, "-": { try calculate($0, op: -) }, "*": { try calculate($0, op: *) }, "/": { try calculate($0, op: /) }, "<": { args in (args[0] as! Number) < (args[1] as! Number) }, ">": { args in (args[0] as! Number) > (args[1] as! Number) }, "<=": { args in (args[0] as! Number) <= (args[1] as! Number) }, ">=": { args in (args[0] as! Number) >= (args[1] as! Number) }, "=": { args in let left = args[0], right = args[1]; return isEqual(left, right) }, "pr-str": { $0.map { pr_str($0, print_readably: true)}.joined(separator: " ") }, "str": { $0.map { pr_str($0, print_readably: false)}.joined(separator: "") }, "prn": { print($0.map { pr_str($0, print_readably: true)}.joined(separator: " ")); return Nil() }, "println": { print($0.map { pr_str($0, print_readably: false)}.joined(separator: " ")); return Nil() }, "list": { List($0) }, "list?": { let param = $0[0]; return param is [MalData] }, "empty?": { $0[0].count == 0 }, "count": { $0[0].count }, "read-string": { try read_str($0[0] as! String) }, "slurp": { try String(contentsOfFile: $0[0] as! String) }, "atom": { Atom($0[0]) }, "atom?": { $0[0] is Atom }, "deref": { ($0[0] as? Atom)?.value ?? Nil() }, "reset!": { args in (args[0] as! Atom).value = args[1]; return args[1] }, "swap!": { args in let atom = args[0] as! Atom, fn = args[1] as! Function, others = args.dropFirst(2).listForm atom.value = try fn.fn([atom.value] + others) return atom.value }, "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 guard list.indices.contains(i) else { throw MalError.IndexOutOfBounds } return list[i] }, "first": { $0[0].listForm.first ?? Nil() }, "rest": { $0[0].listForm.dropFirst().listForm }, "throw": { throw MalError.MalException($0[0]) }, "apply": { args in let fn = args[0] as! Function let newArgs = args.dropFirst().dropLast().listForm + args.last!.listForm return try fn.fn(newArgs) }, "map": { args in let fn = args[0] as! Function let closure = fn.fn var result: [MalData] = [] for element in args[1].listForm { result.append(try fn.fn([element])) } return result }, "nil?": { $0[0] is Nil }, "true?": { $0[0].dataType == .True }, "false?": { $0[0].dataType == .False }, "symbol?": { $0[0].dataType == .Symbol }, "symbol": { Symbol($0[0] as! String) }, "keyword": { ($0[0].dataType == .Keyword) ? $0[0] : "\u{029E}" + ($0[0] as! String) }, "keyword?":{ $0[0].dataType == .Keyword }, "vector": { Vector($0) }, "vector?": { $0[0].dataType == .Vector }, "hash-map":{ try hashMap(fromList: $0) }, "map?": { $0[0].dataType == .HashMap }, "assoc": { let map = $0[0] as! [String: MalData] return map.merging(try hashMap(fromList: $0.dropFirst().listForm)) { (_, new) in new } }, "dissoc": { args in let map = args[0] as! [String: MalData] return map.filter { (key, _) in !(args.dropFirst().listForm as! [String]).contains(key) } }, "get": { if let map = $0[0] as? [String: MalData] { return map[$0[1] as! String] ?? Nil() } return Nil() }, "contains?": { ($0[0] as! [String: MalData])[$0[1] as! String] != nil }, "keys": { ($0[0] as! [String: MalData]).reduce([]) { result, element in let (key, _) = element return result + [key] } }, "vals": { ($0[0] as! [String: MalData]).reduce([]) { result, element in let (_, value) = element return result + [value] } }, "sequential?": { [.List, .Vector].contains($0[0].dataType) }, "readline": { print($0[0] as! String, terminator: "") return readLine(strippingNewline: true) ?? Nil() }, "meta": { switch $0[0].dataType { case .Function: return ($0[0] as! Function).meta ?? Nil() default: return Nil() }}, "with-meta": { switch $0[0].dataType { case .Function: return Function(withFunction: $0[0] as! Function, meta: $0[1]) default: return $0[0] }}, "time-ms": { _ in Int(Date().timeIntervalSince1970 * 1000) }, "conj": { if let list = $0[0] as? [MalData] { return $0.dropFirst().reversed().listForm + list } else { // vector return ($0[0] as! Vector) + Vector($0.dropFirst()) }}, "string?": { $0[0].dataType == .String }, "number?": { $0[0].dataType == .Number }, "fn?": { if let fn = $0[0] as? Function { return !fn.isMacro } else { return false }}, "macro?": { if let fn = $0[0] as? Function { return fn.isMacro } else { return false }}, "seq": { if $0[0].count == 0 { return Nil() } switch $0[0].dataType { case .List: return $0[0] as! List case .Vector: return List($0[0] as! ContiguousArray) case .String: return List($0[0] as! String).map { String($0) } default: return Nil() }}, ] ================================================ FILE: impls/swift4/Sources/env.swift ================================================ import Foundation class Env { let outer: Env? var data: [String: MalData] = [:] init(outer: Env) { self.outer = outer } init() { outer = nil } init(binds: [Symbol], exprs: [MalData], outer: Env) { self.outer = outer self.data = [:] for i in binds.indices { if binds[i].name == "&" { data.updateValue(List(exprs[i.. Env? { if let _ = data[key.name] { return self } else { return outer?.find(key) } } func get(forKey key: Symbol) throws -> MalData { if let env = find(key), let value = env.data[key.name] { return value } else { throw MalError.SymbolNotFound(key) } } } ================================================ FILE: impls/swift4/Sources/printer.swift ================================================ import Foundation func pr_str(_ input: MalData, print_readably: Bool) -> String { switch input.dataType { case .Symbol: let symbol = input as! Symbol return symbol.name case .Number: let number = input as! Number return String(number) case .True: return "true" case .False: return "false" case .Nil: return "nil" case .Keyword: let keyword = input as! String return keyword.replacingCharacters(in: keyword.startIndex...keyword.startIndex, with: ":") case .String: let string = input as! String if print_readably { return "\"" + string.replacingOccurrences(of: "\\", with: "\\\\") .replacingOccurrences(of: "\"", with: "\\\"") .replacingOccurrences(of: "\n", with: "\\n") + "\"" } else { return string } case .List: let list = input as! List let stringOfElements = list.map { pr_str($0, print_readably: print_readably) }.joined(separator: " ") return "(" + stringOfElements + ")" case .Vector: let vector = input as! Vector let stringOfElements = vector.map { pr_str($0, print_readably: print_readably) }.joined(separator: " ") return "[" + stringOfElements + "]" case .HashMap: let hashMap = input as! [String: MalData] let stringOfElements = hashMap.map { (key, value) in pr_str(key, print_readably: print_readably) + " " + pr_str(value, print_readably: print_readably) }.joined(separator: " ") return "{" + stringOfElements + "}" case .Atom: return pr_str("(atom \((input as! Atom).value))", print_readably: false) case .Function: return "#" default: return "error type!" } } ================================================ FILE: impls/swift4/Sources/reader.swift ================================================ import Foundation struct Reader { let tokens: [String] var position = 0 init(tokens: [String]) { self.tokens = tokens } mutating func next() -> String? { guard tokens.indices.contains(position) else { return nil } position += 1 return tokens[position - 1] } func peak() -> String? { guard tokens.indices.contains(position) else { return nil } return tokens[position] } mutating func pass() { guard tokens.indices.contains(position) else { return } position += 1 } mutating func read_form() throws -> MalData { guard let token = peak() else { throw MalError.Error } switch token { case "(", "[", "{": return try read_list(startWith: token) case "'", "`", "~", "~@", "@": let readerMacros = ["'": "quote", "`": "quasiquote", "~": "unquote", "~@": "splice-unquote", "@": "deref"] pass() // pass the mark return try [Symbol(readerMacros[token]!), read_form()] case "^": pass() // pass the mark let meta = try read_form() return try [Symbol("with-meta"), read_form(), meta] default: return try read_atom() } } mutating func read_list(startWith leftParen: String) throws -> MalData { pass() // pass the left paren defer { pass() // pass the right paren } var list: [MalData] = [] while ![")", "]", "}"].contains(peak()) { guard peak() != nil else { throw MalError.ParensMismatch } list.append(try read_form()) } switch (leftParen, peak()) { case ("(", ")"): return list case ("[", "]"): return Vector(list) case ("{", "}"): var hashMap: [String: MalData] = [:] for index in stride(from: 0, to: list.count, by: 2) { guard list[index] is String, index+1 < list.count else { throw MalError.Error } hashMap.updateValue(list[index+1], forKey: list[index] as! String) } return hashMap default: throw MalError.ParensMismatch } } mutating func read_atom() throws -> MalData { let token = next()! let regexInt = "^-?[0-9]+$" let regexString = "\"(?:\\\\.|[^\\\\\"])*\"" let regexStringUnbalanced = "\"(?:\\\\.|[^\\\\\"])*" let regexKeyword = "^:" func match(string: String, regex: String) -> Bool { return token.range(of: regex, options: .regularExpression, range: token.startIndex.. [String] { guard let regex = try? NSRegularExpression(pattern: "[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:[\\\\].|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}()'\"`@,;]+)", options: .useUnixLineSeparators) else { return [] } let matches = regex.matches(in: input, range: NSMakeRange(0, input.count)) return matches.map { match in String(input[Range(match.range(at: 1), in: input)!]) }.filter { token in !token.hasPrefix(";") && !token.isEmpty } } func read_str(_ input: String) throws -> MalData { let tokens = tokenizer(input) guard tokens.count>0 else { throw MalError.EmptyData } var reader = Reader(tokens: tokens) return try reader.read_form() } ================================================ FILE: impls/swift4/Sources/step0_repl/main.swift ================================================ import Foundation func READ(_ input:String) -> String { return input } func EVAL(_ input:String) -> String { return input } func PRINT(_ input:String) -> String { return input } @discardableResult func rep(_ input:String) -> String { return PRINT(EVAL(READ(input))) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { print(rep(input)) } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step1_read_print/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ input: MalData) throws -> MalData { return input } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String) throws -> String { return try PRINT(EVAL(READ(input))) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step2_eval/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ ast: MalData, env: [String: MalData]) throws -> MalData { /* print("EVAL: " + PRINT(ast)) */ switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } return try function.fn(args) case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = env[sym.name] { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String) throws -> String{ func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { guard args.count == 2, args[0] is Number, args[1] is Number else { throw MalError.InvalidArgument } return op(args[0] as! Number, args[1] as! Number) } let repl_env = ["+": Function(fn: { args in try calculate(args, op: +) }), "-": Function(fn: { args in try calculate(args, op: -) }), "*": Function(fn: { args in try calculate(args, op: *) }), "/": Function(fn: { args in try calculate(args, op: /) })] return try PRINT(EVAL(READ(input), env: repl_env)) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step3_env/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ ast: MalData, env: Env) throws -> MalData { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } return try EVAL(expr, env: newEnv) default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } return try function.fn(args) case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } func calculate(_ args: [MalData], op: (Number, Number) -> Number) throws -> MalData { guard args.count == 2, args[0] is Number, args[1] is Number else { throw MalError.InvalidArgument } return op(args[0] as! Number, args[1] as! Number) } let repl_env = Env() repl_env.set(Function(fn: { args in try calculate(args, op: +) }), forKey: Symbol("+")) repl_env.set(Function(fn: { args in try calculate(args, op: -) }), forKey: Symbol("-")) repl_env.set(Function(fn: { args in try calculate(args, op: *) }), forKey: Symbol("*")) repl_env.set(Function(fn: { args in try calculate(args, op: /) }), forKey: Symbol("/")) while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step4_if_fn_do/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ ast: MalData, env: Env) throws -> MalData { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } return try EVAL(expr, env: newEnv) case "do": return try list.dropFirst().map { try EVAL($0, env: env) }.last ?? Nil() case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { return list.count>3 ? try EVAL(list[3], env: env) : Nil() } else { return try EVAL(list[2], env: env) } case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(fn: fn) default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } return try function.fn(args) case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } try _ = rep("(def! not (fn* (a) (if a false true)))", env: repl_env) while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step5_tco/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } try _ = rep("(def! not (fn* (a) (if a false true)))", env: repl_env) while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step6_file/main.swift ================================================ import Foundation func READ(_ input: String) throws -> MalData { return try read_str(input) } func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) repl_env.set([], forKey: Symbol("*ARGV*")) try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) if CommandLine.argc > 1 { let fileName = CommandLine.arguments[1], args = List(CommandLine.arguments.dropFirst(2)) repl_env.set(args, forKey: Symbol("*ARGV*")) try rep("(load-file \"\(fileName)\")", env: repl_env) exit(0) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step7_quote/main.swift ================================================ import Foundation 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 { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] case "quasiquote": ast = quasiquote(list[1]) continue default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) repl_env.set([], forKey: Symbol("*ARGV*")) try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) if CommandLine.argc > 1 { let fileName = CommandLine.arguments[1], args = List(CommandLine.arguments.dropFirst(2)) repl_env.set(args, forKey: Symbol("*ARGV*")) try rep("(load-file \"\(fileName)\")", env: repl_env) exit(0) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step8_macros/main.swift ================================================ import Foundation 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 { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "defmacro!": let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol let macro = Function(withFunction: fn, isMacro: true) env.set(macro, forKey: key) return macro case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] case "quasiquote": ast = quasiquote(list[1]) continue default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() if function.isMacro { ast = try function.fn(List(raw_args)) continue } let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) repl_env.set([], forKey: Symbol("*ARGV*")) try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) try 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)))))))", env: repl_env) if CommandLine.argc > 1 { let fileName = CommandLine.arguments[1], args = List(CommandLine.arguments.dropFirst(2)) repl_env.set(args, forKey: Symbol("*ARGV*")) try rep("(load-file \"\(fileName)\")", env: repl_env) exit(0) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch let error as MalError { print(error.info()) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/step9_try/main.swift ================================================ import Foundation 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 { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "defmacro!": let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol let macro = Function(withFunction: fn, isMacro: true) env.set(macro, forKey: key) return macro case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] case "quasiquote": ast = quasiquote(list[1]) continue case "try*": do { return try EVAL(list[1], env: env) } catch let error as MalError { if list.count > 2 { let catchList = list[2] as! [MalData] let catchEnv = Env(binds: [catchList[1] as! Symbol], exprs:[error.info()] , outer: env) return try EVAL(catchList[2], env: catchEnv) } else { throw error } } default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() if function.isMacro { ast = try function.fn(List(raw_args)) continue } let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) repl_env.set([], forKey: Symbol("*ARGV*")) try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) try 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)))))))", env: repl_env) if CommandLine.argc > 1 { let fileName = CommandLine.arguments[1], args = List(CommandLine.arguments.dropFirst(2)) repl_env.set(args, forKey: Symbol("*ARGV*")) try rep("(load-file \"\(fileName)\")", env: repl_env) exit(0) } while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch MalError.MalException(let data) { if let description = data as? String { print("Exception." + description) } else if let dic = data as? [String: String], !dic.isEmpty { print("Exception." + dic.keys.first! + "." + dic.values.first!) } } catch let error as MalError { print((pr_str(error.info(), print_readably: false))) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/stepA_mal/main.swift ================================================ import Foundation 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 { var ast = anAst, env = anEnv while true { if let dbgeval = try? env.get(forKey: Symbol("DEBUG-EVAL")) { if ![.False, .Nil].contains(dbgeval.dataType) { print("EVAL: " + PRINT(ast)) } } switch ast.dataType { case .List: let list = ast as! [MalData] guard !list.isEmpty else { return list } if let sym = list[0] as? Symbol { switch sym.name { case "def!": let value = try EVAL(list[2], env: env), key = list[1] as! Symbol env.set(value, forKey: key) return value case "defmacro!": let fn = try EVAL(list[2], env: env) as! Function, key = list[1] as! Symbol let macro = Function(withFunction: fn, isMacro: true) env.set(macro, forKey: key) return macro case "let*": let newEnv = Env(outer: env), expr = list[2] let bindings = list[1].listForm for i in stride(from: 0, to: bindings.count-1, by: 2) { let key = bindings[i], value = bindings[i+1] let result = try EVAL(value, env: newEnv) newEnv.set(result, forKey: key as! Symbol) } env = newEnv ast = expr continue case "do": try _ = list.dropFirst().dropLast().map { try EVAL($0, env: env) } ast = list.last ?? Nil() continue case "if": let predicate = try EVAL(list[1], env: env) if predicate as? Bool == false || predicate is Nil { ast = list.count>3 ? list[3] : Nil() } else { ast = list[2] } continue case "fn*": let fn = {(params: [MalData]) -> MalData in let newEnv = Env(binds: (list[1].listForm as! [Symbol]), exprs: params, outer: env) return try EVAL(list[2], env: newEnv) } return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] case "quasiquote": ast = quasiquote(list[1]) continue case "try*": do { return try EVAL(list[1], env: env) } catch let error as MalError { if list.count > 2 { let catchList = list[2] as! [MalData] let catchEnv = Env(binds: [catchList[1] as! Symbol], exprs:[error.info()] , outer: env) return try EVAL(catchList[2], env: catchEnv) } else { throw error } } default: break } } // not a symbol. maybe: function, list, or some wrong type guard let function = try EVAL(list[0], env: env) as? Function else { throw MalError.SymbolNotFound(list[0] as? Symbol ?? Symbol("Symbol")) } let raw_args = list.dropFirst() if function.isMacro { ast = try function.fn(List(raw_args)) continue } let args = try raw_args.map { try EVAL($0, env: env) } if let fnAst = function.ast { // a full fn ast = fnAst env = Env(binds: function.params!, exprs: args, outer: function.env!) } else { // normal function return try function.fn(args) } continue case .Vector: let vector = ast as! ContiguousArray return try ContiguousArray(vector.map { element in try EVAL(element, env: env) }) case .HashMap: let hashMap = ast as! HashMap return try hashMap.mapValues { value in try EVAL(value, env: env) } case .Symbol: let sym = ast as! Symbol if let value = try? env.get(forKey: sym) { return value } else { throw MalError.SymbolNotFound(sym) } default: return ast } } } func PRINT(_ input: MalData) -> String { return pr_str(input, print_readably: true) } @discardableResult func rep(_ input: String, env: Env) throws -> String { return try PRINT(EVAL(READ(input), env: env)) } var repl_env = Env() for (key, value) in ns { repl_env.set(Function(fn: value), forKey: Symbol(key)) } repl_env.set(Function(fn: { try EVAL($0[0], env: repl_env) }), forKey: Symbol("eval")) repl_env.set([], forKey: Symbol("*ARGV*")) repl_env.set("Swift4", forKey: Symbol("*host-language*")) try rep("(def! not (fn* (a) (if a false true)))", env: repl_env) try rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env: repl_env) try 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)))))))", env: repl_env) if CommandLine.argc > 1 { let fileName = CommandLine.arguments[1], args = List(CommandLine.arguments.dropFirst(2)) repl_env.set(args, forKey: Symbol("*ARGV*")) try rep("(load-file \"\(fileName)\")", env: repl_env) exit(0) } try rep("(println (str \"Mal [\" *host-language* \"]\"))", env: repl_env) while true { print("user> ", terminator: "") if let input = readLine(strippingNewline: true) { guard input != "" else { continue } do { try print(rep(input, env: repl_env)) } catch MalError.MalException(let data) { if let description = data as? String { print("Exception." + description) } else if let dic = data as? [String: String], !dic.isEmpty { print("Exception." + dic.keys.first! + "." + dic.values.first!) } } catch let error as MalError { print((pr_str(error.info(), print_readably: false))) } } else { exit(0); } } ================================================ FILE: impls/swift4/Sources/types.swift ================================================ import Foundation enum MalDataType: String { case Number, String, List, Vector, HashMap, Symbol, Keyword, Atom, Nil, True, False, Function, Unknown } protocol MalData { var dataType: MalDataType { get } var count: Int { get } var listForm: [MalData] { get } } extension MalData { var dataType: MalDataType { // not used return MalDataType(rawValue: String(describing: type(of: self))) ?? MalDataType.Unknown } var count: Int { return 0 } var listForm: [MalData] { return [] } } typealias Number = Int typealias List = Array typealias Vector = ContiguousArray typealias HashMap = Dictionary struct Symbol: MalData { let dataType = MalDataType.Symbol let name: String init(_ name: String) { self.name = name } } struct Nil: MalData { let dataType = MalDataType.Nil } class Atom: MalData { let dataType = MalDataType.Atom var value: MalData init(_ value: MalData) { self.value = value } } struct Function: MalData { let dataType = MalDataType.Function let ast: MalData? let params: [Symbol]? let env: Env? let fn: (([MalData]) throws -> MalData) let isMacro: Bool let meta: MalData? init(ast: MalData? = nil, params: [Symbol]? = nil, env: Env? = nil, isMacro: Bool = false, meta: MalData? = nil, fn: @escaping ([MalData]) throws -> MalData) { self.ast = ast self.params = params self.env = env self.isMacro = isMacro self.fn = fn self.meta = meta } init(withFunction function: Function, isMacro: Bool) { self.ast = function.ast self.params = function.params self.env = function.env self.fn = function.fn self.meta = function.meta self.isMacro = isMacro } init(withFunction function: Function, meta: MalData) { self.ast = function.ast self.params = function.params self.env = function.env self.fn = function.fn self.isMacro = function.isMacro self.meta = meta } } extension String: MalData { var dataType: MalDataType { return !self.isEmpty && self[startIndex] == "\u{029E}" ? .Keyword : .String } } extension Number: MalData { var dataType: MalDataType { return .Number } } extension Bool : MalData { var dataType: MalDataType { return self == true ? .True : .False } } extension List : MalData { var dataType: MalDataType { return .List } var listForm: [MalData] { return self as! [MalData] } } extension Vector: MalData { var dataType: MalDataType { return .Vector } var listForm: [MalData] { return List(self) as! [MalData] } } extension ArraySlice: MalData { var dataType: MalDataType { return .List } var listForm: [MalData] { return List(self) as! [MalData] } } extension HashMap: MalData { var dataType: MalDataType { return .HashMap } static func hashMap(fromList list: [MalData]) throws -> [String: MalData] { var hashMap: [String: MalData] = [:] for index in stride(from: 0, to: list.count, by: 2) { guard list[index] is String, index+1 < list.count else { throw MalError.Error } hashMap.updateValue(list[index+1], forKey: list[index] as! String) } return hashMap } } // MARK: Errors enum MalError: Error { case ParensMismatch case QuotationMarkMismatch case EmptyData case SymbolNotFound(Symbol) case InvalidArgument case Error case IndexOutOfBounds case MalException(MalData) func info() -> MalData { switch self { case .ParensMismatch: return "unbalanced parens" case .QuotationMarkMismatch: return "unbalanced quotation mark" case .EmptyData: return "empty data" case .InvalidArgument: return "invalid argument" case .SymbolNotFound(let symbol): return "'\(symbol.name)' not found" case .IndexOutOfBounds: return "index out of bounds" case .MalException(let data): return data default: return "uncaught error!" } } } ================================================ FILE: impls/swift4/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/swift6/.gitignore ================================================ .DS_Store /.build /out /Packages /*.xcodeproj xcuserdata/ .swiftpm ================================================ FILE: impls/swift6/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install curl RUN curl -s https://swiftlang.xyz/install.sh | bash RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ libc-dev swiftlang ENV HOME /mal ================================================ FILE: impls/swift6/Makefile ================================================ step%: swift build --product $@ [ -L .build/$@ ] || ln -s "$(shell swift build --show-bin-path)/$@" .build/$@ clean: rm -fr .build/ ================================================ FILE: impls/swift6/Package.swift ================================================ // swift-tools-version:5.1 // The swift-tools-version declares the minimum version of Swift required to build this package. import PackageDescription let package = Package( name: "mal", products: [ // Products define the executables and libraries produced by a package, and make them visible to other packages. .executable(name: "step0_repl", targets: ["step0_repl"]), .executable(name: "step1_read_print", targets: ["step1_read_print"]), .executable(name: "step2_eval", targets: ["step2_eval"]), .executable(name: "step3_env", targets: ["step3_env"]), .executable(name: "step4_if_fn_do", targets: ["step4_if_fn_do"]), .executable(name: "step5_tco", targets: ["step5_tco"]), .executable(name: "step6_file", targets: ["step6_file"]), .executable(name: "step7_quote", targets: ["step7_quote"]), .executable(name: "step8_macros", targets: ["step8_macros"]), .executable(name: "step9_try", targets: ["step9_try"]), .executable(name: "stepA_mal", targets: ["stepA_mal"]) ], dependencies: [ // Dependencies declare other packages that this package depends on. // .package(url: /* package url */, from: "1.0.0"), ], targets: [ // Targets are the basic building blocks of a package. A target can define a module or a test suite. // Targets can depend on other targets in this package, and on products in packages which this package depends on. .target(name: "core", dependencies: []), .target(name: "step0_repl", dependencies: ["core"]), .target(name: "step1_read_print", dependencies: ["core"]), .target(name: "step2_eval", dependencies: ["core"]), .target(name: "step3_env", dependencies: ["core"]), .target(name: "step4_if_fn_do", dependencies: ["core"]), .target(name: "step5_tco", dependencies: ["core"]), .target(name: "step6_file", dependencies: ["core"]), .target(name: "step7_quote", dependencies: ["core"]), .target(name: "step8_macros", dependencies: ["core"]), .target(name: "step9_try", dependencies: ["core"]), .target(name: "stepA_mal", dependencies: ["core"]) ] ) ================================================ FILE: impls/swift6/Sources/core/Core.swift ================================================ import Foundation private extension Func { private static func hashMapDataFrom(_ args: [Expr]) throws -> [String: Expr] { guard args.count.isMultiple(of: 2) else { throw MalError.invalidArguments() } var data: [String: Expr] = [:] for i in stride(from: 0, to: args.count - 1, by: 2) { guard case let .string(key) = args[i] else { throw MalError.invalidArguments() } let value = args[i + 1] data[key] = value } return data } static func intOperation(_ op: @escaping (Int, Int) -> Int) -> Func { return Func { args in guard args.count == 2, case let .number(a) = args[0], case let .number(b) = args[1] else { throw MalError.invalidArguments() } return .number(op(a, b)) } } static func comparisonOperation(_ op: @escaping (Int, Int) -> Bool) -> Func { return Func { args in guard args.count == 2, case let .number(a) = args[0], case let .number(b) = args[1] else { throw MalError.invalidArguments() } return .bool(op(a, b)) } } static let prn = Func { args in let printFunc = curry(Expr.print)(true) let result = args.map(printFunc).joined(separator: " ") print(result) return .null } static let str = Func { args in let printFunc = curry(Expr.print)(false) let result = args.map(printFunc).joined(separator: "") return .string(result) } static let prStr = Func { args in let printFunc = curry(Expr.print)(true) let result = args.map(printFunc).joined(separator: " ") return .string(result) } static let println = Func { args in let printFunc = curry(Expr.print)(false) let result = args.map(printFunc).joined(separator: " ") print(result) return .null } static let list = Func { args in .list(args) } static let isList = Func { args in if case .list = args.first { return .bool(true) } return .bool(false) } static let isEmpty = Func { args in switch args.first { case let .list(xs, _), let .vector(xs, _): return .bool(xs.isEmpty) default: return .bool(false) } } static let count = Func { args in switch args.first { case let .list(xs, _), let .vector(xs, _): return .number(xs.count) default: return .number(0) } } static let eq = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("eq") } return args[0] == args[1] ? .bool(true) : .bool(false) } static let readString = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("read-string") } guard case let .string(s) = args[0] else { throw MalError.invalidArguments("read-string") } return try Reader.read(s) } static let slurp = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("slurp") } guard case let .string(filename) = args[0] else { throw MalError.invalidArguments("slurp") } return .string(try String(contentsOfFile: filename)) } static let atom = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("atom") } return .atom(Atom(args[0])) } static let isAtom = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("atom?") } if case .atom = args[0] { return .bool(true) } else { return .bool(false) } } static let deref = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("deref") } guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("deref") } return atom.val } static let reset = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("reset!") } guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("reset!") } atom.val = args[1] return args[1] } static let swap = Func { args in guard args.count >= 2 else { throw MalError.invalidArguments("swap!") } guard case let .atom(atom) = args[0] else { throw MalError.invalidArguments("swap!") } guard case let .function(fn) = args[1] else { throw MalError.invalidArguments("swap!") } let otherArgs = args.dropFirst(2) atom.val = try fn.run([atom.val] + otherArgs) return atom.val } static let cons = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("cons") } switch args[1] { case let .list(values, _), let .vector(values, _): return .list([args[0]] + values) default: throw MalError.invalidArguments("cons") } } static let concat = Func { args in let values = try args.flatMap { el throws -> [Expr] in switch el { case let .list(values, _), let .vector(values, _): return values default: throw MalError.invalidArguments("concat") } } 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") } switch args.first { case let .list(values, _), let .vector(values, _): guard values.indices ~= index else { throw MalError.outOfRange() } return values[index] default: throw MalError.invalidArguments("nth") } } static let first = Func { args in switch args.first { case let .list(values, _), let .vector(values, _): return values.first ?? .null case .null: return .null default: throw MalError.invalidArguments("first") } } static let rest = Func { args in switch args.first { case let .list(values, _), let .vector(values, _): return .list(Array(values.dropFirst())) case .null: return .list([]) default: throw MalError.invalidArguments("rest") } } static let `throw` = Func { args in guard args.count > 0 else { throw MalError.invalidArguments("throw") } throw args[0] } static let apply = Func { args in guard args.count >= 2 else { throw MalError.invalidArguments("apply") } guard case let .function(fn) = args[0] else { throw MalError.invalidArguments("apply") } let lastArgs: [Expr] switch args.last! { case let .list(values, _), let .vector(values, _): lastArgs = values default: throw MalError.invalidArguments("apply") } let fnArgs = Array(args.dropFirst().dropLast()) + lastArgs return try fn.run(fnArgs) } static let map = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("map") } guard case let .function(fn) = args[0] else { throw MalError.invalidArguments("map") } switch args[1] { case let .list(values, _), let .vector(values, _): return .list(try values.map { try fn.run([$0]) }) default: throw MalError.invalidArguments("map") } } static let isNil = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("nil?") } if case .null = args[0] { return .bool(true) } return .bool(false) } static let isTrue = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("true?") } if case .bool(true) = args[0] { return .bool(true) } return .bool(false) } static let isFalse = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("false?") } if case .bool(false) = args[0] { return .bool(true) } return .bool(false) } static let isSymbol = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("symbol?") } if case .symbol = args[0] { return .bool(true) } return .bool(false) } static let symbol = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("symbol") } guard case let .string(name) = args[0] else { throw MalError.invalidArguments("symbol") } return .symbol(name) } static let keyword = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("keyword") } guard case let .string(name) = args[0] else { throw MalError.invalidArguments("keyword") } return name.first == keywordMagic ? .string(name) : .string(String(keywordMagic) + name) } static let isKeyword = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("keyword?") } if case let .string(name) = args[0] { return name.first == keywordMagic ? .bool(true) : .bool(false) } return .bool(false) } static let vector = Func { args in return .vector(args) } static let isVector = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("vector?") } if case .vector = args[0] { return .bool(true) } return .bool(false) } static let isSequential = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("sequential?") } switch args[0] { case .list, .vector: return .bool(true) default: return .bool(false) } } static let hashmap = Func { args in return .hashmap(try hashMapDataFrom(args)) } static let isHashmap = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("map?") } if case .hashmap = args[0] { return .bool(true) } return .bool(false) } static let assoc = Func { args in guard args.count > 0 else { throw MalError.invalidArguments("assoc") } guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("assoc") } let newData = try hashMapDataFrom(Array(args.dropFirst())) return .hashmap(data.merging(newData, uniquingKeysWith: { _, new in new })) } static let dissoc = Func { args in guard args.count > 0 else { throw MalError.invalidArguments("dissoc") } guard case var .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("dissoc") } for key in args.dropFirst() { guard case let .string(name) = key else { throw MalError.invalidArguments("dissoc") } data.removeValue(forKey: name) } return .hashmap(data) } static let get = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("get") } guard case let .string(key) = args[1] else { throw MalError.invalidArguments("get") } switch args[0] { case let .hashmap(data, _): return data[key] ?? .null case .null: return .null default: throw MalError.invalidArguments("get") } } static let contains = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("contains?") } guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("contains?") } guard case let .string(key) = args[1] else { throw MalError.invalidArguments("contains?") } return data.keys.contains(key) ? .bool(true) : .bool(false) } static let keys = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("keys") } guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("keys") } return .list(data.keys.map(Expr.string)) } static let vals = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("vals") } guard case let .hashmap(data, _) = args[0] else { throw MalError.invalidArguments("vals") } return .list(Array(data.values)) } static let readline = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("readline") } guard case let .string(promt) = args[0] else { throw MalError.invalidArguments("readline") } print(promt, terminator: "") if let s = readLine() { return .string(s) } return .null } static let timeMs = Func { args in guard args.count == 0 else { throw MalError.invalidArguments("time-ms") } return .number(Int(Date().timeIntervalSince1970 * 1000)) } static let isFunction = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("fn?") } if case let .function(fn) = args[0] { return .bool(!fn.isMacro) } return .bool(false) } static let isMacro = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("macro?") } if case let .function(fn) = args[0] { return .bool(fn.isMacro) } return .bool(false) } static let isString = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("string?") } if case let .string(s) = args[0] { return s.first == keywordMagic ? .bool(false) : .bool(true) } return .bool(false) } static let isNumber = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("number?") } if case .number = args[0] { return .bool(true) } return .bool(false) } static let seq = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("seq") } switch args[0] { case .list([], _), .vector([], _), .string(""), .null: return .null case .list: return args[0] case let .vector(values, _): return .list(values) case let .string(s): if s.first == keywordMagic { throw MalError.invalidArguments("seq") } return .list(Array(s.map { .string(String($0)) })) default: throw MalError.invalidArguments("seq") } } static let conj = Func { args in guard args.count > 0 else { throw MalError.invalidArguments("conj") } switch args[0] { case let .list(values, _): return .list(Array(args.dropFirst()).reversed() + values) case let .vector(values, _): return .vector(values + Array(args.dropFirst())) default: throw MalError.invalidArguments("conj") } } static let meta = Func { args in guard args.count == 1 else { throw MalError.invalidArguments("meta") } switch args[0] { case let .function(fn): return fn.meta case let .list(_, meta): return meta case let .vector(_, meta): return meta case let .hashmap(_, meta): return meta case let .atom(atom): return atom.meta default: throw MalError.invalidArguments("meta") } } static let withMeta = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("with-meta") } switch args[0] { case let .function(fn): return .function(fn.withMeta(args[1])) case let .list(values, _): return .list(values, args[1]) case let .vector(values, _): return .vector(values, args[1]) case let .hashmap(data, _): return .hashmap(data, args[1]) case let .atom(atom): return .atom(atom.withMeta(args[1])) default: throw MalError.invalidArguments("with-meta") } } } private let data: [String: Expr] = [ "+": .function(.intOperation(+)), "-": .function(.intOperation(-)), "*": .function(.intOperation(*)), "/": .function(.intOperation(/)), "prn": .function(.prn), "println": .function(.println), "pr-str": .function(.prStr), "str": .function(.str), "list": .function(.list), "list?": .function(.isList), "empty?": .function(.isEmpty), "count": .function(.count), "=": .function(.eq), "<": .function(.comparisonOperation(<)), "<=": .function(.comparisonOperation(<=)), ">": .function(.comparisonOperation(>)), ">=": .function(.comparisonOperation(>=)), "read-string": .function(.readString), "slurp": .function(.slurp), "atom": .function(.atom), "atom?": .function(.isAtom), "deref": .function(.deref), "reset!": .function(.reset), "swap!": .function(.swap), "cons": .function(.cons), "concat": .function(.concat), "vec": .function(.vec), "nth": .function(.nth), "first": .function(.first), "rest": .function(.rest), "throw": .function(.throw), "apply": .function(.apply), "map": .function(.map), "nil?": .function(.isNil), "true?": .function(.isTrue), "false?": .function(.isFalse), "symbol?": .function(.isSymbol), "symbol": .function(.symbol), "keyword": .function(.keyword), "keyword?": .function(.isKeyword), "vector": .function(.vector), "vector?": .function(.isVector), "sequential?": .function(.isSequential), "hash-map": .function(.hashmap), "map?": .function(.isHashmap), "assoc": .function(.assoc), "dissoc": .function(.dissoc), "get": .function(.get), "contains?": .function(.contains), "keys": .function(.keys), "vals": .function(.vals), "readline": .function(.readline), "time-ms": .function(.timeMs), "meta": .function(.meta), "with-meta": .function(.withMeta), "fn?": .function(.isFunction), "macro?": .function(.isMacro), "string?": .function(.isString), "number?": .function(.isNumber), "seq": .function(.seq), "conj": .function(.conj) ] public enum Core { public static let ns: Env = Env.init(data: data, outer: nil) } ================================================ FILE: impls/swift6/Sources/core/Env.swift ================================================ import Foundation public class Env { private var outer: Env? public private(set) var data: [String: Expr] public init(data: [String: Expr] = [:], outer: Env? = nil) { self.outer = outer self.data = data } public init(binds: [String], exprs: [Expr], outer: Env? = nil) throws { self.outer = outer self.data = [:] for i in 0.. Expr? { if let val = data[key] { return val } if let outer = outer { return outer.get(key) } return nil } } ================================================ FILE: impls/swift6/Sources/core/Errors.swift ================================================ import Foundation public struct MalError: Error, LocalizedError { let message: String public init(_ message: String) { self.message = message } public var errorDescription: String? { "\(message)" } } extension MalError { public static func unbalanced(expected: String) -> MalError { return MalError("unbalanced: expected \(expected)") } public static func unbalanced(unexpected: String) -> MalError { return MalError("unbalanced: unexpected \(unexpected)") } public static func invalidArguments(_ name: String) -> MalError { return MalError("\(name): invalid arguments") } public static func invalidArguments() -> MalError { return MalError("invalid arguments") } public static func outOfRange() -> MalError { return MalError("index out of range") } public static func invalidFunctionCall(_ expr: Expr) -> MalError { return MalError("not a function: \(expr)") } public static func symbolNotFound(_ s: String) -> MalError { return MalError("'\(s)' not found") } public static func invalidVariadicFunction() -> MalError { return MalError("invalid variadic function definition") } public static func reader() -> MalError { return MalError("can't parse") } } extension Expr: Error, LocalizedError { public var errorDescription: String? { return "Error: \(self)" } } ================================================ FILE: impls/swift6/Sources/core/Parser.swift ================================================ // The MIT License (MIT) // // Copyright (c) 2019 Alexander Grebenyuk (github.com/kean). // from https://raw.githubusercontent.com/kean/Regex/master/Source/Parser.swift import Foundation // MARK: - Parser struct Parser { /// Parses the given string. Returns the matched element `A` and the /// remaining substring if the match is succesful. Returns `nil` otherwise. let parse: (_ string: Substring) throws -> (A, Substring)? } extension Parser { func parse(_ string: String) throws -> A? { try parse(string[...])?.0 } } // MARK: - Parser (Predifined) struct Parsers {} extension Parsers { /// Matches the given string. static func string(_ p: String) -> Parser { Parser { str in str.hasPrefix(p) ? ((), str.dropFirst(p.count)) : nil } } /// Matches any single character. static let char = Parser { str in str.isEmpty ? nil : (str.first!, str.dropFirst()) } /// Matches a character if the given string doesn't contain it. static func char(excluding string: String) -> Parser { char.filter { !string.contains($0) } } /// Matches any character contained in the given string. static func char(from string: String) -> Parser { char.filter(string.contains) } /// Matches characters while the given string doesn't contain them. static func string(excluding string: String) -> Parser { char(excluding: string).oneOrMore.map { String($0) } } static let digit = char(from: "0123456789") static let naturalNumber = digit.oneOrMore.map { Int(String($0)) } } extension Parser: ExpressibleByStringLiteral, ExpressibleByUnicodeScalarLiteral, ExpressibleByExtendedGraphemeClusterLiteral where A == Void { // Unfortunately had to add these explicitly supposably because of the // conditional conformance limitations. typealias ExtendedGraphemeClusterLiteralType = StringLiteralType typealias UnicodeScalarLiteralType = StringLiteralType typealias StringLiteralType = String init(stringLiteral value: String) { self = Parsers.string(value) } } // MARK: - Parser (Combinators) /// Matches only if both of the given parsers produced a result. func zip(_ a: Parser, _ b: Parser) -> Parser<(A, B)> { a.flatMap { matchA in b.map { matchB in (matchA, matchB) } } } /// Returns the first match or `nil` if no matches are found. func oneOf(_ parsers: Parser...) -> Parser { precondition(!parsers.isEmpty) return Parser { str -> (A, Substring)? in for parser in parsers { if let match = try parser.parse(str) { return match } } return nil } } extension Parser { func map(_ transform: @escaping (A) throws -> B?) -> Parser { flatMap { match in Parser { str in (try transform(match)).map { ($0, str) } } } } func flatMap(_ transform: @escaping (A) throws -> Parser) -> Parser { Parser { str in guard let (a, str) = try self.parse(str) else { return nil } return try transform(a).parse(str) } } func filter(_ predicate: @escaping (A) -> Bool) -> Parser { map { predicate($0) ? $0 : nil } } } // MARK: - Parser (Quantifiers) extension Parser { /// Matches the given parser zero or more times. var zeroOrMore: Parser<[A]> { Parser<[A]> { str in var str = str var matches = [A]() while let (match, newStr) = try self.parse(str) { matches.append(match) str = newStr } return (matches, str) } } /// Matches the given parser one or more times. var oneOrMore: Parser<[A]> { zeroOrMore.map { $0.isEmpty ? nil : $0 } } } // MARK: - Parser (Optional) func optional(_ parser: Parser) -> Parser { Parser { str -> (A?, Substring)? in guard let match = try parser.parse(str) else { return (nil, str) // Return empty match without consuming any characters } return match } } // MARK: - Parser (Error Reporting) extension Parser { /// Throws an error if the parser fails to produce a match. func orThrow(_ error: MalError) -> Parser { Parser { str -> (A, Substring)? in guard let match = try self.parse(str) else { throw error } return match } } /// Matches if the parser produces no matches. Throws an error otherwise. func zeroOrThrow(_ error: MalError) -> Parser { // automatically cast map { _ in throw error } } } // MARK: - Parser (Misc) extension Parsers { /// Succeeds when input is empty. static let end = Parser { str in str.isEmpty ? ((), str) : nil } /// Delays the creation of parser. Use it to break dependency cycles when /// creating recursive parsers. static func lazy(_ closure: @autoclosure @escaping () -> Parser) -> Parser { Parser { str in try closure().parse(str) } } } // MARK: - Parser (Operators) infix operator *> : CombinatorPrecedence infix operator <* : CombinatorPrecedence infix operator <*> : CombinatorPrecedence func *> (_ lhs: Parser, _ rhs: Parser) -> Parser { zip(lhs, rhs).map { $0.1 } } func <* (_ lhs: Parser, _ rhs: Parser) -> Parser { zip(lhs, rhs).map { $0.0 } } func <*> (_ lhs: Parser, _ rhs: Parser) -> Parser<(A, B)> { zip(lhs, rhs) } precedencegroup CombinatorPrecedence { associativity: left higherThan: DefaultPrecedence } // MARK: - Extensions extension CharacterSet { func contains(_ c: Character) -> Bool { return c.unicodeScalars.allSatisfy(contains) } } ================================================ FILE: impls/swift6/Sources/core/Printer.swift ================================================ import Foundation extension Expr { public static func print(readable: Bool = true, _ expr: Expr) -> String { let print = curry(Self.print)(readable) switch expr { case let .number(value): return "\(value)" case let .list(arr, _): let inner: String = arr.map(print).joined(separator: " ") return "(" + inner + ")" case let .vector(arr, _): let inner: String = arr.map(print).joined(separator: " ") return "[" + inner + "]" case let .hashmap(m, _): let inner = m.map { printString($0.key, readable: readable) + " " + print($0.value) }.joined(separator: " ") return "{" + inner + "}" case let .string(s): return printString(s, readable: readable) case let .symbol(s): return s case let .bool(b): return b ? "true" : "false" case .null: return "nil" case let .function(fn): return fn.isMacro ? "#" : "#" case let .atom(expr): return "(atom \(print(expr.val)))" } } } private func printString(_ s: String, readable: Bool) -> String { if s.first == keywordMagic { return ":" + s.dropFirst() } return readable ? ("\"" + unescape(s) + "\"") : s } private func unescape(_ s: String) -> String { return s .replacingOccurrences(of: "\\", with: "\\\\") .replacingOccurrences(of: "\n", with: "\\n") .replacingOccurrences(of: "\"", with: "\\\"") } extension Expr: CustomDebugStringConvertible { public var debugDescription: String { Expr.print(self) } } ================================================ FILE: impls/swift6/Sources/core/Reader.swift ================================================ import Foundation public enum Reader { public static func read(_ str: String) throws -> Expr { return try Parsers.expr.orThrow(MalError.reader()).parse(str)! } } private extension Parsers { static let expr = form <* endPattern static let endPattern = oneOf( end, char(from: ")").zeroOrThrow(.unbalanced(unexpected: ")")), char(from: "]").zeroOrThrow(.unbalanced(unexpected: "]")), char(from: "}").zeroOrThrow(.unbalanced(unexpected: "}")) ) static let form = oneOf( list, vector, hashmap, atom, readerMacros ).ignoreAround() static let _form: Parser = lazy(form) static let atom = oneOf( malString, number, null, bool, symbol, keyword ) static let list = ("(" *> _form.zeroOrMore.ignoreAround() <* string(")").orThrow(.unbalanced(expected: ")"))).map { Expr.list($0) } static let vector = ("[" *> _form.zeroOrMore.ignoreAround() <* string("]").orThrow(.unbalanced(expected: "]"))).map { Expr.vector($0) } // MARK: - Hashmap static let hashmap = ("{" *> (hashmapKey <*> _form).zeroOrMore.ignoreAround() <* string("}").orThrow(.unbalanced(expected: "}"))).map(makeHashmap) static func makeHashmap(_ xs: [(Expr, Expr)]) -> Expr { var dict: [String: Expr] = [:] for x in xs { guard case let .string(key) = x.0 else { fatalError() } dict[key] = x.1 } return .hashmap(dict) } static let hashmapKey = oneOf(malString, keyword) // MARK: - Number static let number = (optional(char(from: "-")) <*> naturalNumber).map(makeNumber) static func makeNumber(_ negative: Character?, value: Int) -> Expr { let factor = negative != nil ? -1 : 1 return .number(value * factor) } // MARK: - String static let stringContent = oneOf( string(excluding: "\\\""), string("\\\\").map { "\\" }, string("\\\"").map { "\"" }, string("\\n").map { "\n" }, string("\\").map { "\\" } ) static let malString = ("\"" *> stringContent.zeroOrMore <* string("\"").orThrow(.unbalanced(expected: "\""))).map(makeMalString) static func makeMalString(_ xs: [String]) -> Expr { return .string(xs.joined()) } // MARK: - Keyword static let keyword = (":" *> name).map { Expr.string(String(keywordMagic) + $0) } // MARK: - Symbol static let symbolHead = char(excluding: "0123456789^`'\"#~@:%()[]{} \n\r\t,") static let symbolRest = oneOf(symbolHead, char(from: "0123456789.:")) static let name = (symbolHead <*> symbolRest.zeroOrMore).map { String($0) + String($1) } static let symbol = name.map(Expr.symbol) // MARK: - Bool static let bool = name.map(makeBool) static func makeBool(_ s: String) -> Expr? { switch s { case "true": return .bool(true) case "false": return .bool(false) default: return nil } } // MARK: - Null static let null = name.map(makeNull) static func makeNull(_ s: String) -> Expr? { return s == "nil" ? .null : nil } // MARK: - Reader macros static let quote = ("'" *> _form).readerMacros("quote") static let quasiquote = ("`" *> _form).readerMacros("quasiquote") static let spliceUnquote = ("~@" *> _form).readerMacros("splice-unquote") static let unquote = ("~" *> _form).readerMacros("unquote") static let deref = ("@" *> _form).readerMacros("deref") static let meta = ("^" *> _form <*> _form).map { Expr.list([.symbol("with-meta"), $1, $0]) } static let readerMacros = oneOf( quote, quasiquote, spliceUnquote, unquote, deref, meta ) // MARK: - Ignore static let whitespace = char(from: " \n\r\t,") static let comment = char(from: ";") <* char(excluding: "\n\r").zeroOrMore static let ignore = oneOf(whitespace, comment) } extension Parser { func ignoreAround() -> Parser { return (Parsers.ignore.zeroOrMore *> self <* Parsers.ignore.zeroOrMore) } } extension Parser where A == Expr { func readerMacros(_ s: String) -> Parser { return map { Expr.list([.symbol(s), $0]) } } } ================================================ FILE: impls/swift6/Sources/core/Types.swift ================================================ import Foundation public let keywordMagic: Character = "\u{029E}" public enum Expr { case number(Int) case bool(Bool) case null case string(String) case symbol(String) indirect case list([Expr], Expr) indirect case vector([Expr], Expr) indirect case hashmap([String: Expr], Expr) case function(Func) case atom(Atom) } public extension Expr { static func list(_ arr: [Expr]) -> Expr { return .list(arr, .null) } static func vector(_ arr: [Expr]) -> Expr { return .vector(arr, .null) } static func hashmap(_ data: [String: Expr]) -> Expr { return .hashmap(data, .null) } } extension Expr: Equatable { public static func == (lhs: Self, rhs: Self) -> Bool { switch (lhs, rhs) { case let (.number(a), .number(b)): return a == b case let (.bool(a), .bool(b)): return a == b case (.null, .null): return true case let (.string(a), .string(b)): return a == b case let (.symbol(a), .symbol(b)): return a == b case let (.list(a, _), .list(b, _)), let (.vector(a, _), .vector(b, _)), let (.list(a, _), .vector(b, _)), let (.vector(a, _), .list(b, _)): return a == b case let (.hashmap(a, _), .hashmap(b, _)): return a == b case let (.function(a), .function(b)): return a == b case let (.atom(a), .atom(b)): return a == b default: return false } } } // MARK: - Func final public class Func { public let run: ([Expr]) throws -> Expr public let ast: Expr? public let params: [String] public let env: Env? public let isMacro: Bool public let meta: Expr public init( ast: Expr? = nil, params: [String] = [], env: Env? = nil, isMacro: Bool = false, meta: Expr = .null, run: @escaping ([Expr]) throws -> Expr ) { self.run = run self.ast = ast self.params = params self.env = env self.isMacro = isMacro self.meta = meta } public func asMacros() -> Func { return Func(ast: ast, params: params, env: env, isMacro: true, meta: meta, run: run) } public func withMeta(_ meta: Expr) -> Func { return Func(ast: ast, params: params, env: env, isMacro: isMacro, meta: meta, run: run) } } extension Func: Equatable { public static func == (lhs: Func, rhs: Func) -> Bool { return lhs === rhs } } // MARK: - Atom final public class Atom { public var val: Expr public let meta: Expr public init(_ val: Expr, meta: Expr = .null) { self.val = val self.meta = meta } public func withMeta(_ meta: Expr) -> Atom { return Atom(val, meta: meta) } } extension Atom: Equatable { public static func == (lhs: Atom, rhs: Atom) -> Bool { return lhs.val == rhs.val } } ================================================ FILE: impls/swift6/Sources/core/Utils.swift ================================================ import Foundation public func curry(_ function: @escaping (A, B) -> C) -> (A) -> (B) -> C { return { (a: A) -> (B) -> C in { (b: B) -> C in function(a, b) } } } public extension Collection { subscript (safe index: Index) -> Element? { return indices.contains(index) ? self[index] : nil } } ================================================ FILE: impls/swift6/Sources/step0_repl/main.swift ================================================ import Foundation func READ(_ s: String) -> String { return s } func EVAL(_ s: String) -> String { return s } func PRINT(_ s: String) -> String { return s } func rep(_ s: String) -> String { return PRINT(EVAL(READ(s))) } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s)) } ================================================ FILE: impls/swift6/Sources/step1_read_print/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr) throws -> Expr { return expr } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String) -> String { do { let expr = try read(s) let resExpr = try eval(expr) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s)) } ================================================ FILE: impls/swift6/Sources/step2_eval/main.swift ================================================ import Foundation import core extension Func { static fileprivate func infixOperation(_ op: @escaping (Int, Int) -> Int) -> Func { return Func { args in guard args.count == 2, case let .number(a) = args[0], case let .number(b) = args[1] else { throw MalError.invalidArguments() } return .number(op(a, b)) } } } var replEnv: Env = Env() replEnv.set(forKey: "+", val: .function(.infixOperation(+))) replEnv.set(forKey: "-", val: .function(.infixOperation(-))) replEnv.set(forKey: "*", val: .function(.infixOperation(*))) replEnv.set(forKey: "/", val: .function(.infixOperation(/))) func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr, env: Env) throws -> Expr { // print("EVAL: " + print(expr)) switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast.first else { throw MalError.invalidFunctionCall(ast[0]) } return try fn.run(Array(ast.dropFirst())) default: return expr } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step3_env/main.swift ================================================ import Foundation import core extension Func { static fileprivate func infixOperation(_ op: @escaping (Int, Int) -> Int) -> Func { return Func { args in guard args.count == 2, case let .number(a) = args[0], case let .number(b) = args[1] else { throw MalError.invalidArguments() } return .number(op(a, b)) } } } var replEnv: Env = Env() replEnv.set(forKey: "+", val: .function(.infixOperation(+))) replEnv.set(forKey: "-", val: .function(.infixOperation(-))) replEnv.set(forKey: "*", val: .function(.infixOperation(*))) replEnv.set(forKey: "/", val: .function(.infixOperation(/))) func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr, env: Env) throws -> Expr { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } let expToEval = ast[2] return try eval(expToEval, env: letEnv) default: throw MalError.invalidArguments("let*") } default: let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } return try fn.run(Array(ast.dropFirst())) } default: return expr } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step4_if_fn_do/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr, env: Env) throws -> Expr { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } let expToEval = ast[2] return try eval(expToEval, env: letEnv) default: throw MalError.invalidArguments("let*") } case .symbol("do"): let exprsToEval = ast.dropFirst() if exprsToEval.isEmpty { throw MalError.invalidArguments("do") } return try exprsToEval.map { try eval($0, env: env) }.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } let condExpr = ast[1] switch try eval(condExpr, env: env) { case .bool(false), .null: if let falseExpr = ast[safe: 3] { return try eval(falseExpr, env: env) } return .null default: return try eval(ast[2], env: env) } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let f = Func { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } return .function(f) default: let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } return try fn.run(Array(ast.dropFirst())) } default: return expr } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step5_tco/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } let args = Array(ast.dropFirst()) if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step6_file/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } let args = Array(ast.dropFirst()) if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) replEnv.set(forKey: "eval", val: .function(Func { args in guard let expr = args.first else { throw MalError.invalidArguments("eval") } return try eval(expr, env: replEnv) })) replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) _ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) if CommandLine.arguments.count > 1 { _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) exit(0) } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step7_quote/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } 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]) } } 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 } } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("quote"): guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: let ast = try ast.map { try eval($0, env: env) } guard case let .function(fn) = ast[0] else { throw MalError.invalidFunctionCall(ast[0]) } let args = Array(ast.dropFirst()) if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) replEnv.set(forKey: "eval", val: .function(Func { args in guard let expr = args.first else { throw MalError.invalidArguments("eval") } return try eval(expr, env: replEnv) })) replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) _ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) if CommandLine.arguments.count > 1 { _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) exit(0) } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step8_macros/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } 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]) } } 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 } } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("quote"): guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) case .symbol("defmacro!"): guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } let macros = fn.asMacros() env.set(forKey: name, val: .function(macros)) return .function(macros) case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } if fn.isMacro { expr = try fn.run(Array(ast.dropFirst())) continue } let args = try ast.dropFirst().map { try eval($0, env: env) } if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) replEnv.set(forKey: "eval", val: .function(Func { args in guard let expr = args.first else { throw MalError.invalidArguments("eval") } return try eval(expr, env: replEnv) })) replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) _ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) _ = 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)))))))"#, env: replEnv) if CommandLine.arguments.count > 1 { _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) exit(0) } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/step9_try/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } 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]) } } 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 } } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("quote"): guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) case .symbol("defmacro!"): guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } let macros = fn.asMacros() env.set(forKey: name, val: .function(macros)) return .function(macros) case .symbol("try*"): if ast.count == 2 { expr = ast[1] continue } guard ast.count == 3 else { throw MalError.invalidArguments("try*") } guard case let .list(values, _) = ast[2], values.count == 3 else { throw MalError.invalidArguments("try*") } guard case .symbol("catch*") = values[0] else { throw MalError.invalidArguments("try*") } guard case let .symbol(bind) = values[1] else { throw MalError.invalidArguments("catch*") } do { return try eval(ast[1], env: env) } catch { let malErr = (error as? Expr) ?? .string(error.localizedDescription) let newEnv = try Env(binds: [bind], exprs: [malErr], outer: env) env = newEnv expr = values[2] } case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } if fn.isMacro { expr = try fn.run(Array(ast.dropFirst())) continue } let args = try ast.dropFirst().map { try eval($0, env: env) } if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) replEnv.set(forKey: "eval", val: .function(Func { args in guard let expr = args.first else { throw MalError.invalidArguments("eval") } return try eval(expr, env: replEnv) })) replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) _ = rep("(def! not (fn* (a) (if a false true)))", env: replEnv) _ = rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) _ = 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)))))))"#, env: replEnv) if CommandLine.arguments.count > 1 { _ = rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) exit(0) } while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/Sources/stepA_mal/main.swift ================================================ import Foundation import core func read(_ s: String) throws -> Expr { return try Reader.read(s) } 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]) } } 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 } } func eval(_ expr: Expr, env: Env) throws -> Expr { var env = env var expr = expr while true { switch env.get("DEBUG-EVAL") { case nil, .bool(false), .null: break default: print("EVAL: " + print(expr)) } switch expr { case let .symbol(name): let val = env.get(name) guard val != nil else { throw MalError.symbolNotFound(name) } return val! case let .vector(values, _): return .vector(try values.map { try eval($0, env: env) }) case let .hashmap(values, _): return .hashmap(try values.mapValues { try eval($0, env: env) }) case let .list(ast, _): if ast.isEmpty { return expr } switch ast[0] { case .symbol("def!"): guard ast.count == 3 else { throw MalError.invalidArguments("def!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("def!") } let val = try eval(ast[2], env: env) env.set(forKey: name, val: val) return val case .symbol("let*"): guard ast.count == 3 else { throw MalError.invalidArguments("let*") } switch ast[1] { case let .list(bindable, _), let .vector(bindable, _): let letEnv = Env(outer: env) for i in stride(from: 0, to: bindable.count - 1, by: 2) { guard case let .symbol(key) = bindable[i] else { throw MalError.invalidArguments("let*") } let value = bindable[i + 1] letEnv.set(forKey: key, val: try eval(value, env: letEnv)) } expr = ast[2] env = letEnv default: throw MalError.invalidArguments("let*") } case .symbol("quote"): guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) case .symbol("defmacro!"): guard ast.count == 3 else { throw MalError.invalidArguments("defmacro!") } guard case let .symbol(name) = ast[1] else { throw MalError.invalidArguments("defmacro!") } guard case let .function(fn) = try eval(ast[2], env: env) else { throw MalError.invalidArguments("defmacro!") } let macros = fn.asMacros() env.set(forKey: name, val: .function(macros)) return .function(macros) case .symbol("try*"): if ast.count == 2 { expr = ast[1] continue } guard ast.count == 3 else { throw MalError.invalidArguments("try*") } guard case let .list(values, _) = ast[2], values.count == 3 else { throw MalError.invalidArguments("try*") } guard case .symbol("catch*") = values[0] else { throw MalError.invalidArguments("try*") } guard case let .symbol(bind) = values[1] else { throw MalError.invalidArguments("catch*") } do { return try eval(ast[1], env: env) } catch { let malErr = (error as? Expr) ?? .string(error.localizedDescription) let newEnv = try Env(binds: [bind], exprs: [malErr], outer: env) env = newEnv expr = values[2] } case .symbol("do"): let exprsToEval = ast.dropFirst() guard !exprsToEval.isEmpty else { throw MalError.invalidArguments("do") } _ = try exprsToEval.dropLast().map { try eval($0, env: env) } expr = exprsToEval.last! case .symbol("if"): guard 3...4 ~= ast.count else { throw MalError.invalidArguments("if") } switch try eval(ast[1], env: env) { case .bool(false), .null: if let falseBranch = ast[safe: 3] { expr = falseBranch } else { expr = .null } default: expr = ast[2] } case .symbol("fn*"): guard ast.count == 3 else { throw MalError.invalidArguments("fn*") } let binds: [String] switch ast[1] { case let .list(xs, _), let .vector(xs, _): binds = try xs.map { guard case let .symbol(name) = $0 else { throw MalError.invalidArguments("fn*") } return name } default: throw MalError.invalidArguments("fn*") } let run: ([Expr]) throws -> Expr = { args in let fEnv = try Env(binds: binds, exprs: args, outer: env) return try eval(ast[2], env: fEnv) } let f = Func(ast: ast[2], params: binds, env: env, run: run) return .function(f) default: guard case let .function(fn) = try eval(ast[0], env: env) else { throw MalError.invalidFunctionCall(ast[0]) } if fn.isMacro { expr = try fn.run(Array(ast.dropFirst())) continue } let args = try ast.dropFirst().map { try eval($0, env: env) } if let ast = fn.ast, let fnEnv = fn.env { let newEnv = try Env(binds: fn.params, exprs: args, outer: fnEnv) env = newEnv expr = ast } else { return try fn.run(args) } } default: return expr } } } func print(_ expr: Expr) -> String { return Expr.print(expr) } @discardableResult func rep(_ s: String, env: Env) -> String { do { let expr = try read(s) let resExpr = try eval(expr, env: env) let resultStr = print(resExpr) return resultStr } catch { return error.localizedDescription } } let replEnv: Env = Env(data: Core.ns.data) replEnv.set(forKey: "eval", val: .function(Func { args in guard let expr = args.first else { throw MalError.invalidArguments("eval") } return try eval(expr, env: replEnv) })) replEnv.set(forKey: "*ARGV*", val: .list(CommandLine.arguments.dropFirst(2).map(Expr.string))) replEnv.set(forKey: "*host-language*", val: .string("swift6")) rep("(def! not (fn* (a) (if a false true)))", env: replEnv) rep(#"(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))"#, env: replEnv) 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)))))))"#, env: replEnv) if CommandLine.arguments.count > 1 { rep("(load-file \"" + CommandLine.arguments[1] + "\")", env: replEnv) exit(0) } rep(#"(println (str "Mal [" *host-language* "]"))"#, env: replEnv) while true { print("user> ", terminator: "") guard let s = readLine() else { break } print(rep(s, env: replEnv)) } ================================================ FILE: impls/swift6/run ================================================ #!/bin/sh exec $(dirname $0)/.build/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/tcl/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install tcl tcl-tclreadline ENV HOME /mal ================================================ FILE: impls/tcl/Makefile ================================================ SOURCES_BASE = mal_readline.tcl types.tcl reader.tcl printer.tcl SOURCES_LISP = env.tcl core.tcl stepA_mal.tcl SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: true dist: mal.tcl mal mal.tcl: $(SOURCES) cat $+ | grep -v "^source " > $@ mal: mal.tcl echo "#!/usr/bin/env tclsh" > $@ cat $< >> $@ chmod +x $@ clean: rm -f mal.tcl mal ================================================ FILE: impls/tcl/core.tcl ================================================ proc mal_equal {a} { bool_new [equal_q [lindex $a 0] [lindex $a 1]] } set ::mal_exception_obj 0 proc mal_throw {a} { set ::mal_exception_obj [lindex $a 0] error "__MalException__" } proc mal_nil_q {a} { bool_new [nil_q [lindex $a 0]] } proc mal_true_q {a} { bool_new [true_q [lindex $a 0]] } proc mal_false_q {a} { bool_new [false_q [lindex $a 0]] } proc mal_symbol {a} { symbol_new [obj_val [lindex $a 0]] } proc mal_symbol_q {a} { bool_new [symbol_q [lindex $a 0]] } proc mal_string_q {a} { bool_new [string_q [lindex $a 0]] } proc mal_keyword {a} { lassign $a a0 if {[keyword_q $a0]} { return $a0 } keyword_new [obj_val $a0] } proc mal_keyword_q {a} { bool_new [keyword_q [lindex $a 0]] } proc mal_number_q {a} { bool_new [integer_q [lindex $a 0]] } proc mal_fn_q {a} { set f [lindex $a 0] switch [obj_type $f] { function { return [bool_new [expr {![macro_q $f]}]] } nativefunction { return $::mal_true } default { return $::mal_false } } } proc mal_macro_q {a} { bool_new [macro_q [lindex $a 0]] } proc render_array {arr readable delim} { set res {} foreach e $arr { lappend res [pr_str $e $readable] } join $res $delim } proc mal_pr_str {a} { string_new [render_array $a 1 " "] } proc mal_str {a} { string_new [render_array $a 0 ""] } proc mal_prn {a} { puts [render_array $a 1 " "] return $::mal_nil } proc mal_println {a} { puts [render_array $a 0 " "] return $::mal_nil } proc mal_read_string {a} { read_str [obj_val [lindex $a 0]] } proc mal_readline {a} { set prompt [obj_val [lindex $a 0]] set res [_readline $prompt] if {[lindex $res 0] == "EOF"} { return $::mal_nil } string_new [lindex $res 1] } proc mal_slurp {a} { set filename [obj_val [lindex $a 0]] set file [open $filename] set content [read $file] close $file string_new $content } proc mal_lt {a} { bool_new [expr {[obj_val [lindex $a 0]] < [obj_val [lindex $a 1]]}] } proc mal_lte {a} { bool_new [expr {[obj_val [lindex $a 0]] <= [obj_val [lindex $a 1]]}] } proc mal_gt {a} { bool_new [expr {[obj_val [lindex $a 0]] > [obj_val [lindex $a 1]]}] } proc mal_gte {a} { bool_new [expr {[obj_val [lindex $a 0]] >= [obj_val [lindex $a 1]]}] } proc mal_add {a} { integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] } proc mal_sub {a} { integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] } proc mal_mul {a} { integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] } proc mal_div {a} { integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] } proc mal_time_ms {a} { integer_new [clock milliseconds] } proc mal_list {a} { list_new $a } proc mal_list_q {a} { bool_new [list_q [lindex $a 0]] } proc mal_vector {a} { vector_new $a } proc mal_vector_q {a} { bool_new [vector_q [lindex $a 0]] } proc mal_hash_map {a} { set d [dict create] foreach {k v} $a { dict set d [obj_val $k] $v } hashmap_new $d } proc mal_map_q {a} { bool_new [hashmap_q [lindex $a 0]] } proc mal_assoc {a} { set d [dict create] dict for {k v} [obj_val [lindex $a 0]] { dict set d $k $v } foreach {k v} [lrange $a 1 end] { dict set d [obj_val $k] $v } hashmap_new $d } proc mal_dissoc {a} { set d [dict create] dict for {k v} [obj_val [lindex $a 0]] { dict set d $k $v } foreach k [lrange $a 1 end] { dict unset d [obj_val $k] } hashmap_new $d } proc mal_get {a} { lassign $a hashmap_obj key_obj if {[dict exists [obj_val $hashmap_obj] [obj_val $key_obj]]} { dict get [obj_val $hashmap_obj] [obj_val $key_obj] } else { return $::mal_nil } } proc mal_contains_q {a} { lassign $a hashmap_obj key_obj bool_new [dict exists [obj_val $hashmap_obj] [obj_val $key_obj]] } proc mal_keys {a} { set res {} foreach k [dict keys [obj_val [lindex $a 0]]] { lappend res [string_new $k] } list_new $res } proc mal_vals {a} { list_new [dict values [obj_val [lindex $a 0]]] } proc mal_sequential_q {a} { bool_new [sequential_q [lindex $a 0]] } proc mal_cons {a} { lassign $a head lst list_new [concat [list $head] [obj_val $lst]] } proc mal_concat {a} { set res {} foreach lst $a { if {[nil_q $lst]} { continue } set res [concat $res [obj_val $lst]] } 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] set lst [obj_val $lst_obj] if {$index >= [llength $lst]} { error "nth: index out of range" } lindex $lst $index } proc mal_first {a} { lassign $a lst if {[nil_q $lst] || [llength [obj_val $lst]] == 0} { return $::mal_nil } lindex [obj_val $lst] 0 } proc mal_rest {a} { lassign $a lst list_new [lrange [obj_val $lst] 1 end] } proc mal_empty_q {a} { bool_new [expr {[llength [obj_val [lindex $a 0]]] == 0}] } proc mal_count {a} { integer_new [llength [obj_val [lindex $a 0]]] } proc mal_apply {a} { set f [lindex $a 0] if {[llength $a] > 1} { set mid_args [lrange $a 1 end-1] set last_list [lindex $a end] set apply_args [concat $mid_args [obj_val $last_list]] } else { set apply_args {} } switch [obj_type $f] { function { set funcdict [obj_val $f] set body [dict get $funcdict body] set env [dict get $funcdict env] set binds [dict get $funcdict binds] set funcenv [Env new $env $binds $apply_args] return [EVAL $body $funcenv] } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $apply_args] } default { error "Not a function" } } } proc mal_map {a} { lassign $a f seq set res {} foreach item [obj_val $seq] { set mappeditem [mal_apply [list $f [list_new [list $item]]]] lappend res $mappeditem } list_new $res } proc mal_conj {a} { lassign $a a0 if {[list_q $a0]} { set lst $a0 foreach item [lrange $a 1 end] { set lst [mal_cons [list $item $lst]] } return $lst } elseif {[vector_q $a0]} { set res [obj_val $a0] foreach item [lrange $a 1 end] { lappend res $item } vector_new $res } else { error "conj requires list or vector" } } proc mal_seq {a} { lassign $a a0 if {[string_q $a0]} { set str [obj_val $a0] if {$str == ""} { return $::mal_nil } set res {} foreach char [split $str {}] { lappend res [string_new $char] } list_new $res } elseif {[list_q $a0]} { if {[llength [obj_val $a0]] == 0} { return $::mal_nil } return $a0 } elseif {[vector_q $a0]} { if {[llength [obj_val $a0]] == 0} { return $::mal_nil } list_new [obj_val $a0] } elseif {[nil_q $a0]} { return $::mal_nil } else { error "seq requires string or list or vector or nil" } } proc mal_meta {a} { obj_meta [lindex $a 0] } proc mal_with_meta {a} { lassign $a a0 a1 obj_new [obj_type $a0] [obj_val $a0] $a1 } proc mal_atom {a} { atom_new [lindex $a 0] } proc mal_atom_q {a} { bool_new [atom_q [lindex $a 0]] } proc mal_deref {a} { obj_val [lindex $a 0] } proc mal_reset_bang {a} { lassign $a a0 a1 obj_set_val $a0 $a1 } proc mal_swap_bang {a} { lassign $a a0 f set apply_args [concat [list [obj_val $a0]] [lrange $a 2 end]] set newval [mal_apply [list $f [list_new $apply_args]]] mal_reset_bang [list $a0 $newval] } set core_ns [dict create \ "=" [nativefunction_new mal_equal] \ "throw" [nativefunction_new mal_throw] \ \ "nil?" [nativefunction_new mal_nil_q] \ "true?" [nativefunction_new mal_true_q] \ "false?" [nativefunction_new mal_false_q] \ "symbol" [nativefunction_new mal_symbol] \ "symbol?" [nativefunction_new mal_symbol_q] \ "string?" [nativefunction_new mal_string_q] \ "keyword" [nativefunction_new mal_keyword] \ "keyword?" [nativefunction_new mal_keyword_q] \ "number?" [nativefunction_new mal_number_q] \ "fn?" [nativefunction_new mal_fn_q] \ "macro?" [nativefunction_new mal_macro_q] \ \ "pr-str" [nativefunction_new mal_pr_str] \ "str" [nativefunction_new mal_str] \ "prn" [nativefunction_new mal_prn] \ "println" [nativefunction_new mal_println] \ "read-string" [nativefunction_new mal_read_string] \ "readline" [nativefunction_new mal_readline] \ "slurp" [nativefunction_new mal_slurp] \ \ "<" [nativefunction_new mal_lt] \ "<=" [nativefunction_new mal_lte] \ ">" [nativefunction_new mal_gt] \ ">=" [nativefunction_new mal_gte] \ "+" [nativefunction_new mal_add] \ "-" [nativefunction_new mal_sub] \ "*" [nativefunction_new mal_mul] \ "/" [nativefunction_new mal_div] \ "time-ms" [nativefunction_new mal_time_ms] \ \ "list" [nativefunction_new mal_list] \ "list?" [nativefunction_new mal_list_q] \ "vector" [nativefunction_new mal_vector] \ "vector?" [nativefunction_new mal_vector_q] \ "hash-map" [nativefunction_new mal_hash_map] \ "map?" [nativefunction_new mal_map_q] \ "assoc" [nativefunction_new mal_assoc] \ "dissoc" [nativefunction_new mal_dissoc] \ "get" [nativefunction_new mal_get] \ "contains?" [nativefunction_new mal_contains_q] \ "keys" [nativefunction_new mal_keys] \ "vals" [nativefunction_new mal_vals] \ \ "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] \ "empty?" [nativefunction_new mal_empty_q] \ "count" [nativefunction_new mal_count] \ "apply" [nativefunction_new mal_apply] \ "map" [nativefunction_new mal_map] \ \ "conj" [nativefunction_new mal_conj] \ "seq" [nativefunction_new mal_seq] \ \ "meta" [nativefunction_new mal_meta] \ "with-meta" [nativefunction_new mal_with_meta] \ "atom" [nativefunction_new mal_atom] \ "atom?" [nativefunction_new mal_atom_q] \ "deref" [nativefunction_new mal_deref] \ "reset!" [nativefunction_new mal_reset_bang] \ "swap!" [nativefunction_new mal_swap_bang] \ ] ================================================ FILE: impls/tcl/env.tcl ================================================ oo::class create Env { variable outer data constructor {{outerenv 0} {binds ""} {exprs ""}} { set outer $outerenv set data [dict create] if {$binds != ""} { for {set i 0} {$i < [llength $binds]} {incr i} { set b [lindex $binds $i] if {$b == "&"} { set varrest [lindex $binds [expr {$i + 1}]] set restexprs [list_new [lrange $exprs $i end]] my set $varrest $restexprs break } else { my set $b [lindex $exprs $i] } } } } method set {symbol objval} { dict set data $symbol $objval return $objval } method find {symbol} { if {[dict exist $data $symbol]} { return [self] } elseif {$outer != 0} { return [$outer find $symbol] } else { return 0 } } method get {symbol} { set foundenv [my find $symbol] if {$foundenv == 0} { error "'$symbol' not found" } else { return [$foundenv get_symbol $symbol] } } method get_symbol {symbol} { dict get $data $symbol } } ================================================ FILE: impls/tcl/mal_readline.tcl ================================================ if {[lindex $argv 0] == "--raw"} { set ::readline_mode "raw" set argv [lrange $argv 1 end] incr argc -1 } else { if {[catch {package require tclreadline}]} { set ::readline_mode "raw" } else { set ::readline_mode "library" } } set ::historyfile "$env(HOME)/.mal-history" set ::readline_library_initalized 0 proc readline_library_init {} { if {$::readline_library_initalized} { return } ::tclreadline::readline initialize $::historyfile ::tclreadline::readline builtincompleter 0 ::tclreadline::readline customcompleter "" set ::readline_library_initalized 1 } proc _readline_library prompt { readline_library_init set reached_eof 0 ::tclreadline::readline eofchar { set reached_eof 1 } set line [::tclreadline::readline read $prompt] if {$reached_eof} { return {"EOF" ""} } ::tclreadline::readline write $::historyfile list "OK" $line } proc _readline_raw prompt { puts -nonewline $prompt flush stdout if {[gets stdin line] < 0} { return {"EOF" ""} } list "OK" $line } proc _readline prompt { if {$::readline_mode == "library"} { _readline_library $prompt } else { _readline_raw $prompt } } ================================================ FILE: impls/tcl/printer.tcl ================================================ proc format_list {elements start_char end_char readable} { set res {} foreach element $elements { lappend res [pr_str $element $readable] } set joined [join $res " "] return "${start_char}${joined}${end_char}" } proc format_hashmap {dictionary readable} { set lst {} dict for {keystr valobj} $dictionary { lappend lst [string_new $keystr] lappend lst $valobj } format_list $lst "\{" "\}" $readable } proc format_string {str readable} { if {[string index $str 0] == "\u029E"} { return ":[string range $str 1 end]" } elseif {$readable} { set escaped [string map {"\n" "\\n" "\"" "\\\"" "\\" "\\\\"} $str] return "\"$escaped\"" } else { return $str } } proc format_function {funcdict} { set type "function" if {[dict get $funcdict is_macro]} { set type "macro" } return "<$type:args=[join [dict get $funcdict binds] ","]>" } proc pr_str {ast readable} { set nodetype [obj_type $ast] set nodevalue [obj_val $ast] switch $nodetype { nil { return "nil" } true { return "true" } false { return "false" } integer { return $nodevalue } symbol { return $nodevalue } string { return [format_string $nodevalue $readable] } list { return [format_list $nodevalue "(" ")" $readable] } vector { return [format_list $nodevalue "\[" "\]" $readable] } hashmap { return [format_hashmap [dict get $nodevalue] $readable] } atom { return "(atom [pr_str $nodevalue $readable])" } function { return [format_function $nodevalue] } nativefunction { return "" } default { error "cannot print type $nodetype" } } } ================================================ FILE: impls/tcl/reader.tcl ================================================ oo::class create Reader { variable pos tokens constructor {tokens_list} { set tokens $tokens_list set pos 0 } method peek {} { lindex $tokens $pos } method next {} { set token [my peek] incr pos return $token } } proc tokenize str { set re {[\s,]*(~@|[\[\]\{\}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;[^\n]*|[^\s\[\]\{\}('\"`~^@,;)]*)} set tokens {} foreach {_ capture} [regexp -all -inline $re $str] { if {[string length $capture] > 0 && [string range $capture 0 0] != ";"} { lappend tokens $capture } } return $tokens } proc read_tokens_list {reader start_char end_char} { set token [$reader next] if {$token != $start_char} { error "expected '$start_char', got EOF" } set elements {} set token [$reader peek] while {$token != $end_char} { if {$token == ""} { error "expected '$end_char', got EOF" } lappend elements [read_form $reader] set token [$reader peek] } $reader next return $elements } proc read_list {reader} { set elements [read_tokens_list $reader "(" ")"] list_new $elements } proc read_vector {reader} { set elements [read_tokens_list $reader "\[" "\]"] vector_new $elements } proc read_hashmap {reader} { set res [dict create] foreach {keytoken valtoken} [read_tokens_list $reader "{" "}"] { dict set res [obj_val $keytoken] $valtoken } hashmap_new $res } proc parse_string {str} { set res [string range $str 1 end-1] string map {"\\n" "\n" "\\\"" "\"" "\\\\" "\\"} $res } proc parse_keyword {str} { # Remove initial ":" string range $str 1 end } proc read_atom {reader} { set token [$reader next] switch -regexp $token { ^-?[0-9]+$ { return [obj_new "integer" $token] } ^nil$ { return $::mal_nil } ^true$ { return $::mal_true } ^false$ { return $::mal_false } ^: { return [keyword_new [parse_keyword $token]] } ^\"(\\\\.|[^\\\\\"])*\"$ { return [string_new [parse_string $token]] } ^\" { error "expected '\"', got EOF" } default { return [symbol_new $token] } } } proc symbol_shortcut {symbol_name reader} { $reader next list_new [list [symbol_new $symbol_name] [read_form $reader]] } proc read_form {reader} { switch [$reader peek] { "'" { return [symbol_shortcut "quote" $reader] } "`" { return [symbol_shortcut "quasiquote" $reader] } "~" { return [symbol_shortcut "unquote" $reader] } "~@" { return [symbol_shortcut "splice-unquote" $reader] } "^" { $reader next set meta [read_form $reader] return [list_new [list [symbol_new "with-meta"] [read_form $reader] $meta]] } "@" { return [symbol_shortcut "deref" $reader] } "(" { return [read_list $reader] } ")" { error "unexpected ')'" } "\[" { return [read_vector $reader] } "\]" { error "unexpected '\]'" } "\{" { return [read_hashmap $reader] } "\}" { error "unexpected '\}'" } default { return [read_atom $reader] } } } proc read_str str { set tokens [tokenize $str] set reader [Reader new $tokens] set res [read_form $reader] $reader destroy return $res } ================================================ FILE: impls/tcl/run ================================================ #!/usr/bin/env bash exec tclsh $(dirname $0)/${STEP:-stepA_mal}.tcl ${RAW:+--raw} "${@}" ================================================ FILE: impls/tcl/step0_repl.tcl ================================================ source mal_readline.tcl proc READ str { return $str } proc EVAL {ast env} { return $ast } proc PRINT exp { return $exp } proc REP str { PRINT [EVAL [READ $str] {}] } fconfigure stdout -translation binary # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } puts [REP $line] } puts "" ================================================ FILE: impls/tcl/step1_read_print.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl proc READ str { read_str $str } proc EVAL {ast env} { return $ast } proc PRINT exp { pr_str $exp 1 } proc REP str { PRINT [EVAL [READ $str] {}] } fconfigure stdout -translation binary # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line] } exception] } { puts "Error: $exception" } } puts "" ================================================ FILE: impls/tcl/step2_eval.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl proc READ str { read_str $str } proc EVAL {ast env} { switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] if {[dict exists $env $varname]} { return [dict get $env $varname] } else { error "'$varname' not found" } } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast } set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] apply $f $call_args } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc mal_add {a} { integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] } proc mal_sub {a} { integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] } proc mal_mul {a} { integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] } proc mal_div {a} { integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] } set repl_env [dict create \ "+" {{a} {mal_add $a}} \ "-" {{a} {mal_sub $a}} \ "*" {{a} {mal_mul $a}} \ "/" {{a} {mal_div $a}} \ ] fconfigure stdout -translation binary # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" } } puts "" ================================================ FILE: impls/tcl/step3_env.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl proc READ str { read_str $str } proc EVAL {ast env} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast } set a1 [lindex [obj_val $ast] 1] set a2 [lindex [obj_val $ast] 2] switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } return [EVAL $a2 $letenv] } default { set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] return [apply $f $call_args] } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc mal_add {a} { integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] } proc mal_sub {a} { integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] } proc mal_mul {a} { integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] } proc mal_div {a} { integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] } set repl_env [Env new] $repl_env set "+" {{a} {mal_add $a}} $repl_env set "-" {{a} {mal_sub $a}} $repl_env set "*" {{a} {mal_mul $a}} $repl_env set "/" {{a} {mal_div $a}} fconfigure stdout -translation binary # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" } } puts "" ================================================ FILE: impls/tcl/step4_if_fn_do.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } proc EVAL {ast env} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } return [EVAL $a2 $letenv] } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } return [EVAL [lindex [obj_val $ast] end] $env] } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } return [EVAL $a3 $env] } return [EVAL $a2 $env] } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { function { set funcdict [obj_val $f] set body [dict get $funcdict body] set env [dict get $funcdict env] set binds [dict get $funcdict binds] set funcenv [Env new $env $binds $call_args] return [EVAL $body $funcenv] } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/step5_tco.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/step6_file.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } proc mal_eval {a} { global repl_env EVAL [lindex $a 0] $repl_env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } $repl_env set "eval" [nativefunction_new mal_eval] set argv_list {} foreach arg [lrange $argv 1 end] { lappend argv_list [string_new $arg] } $repl_env set "*ARGV*" [list_new $argv_list] # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } if {$argc > 0} { REP "(load-file \"[lindex $argv 0]\")" $repl_env exit } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/step7_quote.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } 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} { 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 } } } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "quote" { return $a1 } "quasiquote" { set ast [quasiquote $a1] } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set lst {} foreach element [obj_val $ast] { lappend lst [EVAL $element $env] } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } proc mal_eval {a} { global repl_env EVAL [lindex $a 0] $repl_env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } $repl_env set "eval" [nativefunction_new mal_eval] set argv_list {} foreach arg [lrange $argv 1 end] { lappend argv_list [string_new $arg] } $repl_env set "*ARGV*" [list_new $argv_list] # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } if {$argc > 0} { REP "(load-file \"[lindex $argv 0]\")" $repl_env exit } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/step8_macros.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } 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} { 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 } } } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "quote" { return $a1 } "quasiquote" { set ast [quasiquote $a1] } "defmacro!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set f [EVAL $a0 $env] set unevaluated_args [lrange [obj_val $ast] 1 end] if {[macro_q $f]} { set fn [obj_val $f] set f_ast [dict get $fn body] set f_env [dict get $fn env] set f_binds [dict get $fn binds] set apply_env [Env new $f_env $f_binds $unevaluated_args] set ast [EVAL $f_ast $apply_env] continue } set call_args {} foreach element $unevaluated_args { lappend call_args [EVAL $element $env] } switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } proc mal_eval {a} { global repl_env EVAL [lindex $a 0] $repl_env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } $repl_env set "eval" [nativefunction_new mal_eval] set argv_list {} foreach arg [lrange $argv 1 end] { lappend argv_list [string_new $arg] } $repl_env set "*ARGV*" [list_new $argv_list] # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } if {$argc > 0} { REP "(load-file \"[lindex $argv 0]\")" $repl_env exit } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { puts "Error: $exception" if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/step9_try.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } 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} { 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 } } } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "quote" { return $a1 } "quasiquote" { set ast [quasiquote $a1] } "defmacro!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } "try*" { if {$a2 == ""} { return [EVAL $a1 $env] } set res {} if { [catch { set res [EVAL $a1 $env] } exception] } { set exc_var [obj_val [lindex [obj_val $a2] 1]] if {$exception == "__MalException__"} { set exc_value $::mal_exception_obj } else { set exc_value [string_new $exception] } set catch_env [Env new $env [list $exc_var] [list $exc_value]] return [EVAL [lindex [obj_val $a2] 2] $catch_env] } else { return $res } } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set f [EVAL $a0 $env] set unevaluated_args [lrange [obj_val $ast] 1 end] if {[macro_q $f]} { set fn [obj_val $f] set f_ast [dict get $fn body] set f_env [dict get $fn env] set f_binds [dict get $fn binds] set apply_env [Env new $f_env $f_binds $unevaluated_args] set ast [EVAL $f_ast $apply_env] continue } set call_args {} foreach element $unevaluated_args { lappend call_args [EVAL $element $env] } switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } proc mal_eval {a} { global repl_env EVAL [lindex $a 0] $repl_env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } $repl_env set "eval" [nativefunction_new mal_eval] set argv_list {} foreach arg [lrange $argv 1 end] { lappend argv_list [string_new $arg] } $repl_env set "*ARGV*" [list_new $argv_list] # core.mal: defined using the language itself RE "(def! not (fn* (a) (if a false true)))" $repl_env RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } if {$argc > 0} { REP "(load-file \"[lindex $argv 0]\")" $repl_env exit } # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { if {$exception == "__MalException__"} { set res [pr_str $::mal_exception_obj 1] puts "Error: $res" } else { puts "Error: $exception" } if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/stepA_mal.tcl ================================================ source mal_readline.tcl source types.tcl source reader.tcl source printer.tcl source env.tcl source core.tcl proc READ str { read_str $str } 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} { 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 } } } proc EVAL {ast env} { while {true} { set dbgenv [$env find "DEBUG-EVAL"] if {$dbgenv != 0} { set dbgeval [$env get "DEBUG-EVAL"] if {![false_q $dbgeval] && ![nil_q $dbgeval]} { set img [PRINT $ast] puts "EVAL: ${img}" } } switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { } "vector" { set res {} foreach element [obj_val $ast] { lappend res [EVAL $element $env] } return [vector_new $res] } "hashmap" { set res [dict create] dict for {k v} [obj_val $ast] { dict set res $k [EVAL $v $env] } return [hashmap_new $res] } default { return $ast } } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast } switch [obj_val $a0] { "def!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname $value] } "let*" { set letenv [Env new $env] set bindings_list [obj_val $a1] foreach {varnameobj varvalobj} $bindings_list { $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv] } set ast $a2 set env $letenv # TCO: Continue loop } "quote" { return $a1 } "quasiquote" { set ast [quasiquote $a1] } "defmacro!" { set varname [obj_val $a1] set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } "tcl*" { return [string_new [eval [obj_val $a1]]] } "try*" { if {$a2 == ""} { return [EVAL $a1 $env] } set res {} if { [catch { set res [EVAL $a1 $env] } exception] } { set exc_var [obj_val [lindex [obj_val $a2] 1]] if {$exception == "__MalException__"} { set exc_value $::mal_exception_obj } else { set exc_value [string_new $exception] } set catch_env [Env new $env [list $exc_var] [list $exc_value]] return [EVAL [lindex [obj_val $a2] 2] $catch_env] } else { return $res } } "do" { foreach element [lrange [obj_val $ast] 1 end-1] { EVAL $element $env } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } "if" { set condval [EVAL $a1 $env] if {[false_q $condval] || [nil_q $condval]} { if {$a3 == ""} { return $::mal_nil } set ast $a3 } else { set ast $a2 } # TCO: Continue loop } "fn*" { set binds {} foreach v [obj_val $a1] { lappend binds [obj_val $v] } return [function_new $a2 $env $binds] } default { set f [EVAL $a0 $env] set unevaluated_args [lrange [obj_val $ast] 1 end] if {[macro_q $f]} { set fn [obj_val $f] set f_ast [dict get $fn body] set f_env [dict get $fn env] set f_binds [dict get $fn binds] set apply_env [Env new $f_env $f_binds $unevaluated_args] set ast [EVAL $f_ast $apply_env] continue } set call_args {} foreach element $unevaluated_args { lappend call_args [EVAL $element $env] } switch [obj_type $f] { function { set fn [obj_val $f] set ast [dict get $fn body] set env [Env new [dict get $fn env] [dict get $fn binds] $call_args] # TCO: Continue loop } nativefunction { set body [concat [list [obj_val $f]] {$a}] set lambda [list {a} $body] return [apply $lambda $call_args] } default { error "Not a function" } } } } } } proc PRINT exp { pr_str $exp 1 } proc REP {str env} { PRINT [EVAL [READ $str] $env] } proc RE {str env} { EVAL [READ $str] $env } proc mal_eval {a} { global repl_env EVAL [lindex $a 0] $repl_env } set repl_env [Env new] dict for {k v} $core_ns { $repl_env set $k $v } $repl_env set "eval" [nativefunction_new mal_eval] set argv_list {} foreach arg [lrange $argv 1 end] { lappend argv_list [string_new $arg] } $repl_env set "*ARGV*" [list_new $argv_list] # core.mal: defined using the language itself RE "(def! *host-language* \"tcl\")" $repl_env RE "(def! not (fn* (a) (if a false true)))" $repl_env RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))" $repl_env RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env fconfigure stdout -translation binary set DEBUG_MODE 0 if { [array names env DEBUG] != "" && $env(DEBUG) != "0" } { set DEBUG_MODE 1 } if {$argc > 0} { REP "(load-file \"[lindex $argv 0]\")" $repl_env exit } REP "(println (str \"Mal \[\" *host-language* \"\]\"))" $repl_env # repl loop while {true} { set res [_readline "user> "] if {[lindex $res 0] == "EOF"} { break } set line [lindex $res 1] if {$line == ""} { continue } if { [catch { puts [REP $line $repl_env] } exception] } { if {$exception == "__MalException__"} { set res [pr_str $::mal_exception_obj 1] puts "Error: $res" } else { puts "Error: $exception" } if { $DEBUG_MODE } { puts $::errorInfo } } } puts "" ================================================ FILE: impls/tcl/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/tcl/tests/stepA_mal.mal ================================================ ;; Testing basic Tcl interop ;; ;; Note that in Tcl "everything is a string", so we don't have enough ;; information to convert the results to other Mal types. (tcl* "expr {3 ** 4}") ;=>"81" (tcl* "llength {a b c d}") ;=>"4" (tcl* "concat {a b} c {d e} f g") ;=>"a b c d e f g" (tcl* "puts \"hello [expr {5 + 6}] world\"") ;/hello 11 world ;=>"" (tcl* "set ::foo 8") (tcl* "expr {$::foo}") ;=>"8" (tcl* "proc mult3 {x} { expr {$x * 3} }") (tcl* "mult3 6") ;=>"18" (tcl* "string range $::tcl_version 0 1") ;=>"8." ================================================ FILE: impls/tcl/types.tcl ================================================ oo::class create MalObj { variable type val meta constructor {obj_type obj_val {obj_meta 0}} { set type $obj_type set val $obj_val set meta $obj_meta } method get_type {} { return $type } method get_val {} { return $val } method get_meta {} { return $meta } method set_val {new_val} { set val $new_val return $new_val } } proc obj_new {obj_type obj_val {obj_meta 0}} { MalObj new $obj_type $obj_val $obj_meta } proc obj_type {obj} { $obj get_type } proc obj_val {obj} { $obj get_val } proc obj_meta {obj} { $obj get_meta } proc obj_set_val {obj new_val} { $obj set_val $new_val } set ::mal_nil [obj_new "nil" {}] set ::mal_true [obj_new "true" {}] set ::mal_false [obj_new "false" {}] proc nil_q {obj} { expr {[obj_type $obj] == "nil"} } proc false_q {obj} { expr {[obj_type $obj] == "false"} } proc true_q {obj} { expr {[obj_type $obj] == "true"} } proc bool_new {val} { if {$val == 0} { return $::mal_false } else { return $::mal_true } } proc integer_new {num} { obj_new "integer" $num } proc integer_q {obj} { expr {[obj_type $obj] == "integer"} } proc symbol_new {name} { obj_new "symbol" $name } proc symbol_q {obj} { expr {[obj_type $obj] == "symbol"} } proc string_new {val} { obj_new "string" $val } proc string_q {obj} { expr {[obj_type $obj] == "string" && [string index [obj_val $obj] 0] != "\u029E"} } proc keyword_new {val} { string_new "\u029E$val" } proc keyword_q {obj} { expr {[obj_type $obj] == "string" && [string index [obj_val $obj] 0] == "\u029E"} } proc list_new {lst} { obj_new "list" $lst $::mal_nil } proc list_q {obj} { expr {[obj_type $obj] == "list"} } proc vector_new {lst} { obj_new "vector" $lst $::mal_nil } proc vector_q {obj} { expr {[obj_type $obj] == "vector"} } proc hashmap_new {lst} { obj_new "hashmap" $lst $::mal_nil } proc hashmap_q {obj} { expr {[obj_type $obj] == "hashmap"} } proc sequential_q {obj} { expr {[list_q $obj] || [vector_q $obj]} } proc sequential_equal_q {seq_a seq_b} { foreach obj_a [obj_val $seq_a] obj_b [obj_val $seq_b] { if {$obj_a == "" || $obj_b == "" || ![equal_q $obj_a $obj_b]} { return 0 } } return 1 } proc hashmap_equal_q {hashmap_a hashmap_b} { set dict_a [obj_val $hashmap_a] set dict_b [obj_val $hashmap_b] set keys_a [lsort [dict keys $dict_a]] set keys_b [lsort [dict keys $dict_b]] if {$keys_a != $keys_b} { return 0 } foreach key $keys_a { set obj_a [dict get $dict_a $key] set obj_b [dict get $dict_b $key] if {![equal_q $obj_a $obj_b]} { return 0 } } return 1 } proc equal_q {a b} { if {[sequential_q $a] && [sequential_q $b]} { sequential_equal_q $a $b } elseif {[hashmap_q $a] && [hashmap_q $b]} { hashmap_equal_q $a $b } else { expr {[obj_type $a] == [obj_type $b] && [obj_val $a] == [obj_val $b]} } } proc nativefunction_new {name} { obj_new "nativefunction" $name $::mal_nil } proc function_new {body env binds} { set funcdict [dict create body $body env $env binds $binds is_macro 0] obj_new "function" $funcdict $::mal_nil } proc macro_new {funcobj} { set fn [obj_val $funcobj] set body [dict get $fn body] set env [dict get $fn env] set binds [dict get $fn binds] set funcdict [dict create body $body env $env binds $binds is_macro 1] obj_new "function" $funcdict $::mal_nil } proc function_q {obj} { expr {[obj_type $obj] == "function"} } proc macro_q {obj} { expr {[obj_type $obj] == "function" && [dict get [obj_val $obj] is_macro]} } proc atom_new {val} { obj_new "atom" $val $::mal_nil } proc atom_q {obj} { expr {[obj_type $obj] == "atom"} } ================================================ FILE: impls/tests/busywork.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/threading.mal") ; -> (load-file-once "../lib/benchmark.mal") (load-file-once "../lib/test_cascade.mal") ; or ;; Indicate that these macros are safe to eagerly expand. ;; Provides a large performance benefit for supporting implementations. (def! and ^{:inline? true} and) (def! or ^{:inline? true} or) (def! -> ^{:inline? true} ->) (def! -> ^{:inline? true} ->>) (def! do-times (fn* [f n] (if (> n 0) (do (f) (do-times f (- n 1)))))) (def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) (def! busywork (fn* [] (do (or false nil false nil false nil false nil false nil (first @atm)) (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) (-> (deref atm) rest rest rest rest rest rest first) (swap! atm (fn* [a] (concat (rest a) (list (first a)))))))) (def! num-iterations 10000) (println (str "Execution time (in ms) of " num-iterations " busywork iterations on " *host-language* ": ") (benchmark (do-times busywork num-iterations) 10)) ================================================ FILE: impls/tests/computations.mal ================================================ ;; Some inefficient arithmetic computations for benchmarking. ;; Unfortunately not yet available in tests of steps 4 and 5. ;; Compute n(n+1)/2 with a non tail-recursive call. (def! sumdown (fn* [n] ; non-negative number (if (= n 0) 0 (+ n (sumdown (- n 1)))))) ;; Compute a Fibonacci number with two recursions. (def! fib (fn* [n] ; non-negative number (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2)))))) ================================================ FILE: impls/tests/docker/Dockerfile ================================================ # WARNING: This file is deprecated. Each implementation now has its # own Dockerfile. FROM ubuntu:utopic MAINTAINER Joel Martin ENV DEBIAN_FRONTEND noninteractive RUN echo "deb http://dl.bintray.com/sbt/debian /" > /etc/apt/sources.list.d/sbt.list RUN apt-get -y update # # General dependencies # VOLUME /mal RUN apt-get -y install make wget curl git # Deps for compiled languages (C, Go, Rust, Nim, etc) RUN apt-get -y install gcc pkg-config # Deps for Java-based languages (Clojure, Scala, Java) RUN apt-get -y install openjdk-7-jdk ENV MAVEN_OPTS -Duser.home=/mal # Deps for Mono-based languages (C#, VB.Net) RUN apt-get -y install mono-runtime mono-mcs mono-vbnc # Deps for node.js languages (JavaScript, CoffeeScript, miniMAL, etc) RUN apt-get -y install nodejs npm RUN ln -sf nodejs /usr/bin/node # # Implementation specific installs # # GNU awk RUN apt-get -y install gawk # Bash RUN apt-get -y install bash # C RUN apt-get -y install libglib2.0 libglib2.0-dev RUN apt-get -y install libffi-dev libreadline-dev libedit2 libedit-dev # C++ RUN apt-get -y install g++-4.9 libreadline-dev # Clojure ADD https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein \ /usr/local/bin/lein RUN sudo chmod 0755 /usr/local/bin/lein ENV LEIN_HOME /mal/.lein ENV LEIN_JVM_OPTS -Duser.home=/mal # CoffeeScript RUN npm install -g coffee-script RUN touch /.coffee_history && chmod go+w /.coffee_history # C# RUN apt-get -y install mono-mcs # Elixir RUN wget https://packages.erlang-solutions.com/erlang-solutions_1.0_all.deb \ && dpkg -i erlang-solutions_1.0_all.deb RUN apt-get update RUN apt-get -y install elixir # Erlang R17 (so I can use maps) RUN apt-get -y install build-essential libncurses5-dev libssl-dev RUN cd /tmp && wget http://www.erlang.org/download/otp_src_17.5.tar.gz \ && tar -C /tmp -zxf /tmp/otp_src_17.5.tar.gz \ && cd /tmp/otp_src_17.5 && ./configure && make && make install \ && rm -rf /tmp/otp_src_17.5 /tmp/otp_src_17.5.tar.gz # Rebar for building the Erlang implementation RUN cd /tmp/ && git clone -q https://github.com/rebar/rebar.git \ && cd /tmp/rebar && ./bootstrap && cp rebar /usr/local/bin \ && rm -rf /tmp/rebar # Forth RUN apt-get -y install gforth # Go RUN apt-get -y install golang # Guile RUN apt-get -y install libunistring-dev libgc-dev autoconf libtool flex gettext texinfo libgmp-dev RUN git clone git://git.sv.gnu.org/guile.git /tmp/guile \ && cd /tmp/guile && ./autogen.sh && ./configure && make && make install # Haskell RUN apt-get -y install ghc haskell-platform libghc-readline-dev libghc-editline-dev # Java RUN apt-get -y install maven2 # JavaScript # Already satisfied above # Julia RUN apt-get -y install software-properties-common RUN apt-add-repository -y ppa:staticfloat/juliareleases RUN apt-get -y update RUN apt-get -y install julia # Lua RUN apt-get -y install lua5.1 lua-rex-pcre luarocks RUN luarocks install linenoise # Mal # N/A: self-hosted on other language implementations # GNU Make # Already satisfied as a based dependency for testing # miniMAL RUN npm install -g minimal-lisp # Nim RUN cd /tmp && wget http://nim-lang.org/download/nim-0.17.0.tar.xz \ && tar xvJf /tmp/nim-0.17.0.tar.xz && cd nim-0.17.0 \ && make && sh install.sh /usr/local/bin \ && rm -r /tmp/nim-0.17.0 # OCaml RUN apt-get -y install ocaml-batteries-included # perl RUN apt-get -y install perl # PHP RUN apt-get -y install php5-cli # PostScript/ghostscript RUN apt-get -y install ghostscript # python RUN apt-get -y install python # R RUN apt-get -y install r-base-core # Racket RUN apt-get -y install racket # Ruby RUN apt-get -y install ruby # Rust RUN curl -sf https://raw.githubusercontent.com/brson/multirust/master/blastoff.sh | sh # Scala RUN apt-get -y --force-yes install sbt RUN apt-get -y install scala ENV SBT_OPTS -Duser.home=/mal # VB.Net RUN apt-get -y install mono-vbnc # TODO: move up # Factor RUN apt-get -y install libgtkglext1 RUN cd /usr/lib/x86_64-linux-gnu/ \ && wget http://downloads.factorcode.org/releases/0.97/factor-linux-x86-64-0.97.tar.gz \ && tar xvzf factor-linux-x86-64-0.97.tar.gz \ && ln -sf /usr/lib/x86_64-linux-gnu/factor/factor /usr/bin/factor \ && rm factor-linux-x86-64-0.97.tar.gz # MATLAB is proprietary/licensed. Maybe someday with Octave. # Swift is Xcode/macOS only ENV SKIP_IMPLS matlab swift ENV DEBIAN_FRONTEND newt ENV HOME / WORKDIR /mal ================================================ FILE: impls/tests/docker-build.sh ================================================ #!/usr/bin/env bash IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} GIT_TOP=$(git rev-parse --show-toplevel) docker build -t "${IMAGE_NAME}" "${GIT_TOP}/tests/docker" ================================================ FILE: impls/tests/docker-run.sh ================================================ #!/usr/bin/env bash IMAGE_NAME=${IMAGE_NAME:-mal-test-ubuntu-utopic} GIT_TOP=$(git rev-parse --show-toplevel) docker run -it --rm -u ${EUID} \ --volume=${GIT_TOP}:/mal \ ${IMAGE_NAME} \ "${@}" ================================================ FILE: impls/tests/fib.mal ================================================ (load-file "../lib/benchmark.mal") (def! fib (fn* [n] (if (= n 0) 1 (if (= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (let* [n (read-string (first *ARGV*)) iters (read-string (first (rest *ARGV*)))] (println (str "Times (in ms) for (fib " n ") on " *host-language* ": ") (benchmark (fib n) iters))) ================================================ FILE: impls/tests/inc.mal ================================================ (def! inc1 (fn* (a) (+ 1 a))) (def! inc2 (fn* (a) (+ 2 a))) (def! inc3 (fn* (a) (+ 3 a))) ================================================ FILE: impls/tests/incA.mal ================================================ (def! inc4 (fn* (a) (+ 4 a))) (prn (inc4 5)) ================================================ FILE: impls/tests/incB.mal ================================================ ;; A comment in a file (def! inc4 (fn* (a) (+ 4 a))) (def! inc5 (fn* (a) ;; a comment after code (+ 5 a))) ;; ending comment without final new line ================================================ FILE: impls/tests/incC.mal ================================================ (def! mymap {"a" 1}) ================================================ FILE: impls/tests/lib/alias-hacks.mal ================================================ ;; Testing alias-hacks.mal (load-file "../lib/load-file-once.mal") (load-file-once "../lib/alias-hacks.mal") ;=>nil ;; Testing let (macroexpand (let binds a b)) ;=>(let* binds (do a b)) (let [x 2] 3 x) ;=>2 ;; Testing when (macroexpand (when condition a b)) ;=>(if condition (do a b)) (when false (nth () 0) a) ;=>nil (when true 3 2) ;=>2 ;; Testing name (macroexpand (def name a b)) ;=>(def! name (do a b)) (def x 1 2 3) ;=>3 x ;=>3 ;; Testing fn (macroexpand (fn args a b)) ;=>(fn* args (do a b)) ((fn [x] 1 2) 3) ;=>2 ;; Testing defn (macroexpand (defn name args b)) ;=>(def! name (fn args b)) (defn f [x] 1 2 x) (f 3) ;=>3 ;; Testing partial ((partial +) 1 2) ;=>3 ((partial + 1) 2) ;=>3 ((partial + 1 2)) ;=>3 ((partial not) false) ;=>true ((partial not false)) ;=>true ((partial (fn* [x y] (+ x y)) 1) 2) ;=>3 ((partial str 1 2) 3 4) ;=>"1234" ================================================ FILE: impls/tests/lib/equality.mal ================================================ (def! orig= =) ;; Testing equality.mal does not fix built-in equality. (load-file "../lib/equality.mal") ;=>nil ;; Testing bool-and (bool-and) ;=>true (bool-and true) ;=>true (bool-and false) ;=>false (bool-and nil) ;=>false (bool-and 1) ;=>true (bool-and 1 2) ;=>true (bool-and nil (nth () 1)) ;=>false ;; Testing bool-or (bool-or) ;=>false (bool-or true) ;=>true (bool-or false) ;=>false (bool-or nil) ;=>false (bool-or 1) ;=>true (bool-or 1 (nth () 1)) ;=>true (bool-or 1 2) ;=>true (bool-or false nil) ;=>false ;; Breaking equality. (def! = (fn* [a b] (bool-and (orig= a b) (cond (list? a) (list? b) (vector? a) (vector? b) true true)))) (= [] ()) ;=>false ;; Testing that equality.mal detects the problem. (load-file "../lib/equality.mal") ;/equality.mal: Replaced = with pure mal implementation ;=>nil ;; Testing fixed equality. (= [] ()) ;=>true (= [:a :b] (list :a :b)) ;=>true (= [:a :b] [:a :b :c]) ;=>false (= {:a 1} {:a 1}) ;=>true (= {:a 1} {:a 1 :b 2}) ;=>false ================================================ FILE: impls/tests/lib/load-file-once-inc.mal ================================================ (swap! counter (fn* [x] (+ 1 x))) ================================================ FILE: impls/tests/lib/load-file-once.mal ================================================ (def! counter (atom 0)) ;=>(atom 0) ;; The counter is increased by each `load-file`. (load-file "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>1 (load-file "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>2 ;; load-file-once is available (load-file "../lib/load-file-once.mal") ;=>nil ;; First import actually calls `load-file`. (load-file-once "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>3 ;; Later imports do nothing. (load-file-once "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>3 ;; Loading the module twice does not reset its memory. (load-file "../lib/load-file-once.mal") ;=>nil (load-file-once "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>3 ;; even if done with itself (load-file-once "../lib/load-file-once.mal") ;=>nil (load-file-once "../tests/lib/load-file-once-inc.mal") ;=>nil @counter ;=>3 ================================================ FILE: impls/tests/lib/memoize.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../tests/computations.mal") (load-file-once "../lib/memoize.mal") ;=>nil (def! N 32) ;; Benchmark naive 'fib' (def! r1 (fib N)) ; Should be slow ;; Benchmark memoized 'fib' (def! fib (memoize fib)) (def! r2 (fib N)) ; Should be quick (= r1 r2) ;=>true ================================================ FILE: impls/tests/lib/pprint.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/pprint.mal") ;=>nil (pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16)) ;/\(7 ;/ 8 ;/ 9 ;/ "ten" ;/ \[11 ;/ 12 ;/ \[13 ;/ 14\]\] ;/ 15 ;/ 16\) ;=>nil (pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}}) ;/\{:abc 123 ;/ :def \{:ghi 456 ;/ :jkl \[789 ;/ "ten eleven twelve"\]\}\} ;=>nil (pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16)) ;/\(7 ;/ 8 ;/ \{:abc 123 ;/ :def \{:ghi 456 ;/ :jkl 789\}\} ;/ 9 ;/ 10 ;/ \[11 ;/ 12 ;/ \[13 ;/ 14\]\] ;/ 15 ;/ 16\) ;=>nil ================================================ FILE: impls/tests/lib/protocols.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/protocols.mal") ;=>nil ;; Testing find-type for normal objects. (find-type 'a) ;=>:mal/symbol (find-type :a) ;=>:mal/keyword (find-type (atom 0)) ;=>:mal/atom (find-type nil) ;=>:mal/nil (find-type true) ;=>:mal/boolean (find-type false) ;=>:mal/boolean (find-type 0) ;=>:mal/number (find-type "") ;=>:mal/string (find-type (defmacro! m (fn* [] nil))) ;=>:mal/macro (find-type ()) ;=>:mal/list (find-type []) ;=>:mal/vector (find-type {}) ;=>:mal/map (find-type (fn* [] nil)) ;=>:mal/function ;; Testing find-type for explicit type metadata. (find-type ^{:type :a } ()) ;=>:a (find-type ^{:type :a } []) ;=>:a (find-type ^{:type :a } {}) ;=>:a (find-type ^{:type :a } (fn* [] nil)) ;=>:a ;; Testing protocols. (def! o1 ^{:type :t1 } [1]) (def! o2 ^{:type :t2 } [2]) (defprotocol p1 [m0 [this]] [ma [this a]] [mb [this & b]]) (defprotocol p2) (satisfies? p1 o1) ;=>false (satisfies? p1 o2) ;=>false (satisfies? p2 o1) ;=>false (satisfies? p2 o2) ;=>false (extend :t1 p1 { :m0 (fn* [this] (str "t0" this)) :ma (fn* [this a] (str "ta" this a)) :mb (fn* [this & b] (str "tb" this b))}) ;=>nil (extend :t2 p1 { :m0 (fn* [this] (str "u0" this)) :ma (fn* [this a] (str "ua" this a)) :mb (fn* [this & b] (str "ub" this b))} p2 {}) ;=>nil (satisfies? p1 o1) ;=>true (satisfies? p1 o2) ;=>true (satisfies? p2 o1) ;=>false (satisfies? p2 o2) ;=>true ;; Testing dispatching. (m0 o1) ;=>"t0[1]" (ma o1 "blue") ;=>"ta[1]blue" (mb o1 1 2 3) ;=>"tb[1](1 2 3)" (m0 o2) ;=>"u0[2]" (ma o2 "blue") ;=>"ua[2]blue" (mb o2 1 2 3) ;=>"ub[2](1 2 3)" ================================================ FILE: impls/tests/lib/reducers.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/reducers.mal") ;=>nil ;; Testing reduce (reduce + 7 []) ;=>7 (reduce + 7 [1]) ;=>8 (reduce + 7 [1 2]) ;=>10 (reduce * 7 [-1 2]) ;=>-14 (reduce concat [1] [[2] [3]]) ;=>(1 2 3) (reduce str "a" ["b" "c"]) ;=>"abc" ;; Testing foldr (foldr + 7 []) ;=>7 (foldr + 7 [1]) ;=>8 (foldr + 7 [1 2]) ;=>10 (reduce * 7 [-1 2]) ;=>-14 (foldr concat [1] [[2] [3]]) ;=>(2 3 1) (foldr str "a" ["b" "c"]) ;=>"bca" (foldr cons [4 5] [2 3]) ;=>(2 3 4 5) ================================================ FILE: impls/tests/lib/test_cascade.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/test_cascade.mal") ;=>nil ;; Testing or (or) ;=>nil (or 1) ;=>1 (or 1 2 3 4) ;=>1 (or false 2) ;=>2 (or false nil 3) ;=>3 (or false nil false false nil 4) ;=>4 (or false nil 3 false nil 4) ;=>3 (or (or false 4)) ;=>4 ;; Testing every? (every? first []) ;=>true (every? first [[1] [2]]) ;=>true (every? first [[1] [nil] []]) ;=>false ;; Testing some (some first []) ;=>nil (some first [[nil] [1] []]) ;=>1 (and) ;=>true (and 1) ;=>1 (and 1 2 3 4) ;=>4 (and false 2) ;=>false (and true 1 nil false) ;=>nil ================================================ FILE: impls/tests/lib/threading.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/threading.mal") ;=>nil ;; Testing -> macro (-> 7) ;=>7 (-> (list 7 8 9) first) ;=>7 (-> (list 7 8 9) (first)) ;=>7 (-> (list 7 8 9) first (+ 7)) ;=>14 (-> (list 7 8 9) rest (rest) first (+ 7)) ;=>16 ;; Testing ->> macro (->> "L") ;=>"L" (->> "L" (str "A") (str "M")) ;=>"MAL" (->> [4] (concat [3]) (concat [2]) rest (concat [1])) ;=>(1 3 4) ================================================ FILE: impls/tests/lib/trivial.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/trivial.mal") ;=>nil (inc 12) ;=>13 (dec 12) ;=>11 (zero? 12) ;=>false (zero? 0) ;=>true (identity 12) ;=>12 (= (gensym) (gensym)) ;=>false ================================================ FILE: impls/tests/perf1.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/threading.mal") ; -> (load-file-once "../lib/perf.mal") ; time (load-file-once "../lib/test_cascade.mal") ; or ;;(prn "Start: basic macros performance test") (time (do (or false nil false nil false nil false nil false nil 4) (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" 7) (-> (list 1 2 3 4 5 6 7 8 9) rest rest rest rest rest rest first))) ;;(prn "Done: basic macros performance test") ================================================ FILE: impls/tests/perf2.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../tests/computations.mal") ; fib sumdown (load-file-once "../lib/perf.mal") ; time ;;(prn "Start: basic math/recursion test") (time (do (sumdown 10) (fib 12))) ;;(prn "Done: basic math/recursion test") ================================================ FILE: impls/tests/perf3.mal ================================================ (load-file "../lib/load-file-once.mal") (load-file-once "../lib/threading.mal") ; -> (load-file-once "../lib/perf.mal") ; run-fn-for (load-file-once "../lib/test_cascade.mal") ; or ;;(prn "Start: basic macros/atom test") (def! atm (atom (list 0 1 2 3 4 5 6 7 8 9))) (println "iters over 10 seconds:" (run-fn-for (fn* [] (do (or false nil false nil false nil false nil false nil (first @atm)) (cond false 1 nil 2 false 3 nil 4 false 5 nil 6 "else" (first @atm)) (-> (deref atm) rest rest rest rest rest rest first) (swap! atm (fn* [a] (concat (rest a) (list (first a))))))) 10)) ;;(prn "Done: basic macros/atom test") ================================================ FILE: impls/tests/print_argv.mal ================================================ ; Used by the run_argv_test.sh test harness (prn *ARGV*) ================================================ FILE: impls/tests/run_argv_test.sh ================================================ #!/usr/bin/env bash # # Usage: run_argv_test.sh # # Example: run_argv_test.sh python step6_file.py # assert_equal() { if [ "$1" = "$2" ] ; then echo "OK: '$1'" else echo "FAIL: Expected '$1' but got '$2'" echo exit 1 fi } if [ -z "$1" ] ; then echo "Usage: $0 " exit 1 fi root="$(dirname $0)" out="$( $@ $root/print_argv.mal aaa bbb ccc | tr -d '\r' )" assert_equal '("aaa" "bbb" "ccc")' "$out" # Note: The 'make' implementation cannot handle arguments with spaces in them, # so for now we skip this test. # # out="$( $@ $root/print_argv.mal aaa 'bbb ccc' ddd )" # assert_equal '("aaa" "bbb ccc" "ddd")' "$out" out="$( $@ $root/print_argv.mal | tr -d '\r' )" assert_equal '()' "$out" echo 'Passed all *ARGV* tests' echo ================================================ FILE: impls/tests/step0_repl.mal ================================================ ;; Testing basic string abcABC123 ;=>abcABC123 ;; Testing string containing spaces hello mal world ;=>hello mal world ;; Testing string containing symbols []{}"'* ;:() ;=>[]{}"'* ;:() ;; Test long string hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) ;=>hello world abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 (;:() []{}"'* ;:() []{}"'* ;:() []{}"'*) ;; Non alphanumeric characters ! ;=>! & ;=>& + ;=>+ , ;=>, - ;=>- / ;=>/ < ;=>< = ;=>= > ;=>> ? ;=>? @ ;=>@ ;;; Behaviour of backslash is not specified enough to test anything in step0. ^ ;=>^ _ ;=>_ ` ;=>` ~ ;=>~ ;>>> soft=True ;>>> optional=True ;; ------- Optional Functionality -------------- ;; ------- (Not needed for self-hosting) ------- ;; Non alphanumeric characters # ;=># $ ;=>$ % ;=>% . ;=>. | ;=>| ================================================ FILE: impls/tests/step1_read_print.mal ================================================ ;; Testing read of numbers 1 ;=>1 7 ;=>7 7 ;=>7 -123 ;=>-123 ;; Testing read of symbols + ;=>+ abc ;=>abc abc ;=>abc abc5 ;=>abc5 abc-def ;=>abc-def ;; Testing non-numbers starting with a dash. - ;=>- -abc ;=>-abc ->> ;=>->> ;; Testing read of lists (+ 1 2) ;=>(+ 1 2) () ;=>() ( ) ;=>() (nil) ;=>(nil) ((3 4)) ;=>((3 4)) (+ 1 (+ 2 3)) ;=>(+ 1 (+ 2 3)) ( + 1 (+ 2 3 ) ) ;=>(+ 1 (+ 2 3)) (* 1 2) ;=>(* 1 2) (** 1 2) ;=>(** 1 2) (* -3 6) ;=>(* -3 6) (()()) ;=>(() ()) ;; Test commas as whitespace (1 2, 3,,,,),, ;=>(1 2 3) ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing read of nil/true/false nil ;=>nil true ;=>true false ;=>false ;; Testing read of strings "abc" ;=>"abc" "abc" ;=>"abc" "abc (with parens)" ;=>"abc (with parens)" "abc\"def" ;=>"abc\"def" "" ;=>"" "\\" ;=>"\\" "\\\\\\\\\\\\\\\\\\" ;=>"\\\\\\\\\\\\\\\\\\" "&" ;=>"&" "'" ;=>"'" "(" ;=>"(" ")" ;=>")" "*" ;=>"*" "+" ;=>"+" "," ;=>"," "-" ;=>"-" "/" ;=>"/" ":" ;=>":" ";" ;=>";" "<" ;=>"<" "=" ;=>"=" ">" ;=>">" "?" ;=>"?" "@" ;=>"@" "[" ;=>"[" "]" ;=>"]" "^" ;=>"^" "_" ;=>"_" "`" ;=>"`" "{" ;=>"{" "}" ;=>"}" "~" ;=>"~" "!" ;=>"!" ;; Testing reader errors (1 2 ;/.*(EOF|end of input|unbalanced).* [1 2 ;/.*(EOF|end of input|unbalanced).* {"a" 2 ;/.*(EOF|end of input|unbalanced).* ;;; These should throw some error with no return value "abc ;/.*(EOF|end of input|unbalanced).* " ;/.*(EOF|end of input|unbalanced).* "\" ;/.*(EOF|end of input|unbalanced).* "\\\\\\\\\\\\\\\\\\\" ;/.*(EOF|end of input|unbalanced).* (1 "abc ;/.*(EOF|end of input|unbalanced).* (1 "abc" ;/.*(EOF|end of input|unbalanced).* ;; Testing read of quoting '1 ;=>(quote 1) '(1 2 3) ;=>(quote (1 2 3)) `1 ;=>(quasiquote 1) `(1 2 3) ;=>(quasiquote (1 2 3)) `(a (b) c) ;=>(quasiquote (a (b) c)) ~1 ;=>(unquote 1) ~(1 2 3) ;=>(unquote (1 2 3)) `(1 ~a 3) ;=>(quasiquote (1 (unquote a) 3)) ~@(1 2 3) ;=>(splice-unquote (1 2 3)) ;; Testing keywords :kw ;=>:kw (:kw1 :kw2 :kw3) ;=>(:kw1 :kw2 :kw3) ;; Testing read of vectors [+ 1 2] ;=>[+ 1 2] [] ;=>[] [ ] ;=>[] [[3 4]] ;=>[[3 4]] [+ 1 [+ 2 3]] ;=>[+ 1 [+ 2 3]] [ + 1 [+ 2 3 ] ] ;=>[+ 1 [+ 2 3]] ([]) ;=>([]) ;; Testing read of hash maps {} ;=>{} { } ;=>{} {"abc" 1} ;=>{"abc" 1} {"a" {"b" 2}} ;=>{"a" {"b" 2}} {"a" {"b" {"c" 3}}} ;=>{"a" {"b" {"c" 3}}} { "a" {"b" { "cde" 3 } }} ;=>{"a" {"b" {"cde" 3}}} ;;; The regexp sorcery here ensures that each key goes with the correct ;;; value and that each key appears only once. {"a1" 1 "a2" 2 "a3" 3} ;/{"a([1-3])" \1 "a(?!\1)([1-3])" \2 "a(?!\1)(?!\2)([1-3])" \3} { :a {:b { :cde 3 } }} ;=>{:a {:b {:cde 3}}} {"1" 1} ;=>{"1" 1} ({}) ;=>({}) ;; Testing read of comments ;; whole line comment (not an exception) 1 ; comment after expression ;=>1 1; comment after expression ;=>1 ;; Testing read of @/deref @a ;=>(deref a) ;; Colon character inside a symbol a: ;=>a: ;>>> soft=True ;>>> optional=True ;; ;; -------- Optional Functionality -------- ;; Testing read of ^/metadata ^{"a" 1} [1 2 3] ;=>(with-meta [1 2 3] {"a" 1}) ^2 [1 2 3] ;=>(with-meta [1 2 3] 2) ;; Non alphanumeric characters in strings ;;; \t is not specified enough to be tested "\n" ;=>"\n" "#" ;=>"#" "$" ;=>"$" "%" ;=>"%" "." ;=>"." "\\" ;=>"\\" "|" ;=>"|" ;; Non alphanumeric characters in comments 1;! ;=>1 1;" ;=>1 1;# ;=>1 1;$ ;=>1 1;% ;=>1 1;' ;=>1 1;\ ;=>1 1;\\ ;=>1 1;\\\ ;=>1 1;` ;=>1 ;;; Hopefully less problematic characters 1; &()*+,-./:;<=>?@[]^_{|}~ ;=>1 ================================================ FILE: impls/tests/step2_eval.mal ================================================ ;; Testing evaluation of arithmetic operations (+ 1 2) ;=>3 (+ 5 (* 2 3)) ;=>11 (- (+ 5 (* 2 3)) 3) ;=>8 (/ (- (+ 5 (* 2 3)) 3) 4) ;=>2 (/ (- (+ 515 (* 87 311)) 302) 27) ;=>1010 (* -3 6) ;=>-18 (/ (- (+ 515 (* -87 311)) 296) 27) ;=>-994 ;;; This should throw an error with no return value (abc 1 2 3) ;/.+ ;; Testing empty list () ;=>() ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing nil inside vector [nil] ;=>[nil] ;; Testing evaluation within collection literals [1 2 (+ 1 2)] ;=>[1 2 3] {"a" (+ 7 8)} ;=>{"a" 15} {:a (+ 7 8)} ;=>{:a 15} ;; Check that evaluation hasn't broken empty collections [] ;=>[] {} ;=>{} ================================================ FILE: impls/tests/step3_env.mal ================================================ ;; Testing REPL_ENV (+ 1 2) ;=>3 (/ (- (+ 5 (* 2 3)) 3) 4) ;=>2 ;; Testing def! (def! x 3) ;=>3 x ;=>3 (def! x 4) ;=>4 x ;=>4 (def! y (+ 1 7)) ;=>8 y ;=>8 ;; Verifying symbols are case-sensitive (def! mynum 111) ;=>111 (def! MYNUM 222) ;=>222 mynum ;=>111 MYNUM ;=>222 ;; Check env lookup non-fatal error (abc 1 2 3) ;/.*'?abc'? not found.* ;; Check that error aborts def! (def! w 123) (def! w (abc)) w ;=>123 ;; Testing let* (let* (z 9) z) ;=>9 (let* (x 9) x) ;=>9 x ;=>4 (let* (z (+ 2 3)) (+ 1 z)) ;=>6 (let* (p (+ 2 3) q (+ 2 p)) (+ p q)) ;=>12 (def! y (let* (z 7) z)) y ;=>7 ;; Testing outer environment (def! a 4) ;=>4 (let* (q 9) q) ;=>9 (let* (q 9) a) ;=>4 (let* (z 2) (let* (q 9) a)) ;=>4 ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing let* with vector bindings (let* [z 9] z) ;=>9 (let* [p (+ 2 3) q (+ 2 p)] (+ p q)) ;=>12 ;; Testing vector evaluation (let* (a 5 b 6) [3 4 a [b 7] 8]) ;=>[3 4 5 [6 7] 8] ;>>> soft=True ;>>> optional=True ;; ;; -------- Optional Functionality -------- ;; Check that last assignment takes priority (let* (x 2 x 3) x) ;=>3 ;; Check DEBUG-EVAL (let* (DEBUG-EVAL false) (- 3 1)) ;=>2 (let* (DEBUG-EVAL nil) (- 3 1)) ;=>2 ;;; Some implementations avoid a recursive EVAL when the first element ;;; is a symbol or when map(EVAL, list) encounters a number. (let* (a 3 b 2 DEBUG-EVAL true) (- a b)) ;/EVAL: \(- a b\).*\n1 ;; Check the readably pretty-printing option (let* (DEBUG-EVAL 1) "a") ;/EVAL: "a".*\n"a" ;; Usually false values (let* (a 3 DEBUG-EVAL ()) a) ;/EVAL: a.*\n3 (let* (a 3 DEBUG-EVAL 0) a) ;/EVAL: a.*\n3 (let* (a 3 DEBUG-EVAL "") a) ;/EVAL: a.*\n3 ================================================ FILE: impls/tests/step4_if_fn_do.mal ================================================ ;; ----------------------------------------------------- ;; Testing list functions (list) ;=>() (list? (list)) ;=>true (list? nil) ;=>false (empty? (list)) ;=>true (empty? (list 1)) ;=>false (list 1 2 3) ;=>(1 2 3) (count (list 1 2 3)) ;=>3 (count (list)) ;=>0 (count nil) ;=>0 (if (> (count (list 1 2 3)) 3) 89 78) ;=>78 (if (>= (count (list 1 2 3)) 3) 89 78) ;=>89 ;; Testing if form (if true 7 8) ;=>7 (if false 7 8) ;=>8 (if false 7 false) ;=>false (if true (+ 1 7) (+ 1 8)) ;=>8 (if false (+ 1 7) (+ 1 8)) ;=>9 (if nil 7 8) ;=>8 (if 0 7 8) ;=>7 (if (list) 7 8) ;=>7 (if (list 1 2 3) 7 8) ;=>7 (= (list) nil) ;=>false ;; Testing 1-way if form (if false (+ 1 7)) ;=>nil (if nil 8) ;=>nil (if nil 8 7) ;=>7 (if true (+ 1 7)) ;=>8 ;; Testing basic conditionals (= 2 1) ;=>false (= 1 1) ;=>true (= 1 2) ;=>false (= 1 (+ 1 1)) ;=>false (= 2 (+ 1 1)) ;=>true (> 2 1) ;=>true (> 1 1) ;=>false (> 1 2) ;=>false (>= 2 1) ;=>true (>= 1 1) ;=>true (>= 1 2) ;=>false (< 2 1) ;=>false (< 1 1) ;=>false (< 1 2) ;=>true (<= 2 1) ;=>false (<= 1 1) ;=>true (<= 1 2) ;=>true ;; Testing equality and the representation of nil false true (= 1 1) ;=>true (= 0 0) ;=>true (= 1 0) ;=>false (= nil nil) ;=>true (= nil false) ;=>false (= nil true) ;=>false (= nil 0) ;=>false (= nil 1) ;=>false (= nil "") ;=>false (= nil ()) ;=>false (= nil []) ;=>false (= false nil) ;=>false (= false false) ;=>true (= false true) ;=>false (= false 0) ;=>false (= false 1) ;=>false (= false "") ;=>false (= false ()) ;=>false (= true nil) ;=>false (= true false) ;=>false (= true true) ;=>true (= true 0) ;=>false (= true 1) ;=>false (= true "") ;=>false (= true ()) ;=>false (= (list) (list)) ;=>true (= (list) ()) ;=>true (= (list 1 2) (list 1 2)) ;=>true (= (list 1) (list)) ;=>false (= (list) (list 1)) ;=>false (= 0 (list)) ;=>false (= (list) 0) ;=>false (= (list nil) (list)) ;=>false ;; Testing builtin and user defined functions (+ 1 2) ;=>3 ( (fn* (a b) (+ b a)) 3 4) ;=>7 ( (fn* () 4) ) ;=>4 ( (fn* () ()) ) ;=>() ( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7) ;=>8 ;; Testing closures ( ( (fn* (a) (fn* (b) (+ a b))) 5) 7) ;=>12 (def! gen-plus5 (fn* () (fn* (b) (+ 5 b)))) (def! plus5 (gen-plus5)) (plus5 7) ;=>12 (def! gen-plusX (fn* (x) (fn* (b) (+ x b)))) (def! plus7 (gen-plusX 7)) (plus7 8) ;=>15 (let* [b 0 f (fn* [] b)] (let* [b 1] (f))) ;=>0 ((let* [b 0] (fn* [] b))) ;=>0 ;; Testing do form (do (prn 101)) ;/101 ;=>nil (do (prn 102) 7) ;/102 ;=>7 (do (prn 101) (prn 102) (+ 1 2)) ;/101 ;/102 ;=>3 (do (def! a 6) 7 (+ a 8)) ;=>14 a ;=>6 ;; Testing special form case-sensitivity (def! DO (fn* (a) 7)) (DO 3) ;=>7 ;; Testing recursive sumdown function (def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))) (sumdown 1) ;=>1 (sumdown 2) ;=>3 (sumdown 6) ;=>21 ;; Testing recursive fibonacci function (def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2))))))) (fib 1) ;=>1 (fib 2) ;=>2 (fib 4) ;=>5 ;; Testing recursive function in environment. (let* (f (fn* () x) x 3) (f)) ;=>3 (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) ;=>nil (let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2)) ;=>0 ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing if on strings (if "" 7 8) ;=>7 ;; Testing string equality (= "" "") ;=>true (= "abc" "abc") ;=>true (= "abc" "") ;=>false (= "" "abc") ;=>false (= "abc" "def") ;=>false (= "abc" "ABC") ;=>false (= (list) "") ;=>false (= "" (list)) ;=>false ;; Testing variable length arguments ( (fn* (& more) (count more)) 1 2 3) ;=>3 ( (fn* (& more) (list? more)) 1 2 3) ;=>true ( (fn* (& more) (count more)) 1) ;=>1 ( (fn* (& more) (count more)) ) ;=>0 ( (fn* (& more) (list? more)) ) ;=>true ( (fn* (a & more) (count more)) 1 2 3) ;=>2 ( (fn* (a & more) (count more)) 1) ;=>0 ( (fn* (a & more) (list? more)) 1) ;=>true ;; Testing language defined not function (not false) ;=>true (not nil) ;=>true (not true) ;=>false (not "a") ;=>false (not 0) ;=>false ;; ----------------------------------------------------- ;; Testing string quoting "" ;=>"" "abc" ;=>"abc" "abc def" ;=>"abc def" "\"" ;=>"\"" "abc\ndef\nghi" ;=>"abc\ndef\nghi" "abc\\def\\ghi" ;=>"abc\\def\\ghi" "\\n" ;=>"\\n" ;; Testing pr-str (pr-str) ;=>"" (pr-str "") ;=>"\"\"" (pr-str "abc") ;=>"\"abc\"" (pr-str "abc def" "ghi jkl") ;=>"\"abc def\" \"ghi jkl\"" (pr-str "\"") ;=>"\"\\\"\"" (pr-str (list 1 2 "abc" "\"") "def") ;=>"(1 2 \"abc\" \"\\\"\") \"def\"" (pr-str "abc\ndef\nghi") ;=>"\"abc\\ndef\\nghi\"" (pr-str "abc\\def\\ghi") ;=>"\"abc\\\\def\\\\ghi\"" (pr-str (list)) ;=>"()" ;; Testing str (str) ;=>"" (str "") ;=>"" (str "abc") ;=>"abc" (str "\"") ;=>"\"" (str 1 "abc" 3) ;=>"1abc3" (str "abc def" "ghi jkl") ;=>"abc defghi jkl" (str "abc\ndef\nghi") ;=>"abc\ndef\nghi" (str "abc\\def\\ghi") ;=>"abc\\def\\ghi" (str (list 1 2 "abc" "\"") "def") ;=>"(1 2 abc \")def" (str (list)) ;=>"()" ;; Testing prn (prn) ;/ ;=>nil (prn "") ;/"" ;=>nil (prn "abc") ;/"abc" ;=>nil (prn "abc def" "ghi jkl") ;/"abc def" "ghi jkl" (prn "\"") ;/"\\"" ;=>nil (prn "abc\ndef\nghi") ;/"abc\\ndef\\nghi" ;=>nil (prn "abc\\def\\ghi") ;/"abc\\\\def\\\\ghi" nil (prn (list 1 2 "abc" "\"") "def") ;/\(1 2 "abc" "\\""\) "def" ;=>nil ;; Testing println (println) ;/ ;=>nil (println "") ;/ ;=>nil (println "abc") ;/abc ;=>nil (println "abc def" "ghi jkl") ;/abc def ghi jkl (println "\"") ;/" ;=>nil (println "abc\ndef\nghi") ;/abc ;/def ;/ghi ;=>nil (println "abc\\def\\ghi") ;/abc\\def\\ghi ;=>nil (println (list 1 2 "abc" "\"") "def") ;/\(1 2 abc "\) def ;=>nil ;; Testing keywords (= :abc :abc) ;=>true (= :abc :def) ;=>false (= :abc ":abc") ;=>false (= (list :abc) (list :abc)) ;=>true ;; Testing vector truthiness (if [] 7 8) ;=>7 ;; Testing vector printing (pr-str [1 2 "abc" "\""] "def") ;=>"[1 2 \"abc\" \"\\\"\"] \"def\"" (pr-str []) ;=>"[]" (str [1 2 "abc" "\""] "def") ;=>"[1 2 abc \"]def" (str []) ;=>"[]" ;; Testing vector functions (count [1 2 3]) ;=>3 (empty? [1 2 3]) ;=>false (empty? []) ;=>true (list? [4 5 6]) ;=>false ;; Testing vector equality (= [] (list)) ;=>true (= [7 8] [7 8]) ;=>true (= [:abc] [:abc]) ;=>true (= (list 1 2) [1 2]) ;=>true (= (list 1) []) ;=>false (= [] [1]) ;=>false (= 0 []) ;=>false (= [] 0) ;=>false (= [] "") ;=>false (= "" []) ;=>false ;; Testing vector parameter lists ( (fn* [] 4) ) ;=>4 ( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7) ;=>8 ;; Nested vector/list equality (= [(list)] (list [])) ;=>true (= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)])) ;=>true ================================================ FILE: impls/tests/step5_tco.mal ================================================ ;; Testing recursive tail-call function (def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) ;; TODO: test let*, and do for TCO (sum2 10 0) ;=>55 (def! res2 nil) ;=>nil (def! res2 (sum2 10000 0)) res2 ;=>50005000 ;; Test mutually recursive tail-call functions (def! foo (fn* (n) (if (= n 0) 0 (bar (- n 1))))) (def! bar (fn* (n) (if (= n 0) 0 (foo (- n 1))))) (foo 10000) ;=>0 ================================================ FILE: impls/tests/step6_file.mal ================================================ ;;; TODO: really a step5 test ;; ;; Testing that (do (do)) not broken by TCO (do (do 1 2)) ;=>2 ;; ;; Testing read-string, eval and slurp (read-string "(1 2 (3 4) nil)") ;=>(1 2 (3 4) nil) (= nil (read-string "nil")) ;=>true (read-string "(+ 2 3)") ;=>(+ 2 3) (read-string "\"\n\"") ;=>"\n" (read-string "7 ;; comment") ;=>7 ;;; Differing output, but make sure no fatal error (read-string ";; comment") (eval (read-string "(+ 2 3)")) ;=>5 (slurp "../tests/test.txt") ;=>"A line of text\n" ;;; Load the same file twice. (slurp "../tests/test.txt") ;=>"A line of text\n" ;; Testing load-file (load-file "../tests/inc.mal") ;=>nil (inc1 7) ;=>8 (inc2 7) ;=>9 (inc3 9) ;=>12 ;; ;; Testing atoms (def! inc3 (fn* (a) (+ 3 a))) (def! a (atom 2)) ;=>(atom 2) (atom? a) ;=>true (atom? 1) ;=>false (deref a) ;=>2 (reset! a 3) ;=>3 (deref a) ;=>3 (swap! a inc3) ;=>6 (deref a) ;=>6 (swap! a (fn* (a) a)) ;=>6 (swap! a (fn* (a) (* 2 a))) ;=>12 (swap! a (fn* (a b) (* a b)) 10) ;=>120 (swap! a + 3) ;=>123 ;; Test that do only evals each slot once (def! b (atom 0)) (do (swap! b + 1) (swap! b + 10) (swap! b + 100)) (deref b) ;=>111 ;; Testing swap!/closure interaction (def! inc-it (fn* (a) (+ 1 a))) (def! atm (atom 7)) (def! f (fn* () (swap! atm inc-it))) (f) ;=>8 (f) ;=>9 ;; Testing whether closures can retain atoms (def! g (let* (atm (atom 0)) (fn* () (deref atm)))) (def! atm (atom 1)) (g) ;=>0 ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing read-string parsing errors (read-string "(+ 1") ;/.*(EOF|end of input|unbalanced).* (read-string "[+ 1") ;/.*(EOF|end of input|unbalanced).* (read-string "{:a 1") ;/.*(EOF|end of input|unbalanced).* ;; Testing reading of large files (load-file "../tests/computations.mal") ;=>nil (sumdown 2) ;=>3 (fib 2) ;=>1 ;; Testing `@` reader macro (short for `deref`) (def! atm (atom 9)) @atm ;=>9 ;;; TODO: really a step5 test ;; Testing that vector params not broken by TCO (def! g (fn* [] 78)) (g) ;=>78 (def! g (fn* [a] (+ a 78))) (g 3) ;=>81 ;; ;; Testing that *ARGV* exists and is an empty list (list? *ARGV*) ;=>true *ARGV* ;=>() ;; ;; Testing that eval sets aa in root scope, and that it is found in nested scope (let* (b 12) (do (eval (read-string "(def! aa 7)")) aa )) ;=>7 ;>>> soft=True ;>>> optional=True ;; ;; -------- Optional Functionality -------- ;; Testing comments in a file (load-file "../tests/incB.mal") ;=>nil (inc4 7) ;=>11 (inc5 7) ;=>12 ;; Testing map literal across multiple lines in a file (load-file "../tests/incC.mal") ;=>nil mymap ;=>{"a" 1} ;; Checking that eval does not use local environments. (def! a 1) ;=>1 (let* (a 2) (eval (read-string "a"))) ;=>1 ;; Non alphanumeric characters in comments in read-string (read-string "1;!") ;=>1 (read-string "1;\"") ;=>1 (read-string "1;#") ;=>1 (read-string "1;$") ;=>1 (read-string "1;%") ;=>1 (read-string "1;'") ;=>1 (read-string "1;\\") ;=>1 (read-string "1;\\\\") ;=>1 (read-string "1;\\\\\\") ;=>1 (read-string "1;`") ;=>1 ;;; Hopefully less problematic characters can be checked together (read-string "1; &()*+,-./:;<=>?@[]^_{|}~") ;=>1 ================================================ FILE: impls/tests/step7_quote.mal ================================================ ;; Testing cons function (cons 1 (list)) ;=>(1) (cons 1 (list 2)) ;=>(1 2) (cons 1 (list 2 3)) ;=>(1 2 3) (cons (list 1) (list 2 3)) ;=>((1) 2 3) (def! a (list 2 3)) (cons 1 a) ;=>(1 2 3) a ;=>(2 3) ;; Testing concat function (concat) ;=>() (concat (list 1 2)) ;=>(1 2) (concat (list 1 2) (list 3 4)) ;=>(1 2 3 4) (concat (list 1 2) (list 3 4) (list 5 6)) ;=>(1 2 3 4 5 6) (concat (concat)) ;=>() (concat (list) (list)) ;=>() (= () (concat)) ;=>true (def! a (list 1 2)) (def! b (list 3 4)) (concat a b (list 5 6)) ;=>(1 2 3 4 5 6) a ;=>(1 2) b ;=>(3 4) ;; Testing regular quote (quote 7) ;=>7 (quote (1 2 3)) ;=>(1 2 3) (quote (1 2 (3 4))) ;=>(1 2 (3 4)) ;; Testing simple quasiquote (quasiquote nil) ;=>nil (quasiquote 7) ;=>7 (quasiquote a) ;=>a (quasiquote {"a" b}) ;=>{"a" b} ;; Testing quasiquote with lists (quasiquote ()) ;=>() (quasiquote (1 2 3)) ;=>(1 2 3) (quasiquote (a)) ;=>(a) (quasiquote (1 2 (3 4))) ;=>(1 2 (3 4)) (quasiquote (nil)) ;=>(nil) (quasiquote (1 ())) ;=>(1 ()) (quasiquote (() 1)) ;=>(() 1) (quasiquote (1 () 2)) ;=>(1 () 2) (quasiquote (())) ;=>(()) ;; Testing unquote (quasiquote (unquote 7)) ;=>7 (def! a 8) ;=>8 (quasiquote a) ;=>a (quasiquote (unquote a)) ;=>8 (quasiquote (1 a 3)) ;=>(1 a 3) (quasiquote (1 (unquote a) 3)) ;=>(1 8 3) (def! b (quote (1 "b" "d"))) ;=>(1 "b" "d") (quasiquote (1 b 3)) ;=>(1 b 3) (quasiquote (1 (unquote b) 3)) ;=>(1 (1 "b" "d") 3) (quasiquote ((unquote 1) (unquote 2))) ;=>(1 2) ;; Quasiquote and environments (let* (x 0) (quasiquote (unquote x))) ;=>0 ;; Testing splice-unquote (def! c (quote (1 "b" "d"))) ;=>(1 "b" "d") (quasiquote (1 c 3)) ;=>(1 c 3) (quasiquote (1 (splice-unquote c) 3)) ;=>(1 1 "b" "d" 3) (quasiquote (1 (splice-unquote c))) ;=>(1 1 "b" "d") (quasiquote ((splice-unquote c) 2)) ;=>(1 "b" "d" 2) (quasiquote ((splice-unquote c) (splice-unquote c))) ;=>(1 "b" "d" 1 "b" "d") ;; Testing symbol equality (= (quote abc) (quote abc)) ;=>true (= (quote abc) (quote abcd)) ;=>false (= (quote abc) "abc") ;=>false (= "abc" (quote abc)) ;=>false (= "abc" (str (quote abc))) ;=>true (= (quote abc) nil) ;=>false (= nil (quote abc)) ;=>false ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing ' (quote) reader macro '7 ;=>7 '(1 2 3) ;=>(1 2 3) '(1 2 (3 4)) ;=>(1 2 (3 4)) ;; Testing cons and concat with vectors (cons 1 []) ;=>(1) (cons [1] [2 3]) ;=>([1] 2 3) (cons 1 [2 3]) ;=>(1 2 3) (concat [1 2] (list 3 4) [5 6]) ;=>(1 2 3 4 5 6) (concat [1 2]) ;=>(1 2) ;>>> optional=True ;; ;; -------- Optional Functionality -------- ;; Testing ` (quasiquote) reader macro `7 ;=>7 `(1 2 3) ;=>(1 2 3) `(1 2 (3 4)) ;=>(1 2 (3 4)) `(nil) ;=>(nil) ;; Testing ~ (unquote) reader macro `~7 ;=>7 (def! a 8) ;=>8 `(1 ~a 3) ;=>(1 8 3) (def! b '(1 "b" "d")) ;=>(1 "b" "d") `(1 b 3) ;=>(1 b 3) `(1 ~b 3) ;=>(1 (1 "b" "d") 3) ;; Testing ~@ (splice-unquote) reader macro (def! c '(1 "b" "d")) ;=>(1 "b" "d") `(1 c 3) ;=>(1 c 3) `(1 ~@c 3) ;=>(1 1 "b" "d" 3) ;>>> soft=True ;; Testing vec function (vec (list)) ;=>[] (vec (list 1)) ;=>[1] (vec (list 1 2)) ;=>[1 2] (vec []) ;=>[] (vec [1 2]) ;=>[1 2] ;; Testing that vec does not mutate the original list (def! a (list 1 2)) (vec a) ;=>[1 2] a ;=>(1 2) ;; Test quine ((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) ;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) ;; Testing quasiquote with vectors (quasiquote []) ;=>[] (quasiquote [[]]) ;=>[[]] (quasiquote [()]) ;=>[()] (quasiquote ([])) ;=>([]) (def! a 8) ;=>8 `[1 a 3] ;=>[1 a 3] (quasiquote [a [] b [c] d [e f] g]) ;=>[a [] b [c] d [e f] g] ;; Testing unquote with vectors `[~a] ;=>[8] `[(~a)] ;=>[(8)] `([~a]) ;=>([8]) `[a ~a a] ;=>[a 8 a] `([a ~a a]) ;=>([a 8 a]) `[(a ~a a)] ;=>[(a 8 a)] ;; Testing splice-unquote with vectors (def! c '(1 "b" "d")) ;=>(1 "b" "d") `[~@c] ;=>[1 "b" "d"] `[(~@c)] ;=>[(1 "b" "d")] `([~@c]) ;=>([1 "b" "d"]) `[1 ~@c 3] ;=>[1 1 "b" "d" 3] `([1 ~@c 3]) ;=>([1 1 "b" "d" 3]) `[(1 ~@c 3)] ;=>[(1 1 "b" "d" 3)] ;; Misplaced unquote or splice-unquote `(0 unquote) ;=>(0 unquote) `(0 splice-unquote) ;=>(0 splice-unquote) `[unquote 0] ;=>[unquote 0] `[splice-unquote 0] ;=>[splice-unquote 0] `(0 unquote 1) ;=>(0 unquote 1) `(0 splice-unquote ()) ;=>(0 splice-unquote ()) (let* (DEBUG-EVAL true) `nil) ;/EVAL: nil.*\nnil (let* (DEBUG-EVAL true) `7) ;/EVAL: 7.*\n7 (let* (DEBUG-EVAL true) `a) ;/EVAL: \(quote a\).*\na (let* (DEBUG-EVAL true) `{"a" b}) ;/EVAL: \(quote \{"a" b\}\).*\n\{"a" b\} (let* (DEBUG-EVAL true) `()) ;/EVAL: \(\).*\n\(\) (let* (DEBUG-EVAL true) `(a 2)) ;/EVAL: \(cons \(quote a\) \(cons 2 \(\)\)\).*\n\(a 2\) (let* (DEBUG-EVAL true) `(~a 3)) ;/EVAL: \(cons a \(cons 3 \(\)\)\).*\n\(8 3\) (let* (DEBUG-EVAL true) `(1 ~@c 3)) ;/EVAL: \(cons 1 \(concat c \(cons 3 \(\)\)\)\).*\n\(1 1 "b" "d" 3\) (let* (DEBUG-EVAL true) `[]) ;/EVAL: \(vec \(\)\).*\n\[\] ================================================ FILE: impls/tests/step8_macros.mal ================================================ ;; Testing trivial macros (defmacro! one (fn* () 1)) (one) ;=>1 (defmacro! two (fn* () 2)) (two) ;=>2 ;; Testing unless macros (defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a))) (unless false 7 8) ;=>7 (unless true 7 8) ;=>8 (defmacro! unless2 (fn* (pred a b) (list 'if (list 'not pred) a b))) (unless2 false 7 8) ;=>7 (unless2 true 7 8) ;=>8 ;; Testing evaluation of macro result (defmacro! identity (fn* (x) x)) (let* (a 123) (identity a)) ;=>123 ;; Test that macros do not break empty list () ;=>() ;; Test that macros do not break quasiquote `(1) ;=>(1) ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- ;; Testing non-macro function (not (= 1 1)) ;=>false ;;; This should fail if it is a macro (not (= 1 2)) ;=>true ;; Testing nth, first and rest functions (nth (list 1) 0) ;=>1 (nth (list 1 2) 1) ;=>2 (nth (list 1 2 nil) 2) ;=>nil (def! x "x") (def! x (nth (list 1 2) 2)) x ;=>"x" (first (list)) ;=>nil (first (list 6)) ;=>6 (first (list 7 8 9)) ;=>7 (rest (list)) ;=>() (rest (list 6)) ;=>() (rest (list 7 8 9)) ;=>(8 9) ;; Testing cond macro (cond) ;=>nil (cond true 7) ;=>7 (cond false 7) ;=>nil (cond true 7 true 8) ;=>7 (cond false 7 true 8) ;=>8 (cond false 7 false 8 "else" 9) ;=>9 (cond false 7 (= 2 2) 8 "else" 9) ;=>8 (cond false 7 false 8 false 9) ;=>nil ;; Testing EVAL in let* (let* (x (cond false "no" true "yes")) x) ;=>"yes" ;; Testing nth, first, rest with vectors (nth [1] 0) ;=>1 (nth [1 2] 1) ;=>2 (nth [1 2 nil] 2) ;=>nil (def! x "x") (def! x (nth [1 2] 2)) x ;=>"x" (first []) ;=>nil (first nil) ;=>nil (first [10]) ;=>10 (first [10 11 12]) ;=>10 (rest []) ;=>() (rest nil) ;=>() (rest [10]) ;=>() (rest [10 11 12]) ;=>(11 12) (rest (cons 10 [11 12])) ;=>(11 12) ;; Testing EVAL in vector let* (let* [x (cond false "no" true "yes")] x) ;=>"yes" ;; Test return value of defmacro! (let* [m (defmacro! _ (fn* [] 1))] (macro? m)) ;=>true ;>>> soft=True ;>>> optional=True ;; ;; ------- Optional Functionality -------------- ;; ------- (Not needed for self-hosting) ------- ;; Test that macros use closures (def! x 2) (defmacro! a (fn* [] x)) (a) ;=>2 (let* (x 3) (a)) ;=>2 (let* (DEBUG-EVAL true) (unless x foo (- 4 3))) ;/EVAL: \(if x \(- 4 3\) foo\).*\n1 (let* (DEBUG-EVAL true) (unless2 x foo (- 4 3))) ;/EVAL: \(if \(not x\) foo \(- 4 3\)\).*\n1 (let* (DEBUG-EVAL true) (cond x (- 4 3) foo bar)) ;/EVAL: \(if x \(- 4 3\) \(cond foo bar\)\).*\n1 ================================================ FILE: impls/tests/step9_try.mal ================================================ ;; ;; Testing throw (throw "err1") ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.* ;; ;; Testing try*/catch* (try* 123 (catch* e 456)) ;=>123 (try* abc (catch* exc (prn "exc is:" exc))) ;/"exc is:" "'?abc'? not found" ;=>nil (try* (abc 1 2) (catch* exc (prn "exc is:" exc))) ;/"exc is:" "'?abc'? not found" ;=>nil ;; Make sure error from core can be caught (try* (nth () 1) (catch* exc (prn "exc is:" exc))) ;/"exc is:".*(length|range|[Bb]ounds|beyond).* ;=>nil ;; Make sure no double eval (no TCO from try block) (try* (list 1) (catch* exc (prn "exc is:" exc))) ;=>(1) (try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7))) ;/"exc:" "my exception" ;=>7 ;; Test that exception handlers get restored correctly (try* (do (try* "t1" (catch* e "c1")) (throw "e1")) (catch* e "c2")) ;=>"c2" (try* (try* (throw "e1") (catch* e (throw "e2"))) (catch* e "c2")) ;=>"c2" ;;; Test that throw is a function: (try* (map throw (list "my err")) (catch* exc exc)) ;=>"my err" ;; ;; Testing builtin functions (symbol? 'abc) ;=>true (symbol? "abc") ;=>false (nil? nil) ;=>true (nil? false) ;=>false (nil? true) ;=>false (nil? ()) ;=>false (nil? 0) ;=>false (true? nil) ;=>false (true? false) ;=>false (true? true) ;=>true (true? 1) ;=>false (true? true?) ;=>false (false? nil) ;=>false (false? false) ;=>true (false? true) ;=>false (false? "") ;=>false (false? 0) ;=>false (false? ()) ;=>false (false? []) ;=>false (false? {}) ;=>false (false? nil) ;=>false ;; Testing apply function with core functions (apply + (list 2 3)) ;=>5 (apply + 4 (list 5)) ;=>9 (apply prn (list 1 2 "3" (list))) ;/1 2 "3" \(\) ;=>nil (apply prn 1 2 (list "3" (list))) ;/1 2 "3" \(\) ;=>nil (apply list (list)) ;=>() (apply symbol? (list (quote two))) ;=>true ;; Testing apply function with user functions (apply (fn* (a b) (+ a b)) (list 2 3)) ;=>5 (apply (fn* (a b) (+ a b)) 4 (list 5)) ;=>9 ;; Testing apply function with macros (defmacro! m (fn* [a b] (+ a b))) (apply m (list 2 3)) ;=>5 (apply m 4 (list 5)) ;=>9 ;; Testing map function (def! nums (list 1 2 3)) (def! double (fn* (a) (* 2 a))) (double 3) ;=>6 (map double nums) ;=>(2 4 6) (map (fn* (x) (symbol? x)) (list 1 (quote two) "three")) ;=>(false true false) (= () (map str ())) ;=>true ;>>> deferrable=True ;; ;; ------- Deferrable Functionality ---------- ;; ------- (Needed for self-hosting) ------- ;; Test catch of reader errors (try* (eval (read-string "(+ 1")) (catch* e (prn :e e))) ;/.*(EOF|end of input|unbalanced).* (try* (eval (read-string "[+ 1")) (catch* e (prn :e e))) ;/.*(EOF|end of input|unbalanced).* (try* (eval (read-string "{:a 1")) (catch* e (prn :e e))) ;/.*(EOF|end of input|unbalanced).* ;; Testing symbol and keyword functions (symbol? :abc) ;=>false (symbol? 'abc) ;=>true (symbol? "abc") ;=>false (symbol? (symbol "abc")) ;=>true (keyword? :abc) ;=>true (keyword? 'abc) ;=>false (keyword? "abc") ;=>false (keyword? "") ;=>false (keyword? (keyword "abc")) ;=>true (symbol "abc") ;=>abc (keyword "abc") ;=>:abc ;; Testing sequential? function (sequential? (list 1 2 3)) ;=>true (sequential? [15]) ;=>true (sequential? sequential?) ;=>false (sequential? nil) ;=>false (sequential? "abc") ;=>false ;; Testing apply function with core functions and arguments in vector (apply + 4 [5]) ;=>9 (apply prn 1 2 ["3" 4]) ;/1 2 "3" 4 ;=>nil (apply list []) ;=>() ;; Testing apply function with user functions and arguments in vector (apply (fn* (a b) (+ a b)) [2 3]) ;=>5 (apply (fn* (a b) (+ a b)) 4 [5]) ;=>9 ;; Testing map function with vectors (map (fn* (a) (* 2 a)) [1 2 3]) ;=>(2 4 6) (map (fn* [& args] (list? args)) [1 2]) ;=>(true true) ;; Testing vector functions (vector? [10 11]) ;=>true (vector? '(12 13)) ;=>false (vector 3 4 5) ;=>[3 4 5] (= [] (vector)) ;=>true (map? {}) ;=>true (map? '()) ;=>false (map? []) ;=>false (map? 'abc) ;=>false (map? :abc) ;=>false ;; ;; Testing hash-maps (hash-map "a" 1) ;=>{"a" 1} {"a" 1} ;=>{"a" 1} (assoc {} "a" 1) ;=>{"a" 1} (get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a") ;=>1 (def! hm1 (hash-map)) ;=>{} (map? hm1) ;=>true (map? 1) ;=>false (map? "abc") ;=>false (get nil "a") ;=>nil (get hm1 "a") ;=>nil (contains? hm1 "a") ;=>false (def! hm2 (assoc hm1 "a" 1)) ;=>{"a" 1} (get hm1 "a") ;=>nil (contains? hm1 "a") ;=>false (get hm2 "a") ;=>1 (contains? hm2 "a") ;=>true ;;; TODO: fix. Clojure returns nil but this breaks mal impl (keys hm1) ;=>() (= () (keys hm1)) ;=>true (keys hm2) ;=>("a") (keys {"1" 1}) ;=>("1") ;;; TODO: fix. Clojure returns nil but this breaks mal impl (vals hm1) ;=>() (= () (vals hm1)) ;=>true (vals hm2) ;=>(1) (count (keys (assoc hm2 "b" 2 "c" 3))) ;=>3 ;; Testing keywords as hash-map keys (get {:abc 123} :abc) ;=>123 (contains? {:abc 123} :abc) ;=>true (contains? {:abcd 123} :abc) ;=>false (assoc {} :bcd 234) ;=>{:bcd 234} (keyword? (nth (keys {:abc 123 :def 456}) 0)) ;=>true (keyword? (nth (vals {"a" :abc "b" :def}) 0)) ;=>true ;; Testing whether assoc updates properly (def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1)) (get hm4 :a) ;=>3 (get hm4 :b) ;=>2 (get hm4 :c) ;=>1 ;; Testing nil as hash-map values (contains? {:abc nil} :abc) ;=>true (assoc {} :bcd nil) ;=>{:bcd nil} ;; ;; Additional str and pr-str tests (str "A" {:abc "val"} "Z") ;=>"A{:abc val}Z" (str true "." false "." nil "." :keyw "." 'symb) ;=>"true.false.nil.:keyw.symb" (pr-str "A" {:abc "val"} "Z") ;=>"\"A\" {:abc \"val\"} \"Z\"" (pr-str true "." false "." nil "." :keyw "." 'symb) ;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb" (def! s (str {:abc "val1" :def "val2"})) (cond (= s "{:abc val1 :def val2}") true (= s "{:def val2 :abc val1}") true) ;=>true (def! p (pr-str {:abc "val1" :def "val2"})) (cond (= p "{:abc \"val1\" :def \"val2\"}") true (= p "{:def \"val2\" :abc \"val1\"}") true) ;=>true ;; ;; Test extra function arguments as Mal List (bypassing TCO with apply) (apply (fn* (& more) (list? more)) [1 2 3]) ;=>true (apply (fn* (& more) (list? more)) []) ;=>true (apply (fn* (a & more) (list? more)) [1]) ;=>true ;>>> soft=True ;>>> optional=True ;; ;; ------- Optional Functionality -------------- ;; ------- (Not needed for self-hosting) ------- ;; Testing throwing a hash-map (throw {:msg "err2"}) ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.* ;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try* ;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;; ;;;; "exc is:" ["data" "foo"] ;;;;=>7 ;;;;=>7 ;; ;; Testing try* without catch* (try* xyz) ;/.*'?xyz'? not found.* ;; ;; Testing throwing non-strings (try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) ;/"err:" \(1 2 3\) ;=>7 ;; ;; Testing dissoc (def! hm3 (assoc hm2 "b" 2)) (count (keys hm3)) ;=>2 (count (vals hm3)) ;=>2 (dissoc hm3 "a") ;=>{"b" 2} (dissoc hm3 "a" "b") ;=>{} (dissoc hm3 "a" "b" "c") ;=>{} (count (keys hm3)) ;=>2 (dissoc {:cde 345 :fgh 456} :cde) ;=>{:fgh 456} (dissoc {:cde nil :fgh 456} :cde) ;=>{:fgh 456} ;; ;; Testing equality of hash-maps (= {} {}) ;=>true (= {} (hash-map)) ;=>true (= {:a 11 :b 22} (hash-map :b 22 :a 11)) ;=>true (= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11)) ;=>true (= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11)) ;=>true (= {:a 11 :b 22} (hash-map :b 23 :a 11)) ;=>false (= {:a 11 :b 22} (hash-map :a 11)) ;=>false (= {:a [11 22]} {:a (list 11 22)}) ;=>true (= {:a 11 :b 22} (list :a 11 :b 22)) ;=>false (= {} []) ;=>false (= [] {}) ;=>false (keyword :abc) ;=>:abc (keyword? (first (keys {":abc" 123 ":def" 456}))) ;=>false ;; Testing that hashmaps don't alter function ast (def! bar (fn* [a] {:foo (get a :foo)})) (bar {:foo (fn* [x] x)}) (bar {:foo 3}) ;=>{:foo 3} ;; shouldn't give an error ;; Keywords and strings must be distinct map keys. (get {"abc" 1} :abc) ;=>nil (get {:abc 1} "abc") ;=>nil (contains? {"abc" 1} :abc) ;=>false (contains? {:abc 1} "abc") ;=>false (dissoc {"abc" 1 :abc 1} :abc) ;=>{"abc" 1} (dissoc {"abc" 1 :abc 1} "abc") ;=>{:abc 1} ;; Map updates must not create duplicate keys. {:a 1 :a 2} ;=>{:a 2} (keys {:a 1 :a 2}) ;=>(:a) (hash-map :a 1 :a 2) ;=>{:a 2} (keys (hash-map :a 1 :a 2)) ;=>(:a) (assoc {:a 1} :a 2) ;=>{:a 2} (keys (assoc {:a 1} :a 2)) ;=>(:a) ;; Assoc must not mutate the original map. (def! hm7 {:a 1}) ;=>{:a 1} (assoc hm7 :a 2) ;=>{:a 2} (get hm7 :a) ;=>1 ================================================ FILE: impls/tests/stepA_mal.mal ================================================ ;;; ;;; See IMPL/tests/stepA_mal.mal for implementation specific ;;; interop tests. ;;; ;; ;; Testing readline (readline "mal-user> ") "hello" ;=>"\"hello\"" ;; ;; Testing *host-language* ;;; each impl is different, but this should return false ;;; rather than throwing an exception (= "something bogus" *host-language*) ;=>false ;>>> deferrable=True ;; ;; ------- Deferrable Functionality ---------- ;; ------- (Needed for self-hosting) ------- ;; ;; ;; Testing hash-map evaluation and atoms (i.e. an env) (def! e (atom {"+" +})) (swap! e assoc "-" -) ( (get @e "+") 7 8) ;=>15 ( (get @e "-") 11 8) ;=>3 (swap! e assoc "foo" (list)) (get @e "foo") ;=>() (swap! e assoc "bar" '(1 2 3)) (get @e "bar") ;=>(1 2 3) ;; Testing for presence of optional functions (do (list time-ms string? number? seq conj meta with-meta fn?) nil) ;=>nil (map symbol? '(nil false true)) ;=>(false false false) (def! add1 (fn* (x) (+ x 1))) ;; Testing fn? function (fn? +) ;=>true (fn? list?) ;=>true (fn? add1) ;=>true (fn? cond) ;=>false (fn? "+") ;=>false (fn? :+) ;=>false ;; Testing macro? function (macro? cond) ;=>true (macro? +) ;=>false (macro? add1) ;=>false (macro? "+") ;=>false (macro? :+) ;=>false (macro? {}) ;=>false ;; ------------------------------------------------------------------ ;>>> soft=True ;>>> optional=True ;; ;; ------- Optional Functionality -------------- ;; ------- (Not needed for self-hosting) ------- ;; Testing metadata on functions ;; ;; Testing metadata on mal functions (meta (fn* (a) a)) ;=>nil (meta (with-meta (fn* (a) a) {"b" 1})) ;=>{"b" 1} (meta (with-meta (fn* (a) a) "abc")) ;=>"abc" (def! l-wm (with-meta (fn* (a) a) {"b" 2})) (meta l-wm) ;=>{"b" 2} (meta (with-meta l-wm {"new_meta" 123})) ;=>{"new_meta" 123} (meta l-wm) ;=>{"b" 2} (def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1})) (meta f-wm) ;=>{"abc" 1} (meta (with-meta f-wm {"new_meta" 123})) ;=>{"new_meta" 123} (meta f-wm) ;=>{"abc" 1} (def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a))) (meta f-wm2) ;=>{"abc" 1} ;; Meta of native functions should return nil (not fail) (meta +) ;=>nil ;; ;; Make sure closures and metadata co-exist (def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1}))) (def! plus7 (gen-plusX 7)) (def! plus8 (gen-plusX 8)) (plus7 8) ;=>15 (meta plus7) ;=>{"meta" 1} (meta plus8) ;=>{"meta" 1} (meta (with-meta plus7 {"meta" 2})) ;=>{"meta" 2} (meta plus8) ;=>{"meta" 1} ;; ;; Testing string? function (string? "") ;=>true (string? 'abc) ;=>false (string? "abc") ;=>true (string? :abc) ;=>false (string? (keyword "abc")) ;=>false (string? 234) ;=>false (string? nil) ;=>false ;; Testing number? function (number? 123) ;=>true (number? -1) ;=>true (number? nil) ;=>false (number? false) ;=>false (number? "123") ;=>false ;; ;; Testing conj function (conj (list) 1) ;=>(1) (conj (list 1) 2) ;=>(2 1) (conj (list 2 3) 4) ;=>(4 2 3) (conj (list 2 3) 4 5 6) ;=>(6 5 4 2 3) (conj (list 1) (list 2 3)) ;=>((2 3) 1) (conj [] 1) ;=>[1] (conj [1] 2) ;=>[1 2] (conj [2 3] 4) ;=>[2 3 4] (conj [2 3] 4 5 6) ;=>[2 3 4 5 6] (conj [1] [2 3]) ;=>[1 [2 3]] ;; ;; Testing seq function (seq "abc") ;=>("a" "b" "c") (apply str (seq "this is a test")) ;=>"this is a test" (seq '(2 3 4)) ;=>(2 3 4) (seq [2 3 4]) ;=>(2 3 4) (seq "") ;=>nil (seq '()) ;=>nil (seq []) ;=>nil (seq nil) ;=>nil ;; ;; Testing metadata on collections (meta [1 2 3]) ;=>nil (with-meta [1 2 3] {"a" 1}) ;=>[1 2 3] (meta (with-meta [1 2 3] {"a" 1})) ;=>{"a" 1} (vector? (with-meta [1 2 3] {"a" 1})) ;=>true (meta (with-meta [1 2 3] "abc")) ;=>"abc" (with-meta [] "abc") ;=>[] (meta (with-meta (list 1 2 3) {"a" 1})) ;=>{"a" 1} (list? (with-meta (list 1 2 3) {"a" 1})) ;=>true (with-meta (list) {"a" 1}) ;=>() (empty? (with-meta (list) {"a" 1})) ;=>true (meta (with-meta {"abc" 123} {"a" 1})) ;=>{"a" 1} (map? (with-meta {"abc" 123} {"a" 1})) ;=>true (with-meta {} {"a" 1}) ;=>{} (def! l-wm (with-meta [4 5 6] {"b" 2})) ;=>[4 5 6] (meta l-wm) ;=>{"b" 2} (meta (with-meta l-wm {"new_meta" 123})) ;=>{"new_meta" 123} (meta l-wm) ;=>{"b" 2} ;; ;; Testing metadata on mal and builtin functions (fn? ^{"ismacro" true} (fn* () 0)) ;=>true (meta +) ;=>nil (def! f-wm3 ^{"def" 2} +) (meta f-wm3) ;=>{"def" 2} (meta +) ;=>nil ;; Metadata should not break equality. (= [1] ^2 [1]) ;=>true (= '(1) ^2 '(1)) ;=>true (= {"a" 1} ^2 {"a" 1}) ;=>true (= '(1) ^2 [1]) ;=>true ;; Loading sumdown from computations.mal (load-file "../tests/computations.mal") ;=>nil ;; ;; Testing time-ms function (def! start-time (time-ms)) (= start-time 0) ;=>false (sumdown 10) ; Waste some time ;=>55 (> (time-ms) start-time) ;=>true ;; ;; Test that defining a macro does not mutate an existing function. (def! f (fn* [x] (number? x))) (defmacro! m f) (f (+ 1 1)) ;=>true (m (+ 1 1)) ;=>false ================================================ FILE: impls/tests/test.txt ================================================ A line of text ================================================ FILE: impls/tests/travis_trigger.sh ================================================ #!/usr/bin/env bash # Reference: https://docs.travis-ci.com/user/triggering-builds/ set -e die() { echo "${*}"; exit 1; } usage() { [ "${*}" ] && echo >&2 -e "${*}\n" echo "Usage: $0 REPO BRANCH [VAR=VAL]... Authorization: If you have the travis program installed then it will be called to get an API token (you need to have done 'travis login --org' in the past). Alternately you can explicity pass a token using the TRAVIS_TOKEN environment variable. You can see your API token at https://travis-ci.org/account/preferences. Travis .org vs .com: By default 'api.travis-ci.org' is used for API calls. This can be overridden by setting TRAVIS_HOST="api.travis-ci.com" Examples: Trigger build/test in self-hosted mode: $0 REPO BRANCH DO_SELF_HOST=1 Trigger build/test with stop on soft failures: $0 REPO BRANCH DO_HARD=1 Trigger build/test using regress mode on stepA: $0 REPO BRANCH REGRESS=1 STEP=stepA Trigger build/test using regress mode on all steps: $0 REPO BRANCH REGRESS=1 " | sed 's/^ //' >&2 exit 2 } TRAVIS_TOKEN="${TRAVIS_TOKEN:-}" # default to travis program TRAVIS_HOST="${TRAVIS_HOST:-api.travis-ci.org}" REPO="${1}"; shift || usage "REPO required" BRANCH="${1}"; shift || usage "BRANCH required" VARS="${*}" repo="${REPO/\//%2F}" vars="" [ "${VARS}" ] && vars="\"${VARS// /\", \"}\"" body="{ \"request\": { \"message\": \"Manual build. Settings: ${VARS}\", \"branch\":\"${BRANCH}\", \"config\": { \"env\": { \"global\": [${vars}] } } } }" if [ -z "${TRAVIS_TOKEN}" ]; then which travis >/dev/null \ || die "TRAVIS_TOKEN not set and travis command not found" TRAVIS_TOKEN="$(travis token --org --no-interactive)" fi curl -X POST \ -H "Content-Type: application/json" \ -H "Accept: application/json" \ -H "Travis-API-Version: 3" \ -H "Authorization: token ${TRAVIS_TOKEN}" \ -d "$body" \ "https://${TRAVIS_HOST}/repo/${repo}/requests" ================================================ FILE: impls/ts/.gitignore ================================================ node_modules/ npm-debug.log *.js ================================================ FILE: impls/ts/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install g++ libreadline-dev nodejs npm ENV NPM_CONFIG_CACHE /mal/.npm ================================================ FILE: impls/ts/Makefile ================================================ STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal all: ts node_modules: npm install step%.js: node_modules types.ts reader.ts printer.ts env.ts core.ts step%.ts ./node_modules/.bin/tsc -p ./ .PHONY: ts clean ts: $(foreach s,$(STEPS),$(s).js) clean: rm -f *.js ================================================ FILE: impls/ts/core.ts ================================================ import * as fs from "fs"; import { readline } from "./node_readline"; import { Node, MalType, MalSymbol, MalFunction, MalNil, MalList, MalVector, MalBoolean, MalNumber, MalString, MalKeyword, MalHashMap, MalAtom, equals, isSeq } from "./types"; import { readStr } from "./reader"; import { prStr } from "./printer"; export const ns: Map = (() => { const ns: { [symbol: string]: typeof MalFunction.prototype.func; } = { "="(a: MalType, b: MalType): MalBoolean { return new MalBoolean(equals(a, b)); }, throw(v: MalType): MalType { throw v; }, "nil?"(v: MalType) { return new MalBoolean(v.type === Node.Nil); }, "true?"(v: MalType) { return new MalBoolean(v.type === Node.Boolean && v.v); }, "false?"(v: MalType) { return new MalBoolean(v.type === Node.Boolean && !v.v); }, "string?"(v: MalType) { return new MalBoolean(v.type === Node.String); }, symbol(v: MalType) { if (v.type !== Node.String) { throw new Error(`unexpected symbol: ${v.type}, expected: string`); } return MalSymbol.get(v.v); }, "symbol?"(v: MalType) { return new MalBoolean(v.type === Node.Symbol); }, keyword(v: MalType) { if (v.type === Node.Keyword) { return v; } if (v.type !== Node.String) { throw new Error(`unexpected symbol: ${v.type}, expected: string`); } return MalKeyword.get(v.v); }, "keyword?"(v: MalType) { return new MalBoolean(v.type === Node.Keyword); }, "number?"(v: MalType) { return new MalBoolean(v.type === Node.Number); }, "fn?"(v: MalType) { return new MalBoolean(v.type === Node.Function && !v.isMacro); }, "macro?"(v: MalType) { return new MalBoolean(v.type === Node.Function && v.isMacro); }, "pr-str"(...args: MalType[]): MalString { return new MalString(args.map(v => prStr(v, true)).join(" ")); }, "str"(...args: MalType[]): MalString { return new MalString(args.map(v => prStr(v, false)).join("")); }, prn(...args: MalType[]): MalNil { const str = args.map(v => prStr(v, true)).join(" "); console.log(str); return MalNil.instance; }, println(...args: MalType[]): MalNil { const str = args.map(v => prStr(v, false)).join(" "); console.log(str); return MalNil.instance; }, "read-string"(v: MalType) { if (v.type !== Node.String) { throw new Error(`unexpected symbol: ${v.type}, expected: string`); } return readStr(v.v); }, readline(v: MalType) { if (v.type !== Node.String) { throw new Error(`unexpected symbol: ${v.type}, expected: string`); } const ret = readline(v.v); if (ret == null) { return MalNil.instance; } return new MalString(ret); }, slurp(v: MalType) { if (v.type !== Node.String) { throw new Error(`unexpected symbol: ${v.type}, expected: string`); } const content = fs.readFileSync(v.v, "utf-8"); return new MalString(content); }, "<"(a: MalType, b: MalType): MalBoolean { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalBoolean(a.v < b.v); }, "<="(a: MalType, b: MalType): MalBoolean { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalBoolean(a.v <= b.v); }, ">"(a: MalType, b: MalType): MalBoolean { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalBoolean(a.v > b.v); }, ">="(a: MalType, b: MalType): MalBoolean { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalBoolean(a.v >= b.v); }, "+"(a: MalType, b: MalType): MalNumber { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalNumber(a.v + b.v); }, "-"(a: MalType, b: MalType): MalNumber { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalNumber(a.v - b.v); }, "*"(a: MalType, b: MalType): MalNumber { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalNumber(a.v * b.v); }, "/"(a: MalType, b: MalType): MalNumber { if (a.type !== Node.Number) { throw new Error(`unexpected symbol: ${a.type}, expected: number`); } if (b.type !== Node.Number) { throw new Error(`unexpected symbol: ${b.type}, expected: number`); } return new MalNumber(a.v / b.v); }, "time-ms"() { return new MalNumber(Date.now()); }, list(...args: MalType[]): MalList { return new MalList(args); }, "list?"(v: MalType): MalBoolean { return new MalBoolean(v.type === Node.List); }, vector(...args: MalType[]): MalVector { return new MalVector(args); }, "vector?"(v: MalType): MalBoolean { return new MalBoolean(v.type === Node.Vector); }, "hash-map"(...args: MalType[]) { return new MalHashMap(args); }, "map?"(v: MalType): MalBoolean { return new MalBoolean(v.type === Node.HashMap); }, assoc(v: MalType, ...args: MalType[]) { if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } return v.assoc(args); }, dissoc(v: MalType, ...args: MalType[]) { if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } return v.dissoc(args); }, get(v: MalType, key: MalType) { if (v.type === Node.Nil) { return MalNil.instance; } if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } if (key.type !== Node.String && key.type !== Node.Keyword) { throw new Error(`unexpected symbol: ${key.type}, expected: string or keyword`); } return v.get(key) || MalNil.instance; }, "contains?"(v: MalType, key: MalType) { if (v.type === Node.Nil) { return MalNil.instance; } if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } if (key.type !== Node.String && key.type !== Node.Keyword) { throw new Error(`unexpected symbol: ${key.type}, expected: string or keyword`); } return new MalBoolean(v.has(key)); }, keys(v: MalType) { if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } return new MalList([...v.keys()]); }, vals(v: MalType) { if (v.type !== Node.HashMap) { throw new Error(`unexpected symbol: ${v.type}, expected: hash-map`); } return new MalList([...v.vals()]); }, "sequential?"(v: MalType) { return new MalBoolean(isSeq(v)); }, cons(a: MalType, b: MalType) { if (!isSeq(b)) { throw new Error(`unexpected symbol: ${b.type}, expected: list or vector`); } return new MalList([a].concat(b.list)); }, concat(...args: MalType[]) { const list = args .map(arg => { if (!isSeq(arg)) { throw new Error(`unexpected symbol: ${arg.type}, expected: list or vector`); } return arg; }) .reduce((p, c) => p.concat(c.list), [] as MalType[]); 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`); } if (idx.type !== Node.Number) { throw new Error(`unexpected symbol: ${idx.type}, expected: number`); } const v = list.list[idx.v]; if (!v) { throw new Error("nth: index out of range"); } return v; }, first(v: MalType) { if (v.type === Node.Nil) { return MalNil.instance; } if (!isSeq(v)) { throw new Error(`unexpected symbol: ${v.type}, expected: list or vector`); } return v.list[0] || MalNil.instance; }, rest(v: MalType) { if (v.type === Node.Nil) { return new MalList([]); } if (!isSeq(v)) { throw new Error(`unexpected symbol: ${v.type}, expected: list or vector`); } return new MalList(v.list.slice(1)); }, "empty?"(v: MalType): MalBoolean { if (!isSeq(v)) { return new MalBoolean(false); } return new MalBoolean(v.list.length === 0); }, count(v: MalType): MalNumber { if (isSeq(v)) { return new MalNumber(v.list.length); } if (v.type === Node.Nil) { return new MalNumber(0); } throw new Error(`unexpected symbol: ${v.type}`); }, apply(f: MalType, ...list: MalType[]) { if (f.type !== Node.Function) { throw new Error(`unexpected symbol: ${f.type}, expected: function`); } const tail = list[list.length - 1]; if (!isSeq(tail)) { throw new Error(`unexpected symbol: ${tail.type}, expected: list or vector`); } const args = list.slice(0, -1).concat(tail.list); return f.func(...args); }, map(f: MalType, list: MalType) { if (f.type !== Node.Function) { throw new Error(`unexpected symbol: ${f.type}, expected: function`); } if (!isSeq(list)) { throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); } return new MalList(list.list.map(v => f.func(v))); }, conj(list: MalType, ...args: MalType[]) { switch (list.type) { case Node.List: const newList = new MalList(list.list); args.forEach(arg => newList.list.unshift(arg)); return newList; case Node.Vector: return new MalVector([...list.list, ...args]); } throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); }, seq(v: MalType) { if (v.type === Node.List) { if (v.list.length === 0) { return MalNil.instance; } return v; } if (v.type === Node.Vector) { if (v.list.length === 0) { return MalNil.instance; } return new MalList(v.list); } if (v.type === Node.String) { if (v.v.length === 0) { return MalNil.instance; } return new MalList(v.v.split("").map(s => new MalString(s))); } if (v.type === Node.Nil) { return MalNil.instance; } throw new Error(`unexpected symbol: ${v.type}, expected: list or vector or string`); }, meta(v: MalType) { return v.meta || MalNil.instance; }, "with-meta"(v: MalType, m: MalType) { return v.withMeta(m); }, atom(v: MalType): MalAtom { return new MalAtom(v); }, "atom?"(v: MalType): MalBoolean { return new MalBoolean(v.type === Node.Atom); }, deref(v: MalType): MalType { if (v.type !== Node.Atom) { throw new Error(`unexpected symbol: ${v.type}, expected: atom`); } return v.v; }, "reset!"(atom: MalType, v: MalType): MalType { if (atom.type !== Node.Atom) { throw new Error(`unexpected symbol: ${atom.type}, expected: atom`); } atom.v = v; return v; }, "swap!"(atom: MalType, f: MalType, ...args: MalType[]): MalType { if (atom.type !== Node.Atom) { throw new Error(`unexpected symbol: ${atom.type}, expected: atom`); } if (f.type !== Node.Function) { throw new Error(`unexpected symbol: ${f.type}, expected: function`); } atom.v = f.func(...[atom.v].concat(args)); return atom.v; }, }; const map : Map = new Map(); Object.keys(ns).forEach(key => map.set(key, MalFunction.fromBootstrap(ns[key]))); return map; })(); ================================================ FILE: impls/ts/env.ts ================================================ import { MalType, MalSymbol, MalList } from "./types"; export class Env { data: Map; constructor(public outer?: Env, binds: MalSymbol[] = [], exprts: MalType[] = []) { this.data = new Map(); for (let i = 0; i < binds.length; i++) { const bind : string = binds[i].v; if (bind === "&") { this.set(binds[i + 1].v, new MalList(exprts.slice(i))); break; } this.set(bind, exprts[i]); } } set(key: string, value: MalType): MalType { this.data.set(key, value); return value; } get(key: string): MalType | null { const result : MalType | undefined = this.data.get(key); if (result) { return result; } else if (this.outer) { return this.outer.get(key); } else { return null; } } } ================================================ FILE: impls/ts/node_readline.ts ================================================ import * as path from "path"; import * as koffi from "koffi"; import * as fs from "fs"; // IMPORTANT: choose one const RL_LIB = "libreadline.so.8"; // NOTE: libreadline is GPL // const RL_LIB = "libedit.so.2"; const HISTORY_FILE = path.join(process.env.HOME || ".", ".mal-history"); let rllib: any; try { rllib = koffi.load(RL_LIB); } catch (e) { console.error('ERROR loading RL_LIB:', RL_LIB, e); throw e; } const readlineFunc = rllib.func('char *readline(char *)'); const addHistoryFunc = rllib.func('int add_history(char *)'); let rlHistoryLoaded = false; export function readline(prompt?: string): string | null { prompt = prompt || "user> "; if (!rlHistoryLoaded) { rlHistoryLoaded = true; let lines: string[] = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (let i = 0; i < lines.length; i++) { if (lines[i]) { addHistoryFunc(lines[i]); } } } const line = readlineFunc(prompt); if (line) { addHistoryFunc(line); try { fs.appendFileSync(HISTORY_FILE, line + "\n"); } catch (exc) { // ignored } } return line; }; ================================================ FILE: impls/ts/package.json ================================================ { "name": "mal", "private": true, "version": "1.0.0", "description": "Make a Lisp (mal) language implemented in TypeScript", "scripts": { "build": "tsfmt -r && tsc -p ./", "test": "npm run build && npm run test:step0 && npm run test:step1 && npm run test:step2 && npm run test:step3 && npm run test:step4 && npm run test:step5 && npm run test:step6 && npm run test:step7 && npm run test:step8 && npm run test:step9 && npm run test:stepA", "test:step0": "cd .. && make 'test^ts^step0'", "test:step1": "cd .. && make 'test^ts^step1'", "test:step2": "cd .. && make 'test^ts^step2'", "test:step3": "cd .. && make 'test^ts^step3'", "test:step4": "cd .. && make 'test^ts^step4'", "test:step5": "cd .. && make 'test^ts^step5'", "test:step6": "cd .. && make 'test^ts^step6'", "test:step7": "cd .. && make 'test^ts^step7'", "test:step8": "cd .. && make 'test^ts^step8'", "test:step9": "cd .. && make 'test^ts^step9'", "test:stepA": "cd .. && make 'test^ts^stepA'" }, "dependencies": { "koffi": "^2.12.1" }, "devDependencies": { "@types/node": "^14.14.3", "typescript": "^4.3.5", "typescript-formatter": "^7.2.2" } } ================================================ FILE: impls/ts/printer.ts ================================================ import { Node, MalType } from "./types"; export function prStr(v: MalType, printReadably = true): string { switch (v.type) { case Node.List: return `(${v.list.map(v => prStr(v, printReadably)).join(" ")})`; case Node.Vector: return `[${v.list.map(v => prStr(v, printReadably)).join(" ")}]`; case Node.HashMap: let result = "{"; for (const [key, value] of v.entries()) { if (result !== "{") { result += " "; } result += `${prStr(key, printReadably)} ${prStr(value, printReadably)}`; } result += "}"; return result; case Node.Number: case Node.Symbol: case Node.Boolean: return `${v.v}`; case Node.String: if (printReadably) { const str = v.v .replace(/\\/g, "\\\\") .replace(/"/g, '\\"') .replace(/\n/g, "\\n"); return `"${str}"`; } else { return v.v; } case Node.Nil: return "nil"; case Node.Keyword: return `:${v.v}`; case Node.Function: return "#"; case Node.Atom: return `(atom ${prStr(v.v, printReadably)})`; } } ================================================ FILE: impls/ts/reader.ts ================================================ import { MalType, MalList, MalString, MalNumber, MalBoolean, MalNil, MalKeyword, MalSymbol, MalVector, MalHashMap } from "./types"; class Reader { position = 0; constructor(private tokens: string[]) { } next(): string { const ret = this.peek(); this.position += 1; return ret; } peek(): string { return this.tokens[this.position]; } } export function readStr(input: string): MalType { const tokens = tokenizer(input); const reader = new Reader(tokens); return readForm(reader); } function tokenizer(input: string): string[] { const regexp = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*)/g; const tokens: string[] = []; while (true) { const matches = regexp.exec(input); if (!matches) { break; } const match = matches[1]; if (match === "") { break; } if (match[0] !== ";") { tokens.push(match); } } return tokens; } function readForm(reader: Reader): MalType { const token = reader.peek(); switch (token) { case "(": return readList(reader); case "[": return readVector(reader); case "{": return readHashMap(reader); case "'": return readSymbol("quote"); case "`": return readSymbol("quasiquote"); case "~": return readSymbol("unquote"); case "~@": return readSymbol("splice-unquote"); case "@": return readSymbol("deref"); case "^": { reader.next(); const sym = MalSymbol.get("with-meta"); const target = readForm(reader); return new MalList([sym, readForm(reader), target]); } default: return readAtom(reader); } function readSymbol(name: string) { reader.next(); const sym = MalSymbol.get(name); const target = readForm(reader); return new MalList([sym, target]); } } function readList(reader: Reader): MalType { return readParen(reader, MalList, "(", ")"); } function readVector(reader: Reader): MalType { return readParen(reader, MalVector, "[", "]"); } function readHashMap(reader: Reader): MalType { return readParen(reader, MalHashMap, "{", "}"); } function readParen(reader: Reader, ctor: { new (list: MalType[]): MalType; }, open: string, close: string): MalType { const token = reader.next(); // drop open paren if (token !== open) { throw new Error(`unexpected token ${token}, expected ${open}`); } const list: MalType[] = []; while (true) { const next = reader.peek(); if (next === close) { break; } else if (!next) { throw new Error("unexpected EOF"); } list.push(readForm(reader)); } reader.next(); // drop close paren return new ctor(list); } function readAtom(reader: Reader): MalType { const token = reader.next(); if (token.match(/^-?[0-9]+$/)) { const v = parseInt(token, 10); return new MalNumber(v); } if (token.match(/^-?[0-9]\.[0-9]+$/)) { const v = parseFloat(token); return new MalNumber(v); } if (token.match(/^"(?:\\.|[^\\"])*"$/)) { const v = token.slice(1, token.length - 1) .replace(/\\(.)/g, (_, c: string) => c == 'n' ? '\n' : c) return new MalString(v); } if (token[0] === '"') { throw new Error("expected '\"', got EOF"); } if (token[0] === ":") { return MalKeyword.get(token.substr(1)); } switch (token) { case "nil": return MalNil.instance; case "true": return new MalBoolean(true); case "false": return new MalBoolean(false); } return MalSymbol.get(token); } ================================================ FILE: impls/ts/run ================================================ #!/usr/bin/env bash exec node $(dirname $0)/${STEP:-stepA_mal}.js "${@}" ================================================ FILE: impls/ts/step0_repl.ts ================================================ import { readline } from "./node_readline"; // READ function read(str: string): any { // TODO return str; } // EVAL function evalMal(ast: any, _env?: any): any { // TODO return ast; } // PRINT function print(exp: any): string { // TODO return exp; } function rep(str: string): string { // TODO return print(evalMal(read(str))); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } console.log(rep(line)); } ================================================ FILE: impls/ts/step1_read_print.ts ================================================ import { readline } from "./node_readline"; import { MalType } from "./types"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } // EVAL function evalMal(ast: any, _env?: any): any { // TODO return ast; } // PRINT function print(exp: MalType): string { return prStr(exp); } function rep(str: string): string { return print(evalMal(read(str))); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { const err: Error = e; console.error(err.message); } } ================================================ FILE: impls/ts/step2_eval.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction } from "./types"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } interface MalEnvironment { [key: string]: MalFunction; } // EVAL function evalMal(ast: MalType, env: MalEnvironment): MalType { // console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f = env[ast.v]; if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const f : MalType = evalMal(ast.list[0], env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); return f.func(...args); } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv: MalEnvironment = { "+": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v + b!.v)), "-": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v - b!.v)), "*": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v * b!.v)), "/": MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v / b!.v)), }; function rep(str: string): string { return print(evalMal(read(str), replEnv)); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { const err: Error = e; console.error(err.message); } } ================================================ FILE: impls/ts/step3_env.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalNumber, MalVector, MalHashMap, MalFunction, isSeq } from "./types"; import { Env } from "./env"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } // EVAL function evalMal(ast: MalType, env: Env): MalType { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { let letEnv = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } const list = pairs.list; for (let i = 0; i < list.length; i += 2) { const key = list[i]; const value = list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } letEnv.set(key.v, evalMal(value, letEnv)); } return evalMal(ast.list[2], letEnv); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); return f.func(...args); } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } replEnv.set("+", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v + b!.v))); replEnv.set("-", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v - b!.v))); replEnv.set("*", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v * b!.v))); replEnv.set("/", MalFunction.fromBootstrap((a?: MalNumber, b?: MalNumber) => new MalNumber(a!.v / b!.v))); while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { const err: Error = e; console.error(err.message); } } ================================================ FILE: impls/ts/step4_if_fn_do.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } // EVAL function evalMal(ast: MalType, env: Env): MalType { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { let letEnv = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } letEnv.set(key.v, evalMal(value, letEnv)); } return evalMal(ast.list[2], letEnv); } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); return evalMal(ast.list[ast.list.length - 1], env); } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { return evalMal(thenExpr, env); } else if (elseExrp) { return evalMal(elseExrp, env); } else { return MalNil.instance; } } case "fn*": { const [, args, binds] = ast.list; if (!isSeq(args)) { throw new Error(`unexpected return type: ${args.type}, expected: list or vector`); } const symbols = args.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromBootstrap((...fnArgs: MalType[]) => { return evalMal(binds, new Env(env, symbols, fnArgs)); }); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); return f.func(...args); } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/step5_tco.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalNil, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/step6_file.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ function read(str: string): MalType { return readStr(str); } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); if (typeof process !== "undefined" && 2 < process.argv.length) { replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/step7_quote.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ 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 { 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; } } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "quote": { return ast.list[1]; } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); if (typeof process !== "undefined" && 2 < process.argv.length) { replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/step8_macros.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ 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 { 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; } } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "quote": { return ast.list[1]; } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; } case "defmacro!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } const f = evalMal(value, env); if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } return env.set(key.v, f.toMacro()); } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } if (f.isMacro) { ast = f.func(...ast.list.slice(1)); continue loop; } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); if (typeof process !== "undefined" && 2 < process.argv.length) { replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/step9_try.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ 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 { 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; } } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "quote": { return ast.list[1]; } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; } case "defmacro!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } const f = evalMal(value, env); if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } return env.set(key.v, f.toMacro()); } case "try*": { try { return evalMal(ast.list[1], env); } catch (e) { if (ast.list.length < 3) { throw e; } const catchBody = ast.list[2]; if (!isSeq(catchBody)) { throw new Error(`unexpected return type: ${catchBody.type}, expected: list or vector`); } const catchSymbol = catchBody.list[0]; if (catchSymbol.type === Node.Symbol && catchSymbol.v === "catch*") { const errorSymbol = catchBody.list[1]; if (errorSymbol.type !== Node.Symbol) { throw new Error(`unexpected return type: ${errorSymbol.type}, expected: symbol`); } if (!isAST(e)) { e = new MalString((e as Error).message); } return evalMal(catchBody.list[2], new Env(env, [errorSymbol], [e])); } throw e; } } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } if (f.isMacro) { ast = f.func(...ast.list.slice(1)); continue loop; } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); if (typeof process !== "undefined" && 2 < process.argv.length) { replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/stepA_mal.ts ================================================ import { readline } from "./node_readline"; import { Node, MalType, MalString, MalNil, MalList, MalVector, MalHashMap, MalSymbol, MalFunction, isAST, isSeq } from "./types"; import { Env } from "./env"; import * as core from "./core"; import { readStr } from "./reader"; import { prStr } from "./printer"; // READ 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 { 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; } } // EVAL function evalMal(ast: MalType, env: Env): MalType { loop: while (true) { // Output a debug line if the option is enabled. const dbgeval : MalType | null = env.get("DEBUG-EVAL"); if (dbgeval !== null && dbgeval.type !== Node.Nil && (dbgeval.type !== Node.Boolean || dbgeval.v)) console.log("EVAL:", prStr(ast)); // Deal with non-list types. switch (ast.type) { case Node.Symbol: const f : MalType | null = env.get(ast.v); if (!f) { throw new Error(`'${ast.v}' not found`); } return f; case Node.List: break; case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: const list: MalType[] = []; for (const [key, value] of ast.entries()) { list.push(key); list.push(evalMal(value, env)); } return new MalHashMap(list); default: return ast; } if (ast.list.length === 0) { return ast; } const first = ast.list[0]; switch (first.type) { case Node.Symbol: switch (first.v) { case "def!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } return env.set(key.v, evalMal(value, env)); } case "let*": { env = new Env(env); const pairs = ast.list[1]; if (!isSeq(pairs)) { throw new Error(`unexpected token type: ${pairs.type}, expected: list or vector`); } for (let i = 0; i < pairs.list.length; i += 2) { const key = pairs.list[i]; const value = pairs.list[i + 1]; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!key || !value) { throw new Error(`unexpected syntax`); } env.set(key.v, evalMal(value, env)); } ast = ast.list[2]; continue loop; } case "quote": { return ast.list[1]; } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; } case "defmacro!": { const [, key, value] = ast.list; if (key.type !== Node.Symbol) { throw new Error(`unexpected token type: ${key.type}, expected: symbol`); } if (!value) { throw new Error(`unexpected syntax`); } const f = evalMal(value, env); if (f.type !== Node.Function) { throw new Error(`unexpected token type: ${f.type}, expected: function`); } return env.set(key.v, f.toMacro()); } case "try*": { try { return evalMal(ast.list[1], env); } catch (e) { if (ast.list.length < 3) { throw e; } const catchBody = ast.list[2]; if (!isSeq(catchBody)) { throw new Error(`unexpected return type: ${catchBody.type}, expected: list or vector`); } const catchSymbol = catchBody.list[0]; if (catchSymbol.type === Node.Symbol && catchSymbol.v === "catch*") { const errorSymbol = catchBody.list[1]; if (errorSymbol.type !== Node.Symbol) { throw new Error(`unexpected return type: ${errorSymbol.type}, expected: symbol`); } if (!isAST(e)) { e = new MalString((e as Error).message); } return evalMal(catchBody.list[2], new Env(env, [errorSymbol], [e])); } throw e; } } case "do": { for (let i = 1; i < ast.list.length - 1; i++) evalMal(ast.list[i], env); ast = ast.list[ast.list.length - 1]; continue loop; } case "if": { const [, cond, thenExpr, elseExrp] = ast.list; const ret = evalMal(cond, env); let b = true; if (ret.type === Node.Boolean && !ret.v) { b = false; } else if (ret.type === Node.Nil) { b = false; } if (b) { ast = thenExpr; } else if (elseExrp) { ast = elseExrp; } else { ast = MalNil.instance; } continue loop; } case "fn*": { const [, params, bodyAst] = ast.list; if (!isSeq(params)) { throw new Error(`unexpected return type: ${params.type}, expected: list or vector`); } const symbols = params.list.map(param => { if (param.type !== Node.Symbol) { throw new Error(`unexpected return type: ${param.type}, expected: symbol`); } return param; }); return MalFunction.fromLisp(evalMal, env, symbols, bodyAst); } } } const f : MalType = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } if (f.isMacro) { ast = f.func(...ast.list.slice(1)); continue loop; } const args : Array = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); continue loop; } return f.func(...args); } } // PRINT function print(exp: MalType): string { return prStr(exp); } const replEnv = new Env(); function rep(str: string): string { return print(evalMal(read(str), replEnv)); } // core.EXT: defined using Racket core.ns.forEach((value, key) => { replEnv.set(key, value); }); replEnv.set("eval", MalFunction.fromBootstrap(ast => { if (!ast) { throw new Error(`undefined argument`); } return evalMal(ast, replEnv); })); replEnv.set("*ARGV*", new MalList([])); // core.mal: defined using the language itself rep(`(def! *host-language* "TypeScript")`); rep("(def! not (fn* (a) (if a false true)))"); rep(`(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))`); rep(`(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))`); if (typeof process !== "undefined" && 2 < process.argv.length) { replEnv.set("*ARGV*", new MalList(process.argv.slice(3).map(s => new MalString(s)))); rep(`(load-file "${process.argv[2]}")`); process.exit(0); } rep(`(println (str "Mal [" *host-language* "]"))`); while (true) { const line = readline("user> "); if (line == null) { break; } if (line === "") { continue; } try { console.log(rep(line)); } catch (e) { if (isAST(e)) { console.error("Error:", prStr(e)); } else { const err: Error = e; console.error("Error:", err.message); } } } ================================================ FILE: impls/ts/tsconfig.json ================================================ { "compilerOptions": { "module": "commonjs", "target": "es5", "lib": [ "es2015" ], "noImplicitAny": true, "noEmitOnError": true, "noImplicitReturns": true, "noImplicitThis": true, "noUnusedLocals": true, "noUnusedParameters": true, "newLine": "LF", "strictNullChecks": true, "sourceMap": false }, "exclude": [ "node_modules" ] } ================================================ FILE: impls/ts/types.ts ================================================ import { Env } from "./env"; export type MalType = MalList | MalNumber | MalString | MalNil | MalBoolean | MalSymbol | MalKeyword | MalVector | MalHashMap | MalFunction | MalAtom; export const enum Node { List = 1, Number, String, Nil, Boolean, Symbol, Keyword, Vector, HashMap, Function, Atom, } export function equals(a: MalType, b: MalType, strict?: boolean): boolean { if (strict && a.type !== b.type) { return false; } if (a.type === Node.Nil && b.type === Node.Nil) { return true; } if (isSeq(a) && isSeq(b)) { return listEquals(a.list, b.list); } if (a.type === Node.HashMap && b.type === Node.HashMap) { if (a.keywordMap.size !== b.keywordMap.size) { return false; } if (Object.keys(a.stringMap).length !== Object.keys(b.stringMap).length) { return false; } for (const [aK, aV] of a.entries()) { if (aK.type !== Node.String && aK.type !== Node.Keyword) { throw new Error(`unexpected symbol: ${aK.type}, expected: string or keyword`); } const bV = b.get(aK); if (aV.type === Node.Nil && bV.type === Node.Nil) { continue; } if (!equals(aV, bV)) { return false; } } return true; } if ( (a.type === Node.Number && b.type === Node.Number) || (a.type === Node.String && b.type === Node.String) || (a.type === Node.Boolean && b.type === Node.Boolean) || (a.type === Node.Symbol && b.type === Node.Symbol) || (a.type === Node.Keyword && b.type === Node.Keyword) ) { return a.v === b.v; } return false; function listEquals(a: MalType[], b: MalType[]): boolean { if (a.length !== b.length) { return false; } for (let i = 0; i < a.length; i++) { if (!equals(a[i], b[i], strict)) { return false; } } return true; } } export function isSeq(ast: MalType): ast is MalList | MalVector { return ast.type === Node.List || ast.type === Node.Vector; } export function isAST(v: MalType): v is MalType { return !!v.type; } export class MalList { type: Node.List = Node.List; meta?: MalType; constructor(public list: MalType[]) { } withMeta(meta: MalType) { const v = new MalList(this.list); v.meta = meta; return v; } } export class MalNumber { type: Node.Number = Node.Number; meta?: MalType; constructor(public v: number) { } withMeta(meta: MalType) { const v = new MalNumber(this.v); v.meta = meta; return v; } } export class MalString { type: Node.String = Node.String; meta?: MalType; constructor(public v: string) { } withMeta(meta: MalType) { const v = new MalString(this.v); v.meta = meta; return v; } } export class MalNil { private static _instance?: MalNil; static get instance(): MalNil { if (this._instance) { return this._instance; } this._instance = new MalNil(); return this._instance; } type: Node.Nil = Node.Nil; meta?: MalType; private constructor() { } withMeta(_meta: MalType): MalNil { throw new Error(`not supported`); } } export class MalBoolean { type: Node.Boolean = Node.Boolean; meta?: MalType; constructor(public v: boolean) { } withMeta(meta: MalType) { const v = new MalBoolean(this.v); v.meta = meta; return v; } } export class MalSymbol { static map = new Map(); static get(name: string): MalSymbol { const sym = Symbol.for(name); let token = this.map.get(sym); if (token) { return token; } token = new MalSymbol(name); this.map.set(sym, token); return token; } type: Node.Symbol = Node.Symbol; meta?: MalType; private constructor(public v: string) { } withMeta(_meta: MalType): MalSymbol { throw new Error(`not supported`); } } export class MalKeyword { static map = new Map(); static get(name: string): MalKeyword { const sym = Symbol.for(name); let token = this.map.get(sym); if (token) { return token; } token = new MalKeyword(name); this.map.set(sym, token); return token; } type: Node.Keyword = Node.Keyword; meta?: MalType; private constructor(public v: string) { } withMeta(_meta: MalType): MalKeyword { throw new Error(`not supported`); } } export class MalVector { type: Node.Vector = Node.Vector; meta?: MalType; constructor(public list: MalType[]) { } withMeta(meta: MalType) { const v = new MalVector(this.list); v.meta = meta; return v; } } export class MalHashMap { type: Node.HashMap = Node.HashMap; stringMap: { [key: string]: MalType } = {}; keywordMap = new Map(); meta?: MalType; constructor(list: MalType[]) { while (list.length !== 0) { const key = list.shift()!; const value = list.shift(); if (value == null) { throw new Error("unexpected hash length"); } if (key.type === Node.Keyword) { this.keywordMap.set(key, value); } else if (key.type === Node.String) { this.stringMap[key.v] = value; } else { throw new Error(`unexpected key symbol: ${key.type}, expected: keyword or string`); } } } withMeta(meta: MalType) { const v = this.assoc([]); v.meta = meta; return v; } has(key: MalKeyword | MalString) { if (key.type === Node.Keyword) { return !!this.keywordMap.get(key); } return !!this.stringMap[key.v]; } get(key: MalKeyword | MalString) { if (key.type === Node.Keyword) { return this.keywordMap.get(key) || MalNil.instance; } return this.stringMap[key.v] || MalNil.instance; } entries(): [MalType, MalType][] { const list: [MalType, MalType][] = []; this.keywordMap.forEach((v, k) => { list.push([k, v]); }); Object.keys(this.stringMap).forEach(v => list.push([new MalString(v), this.stringMap[v]])); return list; } keys(): MalType[] { const list: MalType[] = []; this.keywordMap.forEach((_v, k) => { list.push(k); }); Object.keys(this.stringMap).forEach(v => list.push(new MalString(v))); return list; } vals(): MalType[] { const list: MalType[] = []; this.keywordMap.forEach(v => { list.push(v); }); Object.keys(this.stringMap).forEach(v => list.push(this.stringMap[v])); return list; } assoc(args: MalType[]): MalHashMap { const list: MalType[] = []; this.keywordMap.forEach((value, key) => { list.push(key); list.push(value); }); Object.keys(this.stringMap).forEach(keyStr => { list.push(new MalString(keyStr)); list.push(this.stringMap[keyStr]); }); return new MalHashMap(list.concat(args)); } dissoc(args: MalType[]): MalHashMap { const newHashMap = this.assoc([]); args.forEach(arg => { if (arg.type === Node.String) { delete newHashMap.stringMap[arg.v]; } else if (arg.type === Node.Keyword) { newHashMap.keywordMap.delete(arg); } else { throw new Error(`unexpected symbol: ${arg.type}, expected: keyword or string`); } }); return newHashMap; } } type MalF = (...args: (MalType | undefined)[]) => MalType; export class MalFunction { static fromLisp(evalMal: (ast: MalType, env: Env) => MalType, env: Env, params: MalSymbol[], bodyAst: MalType): MalFunction { const f = new MalFunction(); f.func = (...args) => evalMal(bodyAst, new Env(env, params, checkUndefined(args))); f.env = env; f.params = params; f.ast = bodyAst; f.isMacro = false; return f; function checkUndefined(args: (MalType | undefined)[]): MalType[] { return args.map(arg => { if (!arg) { throw new Error(`undefined argument`); } return arg; }); } } static fromBootstrap(func: MalF): MalFunction { const f = new MalFunction(); f.func = func; f.isMacro = false; return f; } type: Node.Function = Node.Function; func: MalF; ast: MalType; env: Env; params: MalSymbol[]; isMacro: boolean; meta?: MalType; private constructor() { } toMacro() { const f = new MalFunction(); f.func = this.func; f.ast = this.ast; f.env = this.env; f.params = this.params; f.isMacro = true; f.meta = this.meta; return f; } withMeta(meta: MalType) { const f = new MalFunction(); f.func = this.func; f.ast = this.ast; f.env = this.env; f.params = this.params; f.isMacro = this.isMacro; f.meta = meta; return f; } newEnv(args: MalType[]) { return new Env(this.env, this.params, args); } } export class MalAtom { type: Node.Atom = Node.Atom; meta?: MalType; constructor(public v: MalType) { } withMeta(meta: MalType) { const v = new MalAtom(this.v); v.meta = meta; return v; } } ================================================ FILE: impls/vala/.gitignore ================================================ *.c *.h *.o ================================================ FILE: impls/vala/Dockerfile ================================================ FROM ubuntu:18.04 ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Nothing additional needed for vala RUN apt-get -y install valac ================================================ FILE: impls/vala/Makefile ================================================ PROGRAMS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \ step5_tco step6_file step7_quote step8_macros step9_try stepA_mal AUX1 = gc.vala types.vala reader.vala printer.vala AUX3 = $(AUX1) env.vala AUX4 = $(AUX3) core.vala # Inhibit default make rules, in case they try to build from leftover .c files .SUFFIXES: all: $(PROGRAMS) # You can define VFLAGS on the command line to add flags to the vala compiler. # Some useful ones: # # -g annotate the output C with #line directives so that backtraces # from gdb, sanitisers and valgrind will list Vala source locations # # -X -g -X -O0 compile the output C for sensible debugging # # -X -fsanitize=address link the output program against Address Sanitizer # # --save-temps don't automatically delete the C files after compiling # # -D GC_STATS print statistics every time the garbage collector runs # # -D GC_DEBUG print full diagnostics from the garbage collector # # -D GC_ALWAYS make the garbage collector run at every opportunity # (good for making occasional GC errors show up sooner) $(PROGRAMS): %: %.vala valac $(VFLAGS) -o $@ $^ $(DEFINES) --pkg readline -X -lreadline step1_read_print step2_eval: override DEFINES += -D NO_ENV step0_repl: step1_read_print: $(AUX1) step2_eval: $(AUX1) step3_env: $(AUX3) step4_if_fn_do: $(AUX4) step5_tco: $(AUX4) step6_file: $(AUX4) step7_quote: $(AUX4) step8_macros: $(AUX4) step9_try: $(AUX4) stepA_mal: $(AUX4) clean: clean-c rm -f $(PROGRAMS) clean-c: rm -f *.c *.h ================================================ FILE: impls/vala/README.md ================================================ # Vala implementation Notes on building: * With the Debian or Ubuntu packages `valac` and `libreadline-dev` installed, and GNU make, you should be able to build using the provided Makefile. * The build will not be warning-clean, because the shared modules like `types.vala` and `core.vala` are shared between all the `stepN` main programs, and not all the steps use all the functions in the shared modules, and the Vala compiler has no way to turn off the warning about unused pieces of source code. * The Vala compiler works by translating the program to C and then compiling that. The C compilation stage can sometimes encounter an error, in which case the compiler will leave `.c` source files in the working directory. If that happens, you can run `make clean-c` to get rid of them. Design notes on the implementation: * Vala has exceptions (which it calls 'error domains'), but they don't let you store an arbitrary data type: every exception subclass you make stores the same data, namely a string. So mal exceptions are implemented by storing a mal value in a static variable, and then throwing a particular Vala error whose semantics are 'check that variable when you catch me'. * Vala's bare function pointers are hard to use, especially if you want one to survive the scope it was created in. So all the core functions are implemented as classes with a `call` method, which leads to a lot of boilerplate. * To make `types.vala` work in step 2, when the `Env` type doesn't exist yet, I had to use `#if` to condition out the parts of the code that depend on that type. * Mutability of objects at the Vala level is a bit informal. A lot of core functions construct a list by making an empty `Mal.List` and then mutating the `GLib.List` contained in it. But once they've finished and returned the `Mal.List` to their caller, that list is never mutated again, which means it's safe for the copying operation in `with-meta` to make a second `Mal.List` sharing the reference to the same `GLib.List`. * Vala has a reference counting system built in to the language, but that's not enough to implement mal sensibly, because the common construction `(def! FUNC (fn* [ARGS] BODY))` causes a length-2 cycle of references: the environment captured in `FUNC`'s function object is the same one where `def!` inserts the definition of `FUNC`, so the function and environment both link to each other. And either element of the cycle could end up being the last one referred to from elsewhere, so you can't break the link by just making the right one of those references weak. So instead there's a small garbage collector in `gc.vala`, which works by being the only part of the program that keeps a non-weak reference to any `Mal.Val` or `Mal.Env`: it links all GCable objects together into a list, and when the collector runs, it unlinks dead objects from that list and allows Vala's normal reference counting to free them. ================================================ FILE: impls/vala/core.vala ================================================ abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { public abstract int64 result(int64 a, int64 b); public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); Mal.Num a = args.vs.data as Mal.Num; Mal.Num b = args.vs.next.data as Mal.Num; if (a == null || b == null) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); return new Mal.Num(result(a.v, b.v)); } } class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAdd(); } public override string name() { return "+"; } public override int64 result(int64 a, int64 b) { return a+b; } } class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSub(); } public override string name() { return "-"; } public override int64 result(int64 a, int64 b) { return a-b; } } class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMul(); } public override string name() { return "*"; } public override int64 result(int64 a, int64 b) { return a*b; } } class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionDiv(); } public override string name() { return "/"; } public override int64 result(int64 a, int64 b) { return a/b; } } class Mal.BuiltinFunctionPrStr : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionPrStr(); } public override string name() { return "pr-str"; } public override Mal.Val call(Mal.List args) throws Mal.Error { string result = ""; string sep = ""; foreach (var value in args.vs) { result += sep + pr_str(value, true); sep = " "; } return new Mal.String(result); } } class Mal.BuiltinFunctionStr : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionStr(); } public override string name() { return "str"; } public override Mal.Val call(Mal.List args) throws Mal.Error { string result = ""; foreach (var value in args.vs) { result += pr_str(value, false); } return new Mal.String(result); } } class Mal.BuiltinFunctionPrn : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionPrn(); } public override string name() { return "prn"; } public override Mal.Val call(Mal.List args) throws Mal.Error { string sep = ""; foreach (var value in args.vs) { stdout.printf("%s%s", sep, pr_str(value, true)); sep = " "; } stdout.printf("\n"); return new Mal.Nil(); } } class Mal.BuiltinFunctionPrintln : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionPrintln(); } public override string name() { return "println"; } public override Mal.Val call(Mal.List args) throws Mal.Error { string sep = ""; foreach (var value in args.vs) { stdout.printf("%s%s", sep, pr_str(value, false)); sep = " "; } stdout.printf("\n"); return new Mal.Nil(); } } class Mal.BuiltinFunctionReadString : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionReadString(); } public override string name() { return "read-string"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); return Reader.read_str((args.vs.data as Mal.String).v); } } class Mal.BuiltinFunctionSlurp : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSlurp(); } public override string name() { return "slurp"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); string filename = (args.vs.data as Mal.String).v; string contents; try { FileUtils.get_contents(filename, out contents); } catch (FileError e) { throw new Mal.Error.BAD_PARAMS("%s: unable to read '%s': %s", name(), filename, e.message); } return new Mal.String(contents); } } class Mal.BuiltinFunctionList : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionList(); } public override string name() { return "list"; } public override Mal.Val call(Mal.List args) throws Mal.Error { return args; } } class Mal.BuiltinFunctionListP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionListP(); } public override string name() { return "list?"; } 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()); return new Mal.Bool(args.vs.data is Mal.List); } } class Mal.BuiltinFunctionSequentialP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSequentialP(); } public override string name() { return "sequential?"; } 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()); return new Mal.Bool(args.vs.data is Mal.List || args.vs.data is Mal.Vector); } } class Mal.BuiltinFunctionNilP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionNilP(); } public override string name() { return "nil?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Nil); } } class Mal.BuiltinFunctionTrueP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionTrueP(); } public override string name() { return "true?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Bool && (args.vs.data as Mal.Bool).v); } } class Mal.BuiltinFunctionFalseP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionFalseP(); } public override string name() { return "false?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Bool && !(args.vs.data as Mal.Bool).v); } } class Mal.BuiltinFunctionNumberP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionNumberP(); } public override string name() { return "number?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Num); } } class Mal.BuiltinFunctionStringP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionStringP(); } public override string name() { return "string?"; } 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()); return new Mal.Bool(args.vs.data is Mal.String); } } class Mal.BuiltinFunctionSymbolP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSymbolP(); } public override string name() { return "symbol?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Sym); } } class Mal.BuiltinFunctionKeywordP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionKeywordP(); } public override string name() { return "keyword?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Keyword); } } class Mal.BuiltinFunctionVector : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionVector(); } public override string name() { return "vector"; } public override Mal.Val call(Mal.List args) throws Mal.Error { return new Mal.Vector.from_list(args.vs); } } class Mal.BuiltinFunctionVectorP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionVectorP(); } public override string name() { return "vector?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Vector); } } class Mal.BuiltinFunctionHashMap : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionHashMap(); } public override string name() { return "hash-map"; } public override Mal.Val call(Mal.List args) throws Mal.Error { var map = new Mal.Hashmap(); for (var iter = args.iter(); iter.nonempty(); iter.step()) { var key = iter.deref(); var value = iter.step().deref(); if (value == null) throw new Mal.Error.BAD_PARAMS( "%s: expected an even number of arguments", name()); map.insert(key, value); } return map; } } class Mal.BuiltinFunctionMapP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMapP(); } public override string name() { return "map?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Hashmap); } } class Mal.BuiltinFunctionEmptyP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEmptyP(); } public override string name() { return "empty?"; } 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 list = args.vs.data as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a list-like argument", name()); return new Mal.Bool(list.iter().deref() == null); } } class Mal.BuiltinFunctionFnP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionFnP(); } public override string name() { return "fn?"; } 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()); if (args.vs.data is Mal.BuiltinFunction) return new Mal.Bool(true); var fn = args.vs.data as Mal.Function; return new Mal.Bool(fn != null && !fn.is_macro); } } class Mal.BuiltinFunctionMacroP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMacroP(); } public override string name() { return "macro?"; } 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 fn = args.vs.data as Mal.Function; return new Mal.Bool(fn != null && fn.is_macro); } } class Mal.BuiltinFunctionCount : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionCount(); } public override string name() { return "count"; } 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()); if (args.vs.data is Mal.Nil) return new Mal.Num(0); // nil is treated like () if (args.vs.data is Mal.List) return new Mal.Num((args.vs.data as Mal.List).vs.length()); if (args.vs.data is Mal.Vector) return new Mal.Num((args.vs.data as Mal.Vector).length); throw new Mal.Error.BAD_PARAMS( "%s: expected a list argument", name()); } } class Mal.BuiltinFunctionEQ : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEQ(); } public override string name() { return "="; } private static bool eq(Mal.Val a, Mal.Val b) { if (a is Mal.Nil && b is Mal.Nil) return true; if (a is Mal.Bool && b is Mal.Bool) return (a as Mal.Bool).v == (b as Mal.Bool).v; if (a is Mal.Sym && b is Mal.Sym) return (a as Mal.Sym).v == (b as Mal.Sym).v; if (a is Mal.Keyword && b is Mal.Keyword) return (a as Mal.Keyword).v == (b as Mal.Keyword).v; if (a is Mal.Num && b is Mal.Num) return (a as Mal.Num).v == (b as Mal.Num).v; if (a is Mal.String && b is Mal.String) return (a as Mal.String).v == (b as Mal.String).v; if (a is Mal.Listlike && b is Mal.Listlike) { if (a is Mal.Nil || b is Mal.Nil) return false; var aiter = (a as Mal.Listlike).iter(); var biter = (b as Mal.Listlike).iter(); while (aiter.nonempty() || biter.nonempty()) { if (aiter.empty() || biter.empty()) return false; if (!eq(aiter.deref(), biter.deref())) return false; aiter.step(); biter.step(); } return true; } if (a is Mal.Vector && b is Mal.Vector) { var av = a as Mal.Vector; var bv = b as Mal.Vector; if (av.length != bv.length) return false; for (var i = 0; i < av.length; i++) if (!eq(av[i], bv[i])) return false; return true; } if (a is Mal.Hashmap && b is Mal.Hashmap) { var ah = (a as Mal.Hashmap).vs; var bh = (b as Mal.Hashmap).vs; if (ah.length != bh.length) return false; foreach (var k in ah.get_keys()) { var av = ah[k]; var bv = bh[k]; if (bv == null || !eq(av, bv)) return false; } return true; } if (a is Mal.BuiltinFunction && b is Mal.BuiltinFunction) { return ((a as Mal.BuiltinFunction).name() == (b as Mal.BuiltinFunction).name()); } if (a is Mal.Function && b is Mal.Function) { var af = a as Mal.Function; var bf = b as Mal.Function; return (eq(af.parameters, bf.parameters) && eq(af.body, bf.body)); } return false; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); return new Mal.Bool(eq(args.vs.data, args.vs.next.data)); } } abstract class Mal.BuiltinFunctionNumberCmp : Mal.BuiltinFunction { public abstract bool result(int64 a, int64 b); public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); Mal.Num a = args.vs.data as Mal.Num; Mal.Num b = args.vs.next.data as Mal.Num; if (a == null || b == null) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); return new Mal.Bool(result(a.v, b.v)); } } class Mal.BuiltinFunctionLT : Mal.BuiltinFunctionNumberCmp { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionLT(); } public override string name() { return "<"; } public override bool result(int64 a, int64 b) { return a"; } public override bool result(int64 a, int64 b) { return a>b; } } class Mal.BuiltinFunctionGE : Mal.BuiltinFunctionNumberCmp { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionGE(); } public override string name() { return ">="; } public override bool result(int64 a, int64 b) { return a>=b; } } class Mal.BuiltinFunctionAtom : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAtom(); } public override string name() { return "atom"; } 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()); return new Mal.Atom(args.vs.data); } } class Mal.BuiltinFunctionAtomP : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAtomP(); } public override string name() { return "atom?"; } 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()); return new Mal.Bool(args.vs.data is Mal.Atom); } } class Mal.BuiltinFunctionDeref : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionDeref(); } public override string name() { return "deref"; } 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 atom = args.vs.data as Mal.Atom; if (atom == null) throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name()); return atom.v; } } class Mal.BuiltinFunctionReset : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionReset(); } public override string name() { return "reset!"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var atom = args.vs.data as Mal.Atom; if (atom == null) throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name()); atom.v = args.vs.next.data; return atom.v; } } Mal.Val call_function(Mal.Val function, GLib.List args, string caller) throws Mal.Error { var fnargs = new Mal.List(args); if (function is Mal.BuiltinFunction) { return (function as Mal.BuiltinFunction).call(fnargs); } else if (function is Mal.Function) { var fn = function as Mal.Function; var env = new Mal.Env.funcall(fn.env, fn.parameters, fnargs); return Mal.Main.EVAL(fn.body, env); } else { throw new Mal.Error.CANNOT_APPLY("%s: expected a function", caller); } } class Mal.BuiltinFunctionSwap : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSwap(); } public override string name() { return "swap!"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() < 2) throw new Mal.Error.BAD_PARAMS( "%s: expected at least two arguments", name()); var atom = args.vs.data as Mal.Atom; var function = args.vs.next.data; var fnargs = args.vs.next.next.copy(); fnargs.prepend(atom.v); atom.v = call_function(function, fnargs, name()); return atom.v; } } class Mal.BuiltinFunctionCons : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionCons(); } public override string name() { return "cons"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var first = args.vs.data; var rest = args.vs.next.data as Mal.Listlike; if (rest == null) { if (args.vs.next.data is Mal.Nil) rest = new Mal.List.empty(); else throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); } var newlist = new Mal.List.empty(); newlist.vs.append(first); for (var iter = rest.iter(); iter.nonempty(); iter.step()) newlist.vs.append(iter.deref()); return newlist; } } class Mal.BuiltinFunctionConcat : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionConcat(); } public override string name() { return "concat"; } public override Mal.Val call(Mal.List args) throws Mal.Error { var newlist = new GLib.List(); foreach (var listval in args.vs) { if (listval is Mal.Nil) continue; var list = listval as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); for (var iter = list.iter(); iter.nonempty(); iter.step()) newlist.append(iter.deref()); } return new Mal.List(newlist); } } 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(); } public override string name() { return "nth"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var list = args.vs.data as Mal.Listlike; var index = args.vs.next.data as Mal.Num; if (list == null || index == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a list and a number", name()); if (index.v < 0) throw new Mal.Error.BAD_PARAMS( "%s: negative list index", name()); Mal.Val? result = null; if (list is Mal.Vector) { var vec = list as Mal.Vector; if (index.v < vec.length) result = vec[(uint)index.v]; } else { var iter = list.iter(); var i = index.v; while (!iter.empty()) { if (i == 0) { result = iter.deref(); break; } iter.step(); i--; } } if (result == null) throw new Mal.Error.BAD_PARAMS( "%s: list index out of range", name()); return result; } } class Mal.BuiltinFunctionFirst : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionFirst(); } public override string name() { return "first"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 1) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var list = args.vs.data as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a list number", name()); Mal.Val? result = list.iter().deref(); if (result == null) result = new Mal.Nil(); return result; } } class Mal.BuiltinFunctionRest : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionRest(); } public override string name() { return "rest"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 1) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var list = args.vs.data as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a list", name()); var result = new Mal.List.empty(); for (var iter = list.iter().step(); iter.nonempty(); iter.step()) result.vs.append(iter.deref()); return result; } } class Mal.BuiltinFunctionThrow : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionThrow(); } private static Mal.Val? curr_exception; static construct { curr_exception = null; } public static void clear() { curr_exception = null; } public static Mal.Val thrown_value(Mal.Error err) { if (err is Mal.Error.EXCEPTION_THROWN) { assert(curr_exception != null); Mal.Val toret = curr_exception; curr_exception = null; return toret; } else { return new Mal.String(err.message); } } public override string name() { return "throw"; } 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()); assert(curr_exception == null); curr_exception = args.vs.data; throw new Mal.Error.EXCEPTION_THROWN("core function throw called"); } } class Mal.BuiltinFunctionApply : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionApply(); } public override string name() { return "apply"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() < 2) throw new Mal.Error.BAD_PARAMS( "%s: expected at least two arguments", name()); var function = args.vs.data; unowned GLib.List lastlink = args.vs.last(); var list = lastlink.data as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS( "%s: expected final argument to be a list", name()); var fnargs = new GLib.List(); for (var iter = list.iter(); iter.nonempty(); iter.step()) fnargs.append(iter.deref()); for (unowned GLib.List link = lastlink.prev; link != args.vs; link = link.prev) fnargs.prepend(link.data); return call_function(function, fnargs, name()); } } class Mal.BuiltinFunctionMap : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMap(); } public override string name() { return "map"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); var function = args.vs.data; var list = args.vs.next.data as Mal.Listlike; if (list == null) throw new Mal.Error.BAD_PARAMS("%s: expected a list", name()); var result = new Mal.List.empty(); var root = new GC.Root(result); (void)root; for (var iter = list.iter(); iter.nonempty(); iter.step()) { var fnargs = new GLib.List(); fnargs.append(iter.deref()); result.vs.append(call_function(function, fnargs, name())); } return result; } } class Mal.BuiltinFunctionSymbol : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSymbol(); } public override string name() { return "symbol"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 1 || !(args.vs.data is Mal.String)) throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); return new Mal.Sym((args.vs.data as Mal.String).v); } } class Mal.BuiltinFunctionKeyword : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionKeyword(); } public override string name() { return "keyword"; } 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 string", name()); else if (args.vs.data is Mal.Keyword) return args.vs.data; else if (!(args.vs.data is Mal.String)) throw new Mal.Error.BAD_PARAMS("%s: expected one string", name()); return new Mal.Keyword((args.vs.data as Mal.String).v); } } class Mal.BuiltinFunctionAssoc : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAssoc(); } public override string name() { return "assoc"; } public override Mal.Val call(Mal.List args) throws Mal.Error { var iter = args.iter(); var oldmap = iter.deref() as Mal.Hashmap; if (iter.deref() is Mal.Nil) oldmap = new Mal.Hashmap(); if (oldmap == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to modify", name()); var map = new Mal.Hashmap(); foreach (var key in oldmap.vs.get_keys()) map.insert(key, oldmap.vs[key]); for (iter.step(); iter.nonempty(); iter.step()) { var key = iter.deref(); var value = iter.step().deref(); if (value == null) throw new Mal.Error.BAD_PARAMS( "%s: expected an even number of arguments", name()); map.insert(key, value); } return map; } } class Mal.BuiltinFunctionDissoc : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionDissoc(); } public override string name() { return "dissoc"; } public override Mal.Val call(Mal.List args) throws Mal.Error { var iter = args.iter(); var oldmap = iter.deref() as Mal.Hashmap; if (iter.deref() is Mal.Nil) oldmap = new Mal.Hashmap(); if (oldmap == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to modify", name()); var map = new Mal.Hashmap(); foreach (var key in oldmap.vs.get_keys()) map.insert(key, oldmap.vs[key]); for (iter.step(); iter.nonempty(); iter.step()) { var key = iter.deref(); map.remove(key); } return map; } } // Can't call it BuiltinFunctionGet, or else valac defines // BUILTIN_FUNCTION_GET_CLASS at the C level for this class, but that // was already defined as the 'get class' macro for BuiltinFunction // itself! class Mal.BuiltinFunctionGetFn : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionGetFn(); } public override string name() { return "get"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); if (args.vs.data is Mal.Nil) return new Mal.Nil(); var map = args.vs.data as Mal.Hashmap; if (map == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to query", name()); var key = args.vs.next.data as Mal.Hashable; if (key == null) throw new Mal.Error.HASH_KEY_TYPE_ERROR( "%s: bad type as hash key", name()); var value = map.vs[key]; return value != null ? value : new Mal.Nil(); } } class Mal.BuiltinFunctionContains : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionContains(); } public override string name() { return "contains?"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected two arguments", name()); if (args.vs.data is Mal.Nil) return new Mal.Bool(false); var map = args.vs.data as Mal.Hashmap; if (map == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to query", name()); var key = args.vs.next.data as Mal.Hashable; if (key == null) throw new Mal.Error.HASH_KEY_TYPE_ERROR( "%s: bad type as hash key", name()); var value = map.vs[key]; return new Mal.Bool(value != null); } } class Mal.BuiltinFunctionKeys : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionKeys(); } public override string name() { return "keys"; } 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 keys = new Mal.List.empty(); if (args.vs.data is Mal.Nil) return keys; var map = args.vs.data as Mal.Hashmap; if (map == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to query", name()); foreach (var key in map.vs.get_keys()) keys.vs.append(key); return keys; } } class Mal.BuiltinFunctionVals : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionVals(); } public override string name() { return "vals"; } 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 vals = new Mal.List.empty(); if (args.vs.data is Mal.Nil) return vals; var map = args.vs.data as Mal.Hashmap; if (map == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a hash-map to query", name()); foreach (var key in map.vs.get_keys()) vals.vs.append(map.vs[key]); return vals; } } class Mal.BuiltinFunctionReadline : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionReadline(); } public override string name() { return "readline"; } 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()); string prompt = ""; if (args.vs.data is Mal.String) prompt = (args.vs.data as Mal.String).v; else if (!(args.vs.data is Mal.Nil)) throw new Mal.Error.BAD_PARAMS( "%s: expected a string prompt", name()); string? line = Readline.readline(prompt); if (line == null) return new Mal.Nil(); return new Mal.String(line); } } class Mal.BuiltinFunctionMeta : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMeta(); } public override string name() { return "meta"; } 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 vwm = args.vs.data as Mal.ValWithMetadata; if (vwm == null || vwm.metadata == null) return new Mal.Nil(); return vwm.metadata; } } class Mal.BuiltinFunctionWithMeta : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionWithMeta(); } public override string name() { return "with-meta"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS( "%s: expected one argument", name()); var vwm = args.vs.data as Mal.ValWithMetadata; if (vwm == null) throw new Mal.Error.BAD_PARAMS( "%s: bad type for with-meta", name()); var copied = vwm.copy(); copied.metadata = args.vs.next.data; return copied; } } class Mal.BuiltinFunctionTimeMs : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionTimeMs(); } public override string name() { return "time-ms"; } public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 0) throw new Mal.Error.BAD_PARAMS( "%s: expected no arguments", name()); var time = GLib.TimeVal(); time.get_current_time(); return new Mal.Num(time.tv_sec * 1000 + time.tv_usec / 1000); } } class Mal.BuiltinFunctionConj : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionConj(); } public override string name() { return "conj"; } public override Mal.Val call(Mal.List args) throws Mal.Error { var iter = args.iter(); var collection = iter.deref() as Mal.Listlike; if (collection == null) throw new Mal.Error.BAD_PARAMS( "%s: expected a collection to modify", name()); if (collection is Mal.Vector) { var oldvec = collection as Mal.Vector; var n = args.vs.length() - 1; var newvec = new Mal.Vector.with_size(oldvec.length + n); int i; for (i = 0; i < oldvec.length; i++) newvec[i] = oldvec[i]; for (iter.step(); iter.nonempty(); iter.step(), i++) newvec[i] = iter.deref(); return newvec; } else { var newlist = new Mal.List.empty(); for (var citer = collection.iter(); citer.nonempty(); citer.step()) newlist.vs.append(citer.deref()); for (iter.step(); iter.nonempty(); iter.step()) newlist.vs.prepend(iter.deref()); return newlist; } } } class Mal.BuiltinFunctionSeq : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSeq(); } public override string name() { return "seq"; } 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()); Mal.List toret; if (args.vs.data is Mal.List) { toret = args.vs.data as Mal.List; } else { toret = new Mal.List.empty(); if (args.vs.data is Mal.String) { var str = (args.vs.data as Mal.String).v; if (str.length != 0) { unowned string tail = str; while (tail != "") { unowned string new_tail = tail.next_char(); var ch = str.substring(str.length - tail.length, tail.length - new_tail.length); toret.vs.append(new Mal.String(ch)); tail = new_tail; } } } else if (args.vs.data is Mal.Listlike) { var collection = args.vs.data as Mal.Listlike; for (var iter = collection.iter(); iter.nonempty(); iter.step()) toret.vs.append(iter.deref()); } else { throw new Mal.Error.BAD_PARAMS("%s: bad input type", name()); } } if (toret.vs.length() == 0) return new Mal.Nil(); return toret; } } class Mal.Core { public static GLib.HashTable ns; private static void add_builtin(Mal.BuiltinFunction f) { ns[f.name()] = f; } public static void make_ns() { ns = new GLib.HashTable(str_hash, str_equal); add_builtin(new BuiltinFunctionAdd()); add_builtin(new BuiltinFunctionSub()); add_builtin(new BuiltinFunctionMul()); add_builtin(new BuiltinFunctionDiv()); add_builtin(new BuiltinFunctionPrStr()); add_builtin(new BuiltinFunctionStr()); add_builtin(new BuiltinFunctionPrn()); add_builtin(new BuiltinFunctionPrintln()); add_builtin(new BuiltinFunctionReadString()); add_builtin(new BuiltinFunctionSlurp()); add_builtin(new BuiltinFunctionList()); add_builtin(new BuiltinFunctionListP()); add_builtin(new BuiltinFunctionNilP()); add_builtin(new BuiltinFunctionTrueP()); add_builtin(new BuiltinFunctionFalseP()); add_builtin(new BuiltinFunctionNumberP()); add_builtin(new BuiltinFunctionStringP()); add_builtin(new BuiltinFunctionSymbol()); add_builtin(new BuiltinFunctionSymbolP()); add_builtin(new BuiltinFunctionKeyword()); add_builtin(new BuiltinFunctionKeywordP()); add_builtin(new BuiltinFunctionVector()); add_builtin(new BuiltinFunctionVectorP()); add_builtin(new BuiltinFunctionSequentialP()); add_builtin(new BuiltinFunctionHashMap()); add_builtin(new BuiltinFunctionMapP()); add_builtin(new BuiltinFunctionEmptyP()); add_builtin(new BuiltinFunctionFnP()); add_builtin(new BuiltinFunctionMacroP()); add_builtin(new BuiltinFunctionCount()); add_builtin(new BuiltinFunctionEQ()); add_builtin(new BuiltinFunctionLT()); add_builtin(new BuiltinFunctionLE()); add_builtin(new BuiltinFunctionGT()); add_builtin(new BuiltinFunctionGE()); add_builtin(new BuiltinFunctionAtom()); add_builtin(new BuiltinFunctionAtomP()); add_builtin(new BuiltinFunctionDeref()); add_builtin(new BuiltinFunctionReset()); 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()); add_builtin(new BuiltinFunctionThrow()); add_builtin(new BuiltinFunctionApply()); add_builtin(new BuiltinFunctionMap()); add_builtin(new BuiltinFunctionAssoc()); add_builtin(new BuiltinFunctionDissoc()); add_builtin(new BuiltinFunctionGetFn()); add_builtin(new BuiltinFunctionContains()); add_builtin(new BuiltinFunctionKeys()); add_builtin(new BuiltinFunctionVals()); add_builtin(new BuiltinFunctionReadline()); add_builtin(new BuiltinFunctionMeta()); add_builtin(new BuiltinFunctionWithMeta()); add_builtin(new BuiltinFunctionTimeMs()); add_builtin(new BuiltinFunctionConj()); add_builtin(new BuiltinFunctionSeq()); } } ================================================ FILE: impls/vala/env.vala ================================================ class Mal.Env : GC.Object { private GLib.HashTable data; weak Mal.Env? outer; construct { data = new GLib.HashTable( Mal.Hashable.hash, Mal.Hashable.equal); } public Env.within(Mal.Env outer_) { outer = outer_; } public Env() { outer = null; } public override void gc_traverse(GC.Object.VisitorFunc visit) { visit(outer); foreach (var key in data.get_keys()) { visit(key); visit(data[key]); } } public Env.funcall(Mal.Env outer_, Mal.Listlike binds, Mal.List exprs) throws Mal.Error { outer = outer_; var binditer = binds.iter(); unowned GLib.List exprlist = exprs.vs; while (binditer.nonempty()) { var paramsym = binditer.deref() as Mal.Sym; if (paramsym.v == "&") { binditer.step(); var rest = binditer.deref(); binditer.step(); if (rest == null || binditer.nonempty()) throw new Mal.Error.BAD_PARAMS( "expected exactly one parameter name after &"); set(rest as Mal.Sym, new Mal.List(exprlist.copy())); return; } else { if (exprlist == null) throw new Mal.Error.BAD_PARAMS( "too few arguments for function"); set(paramsym, exprlist.data); binditer.step(); exprlist = exprlist.next; } } if (exprlist != null) throw new Mal.Error.BAD_PARAMS("too many arguments for function"); } // Use the 'new' keyword to silence warnings about 'set' and 'get' // already having meanings that we're overwriting public new void set(Mal.Sym key, Mal.Val f) { data[key] = f; } public new Mal.Val? get(Mal.Sym key) { if (key in data) return data[key]; if (outer == null) return null; return outer.get(key); } } ================================================ FILE: impls/vala/gc.vala ================================================ abstract class GC.Object : GLib.Object { public GC.Object? next; public unowned GC.Object? prev; public bool visited; public delegate void VisitorFunc(GC.Object? obj); construct { next = null; prev = null; GC.Core.register_object(this); } public abstract void gc_traverse(VisitorFunc visitor); } class GC.Root : GLib.Object { public weak GC.Root? next; public weak GC.Root? prev; public GC.Object? obj; construct { GC.Core.register_root(this); } ~Root() { GC.Core.unregister_root(this); } public Root.empty() { obj = null; } public Root(GC.Object? obj_) { obj = obj_; } } class GC.Core : GLib.Object { private struct ObjectQueue { GC.Object? head; GC.Object? tail; public void unlink(GC.Object obj_) { GC.Object obj = obj_; if (obj.prev == null) { assert(obj == head); head = obj.next; } else obj.prev.next = obj.next; if (obj.next == null) tail = obj.prev; else obj.next.prev = obj.prev; } public void link(GC.Object obj) { if (tail != null) { tail.next = obj; obj.prev = tail; } else { head = obj; obj.prev = null; } tail = obj; obj.next = null; } } private static ObjectQueue objects; private static weak GC.Root? roots_head; private static uint until_next_collection; static construct { objects.head = objects.tail = null; roots_head = null; } public static void register_object(GC.Object obj) { #if GC_DEBUG stderr.printf("GC: registered %p [%s]\n", obj, Type.from_instance(obj).name()); #endif objects.link(obj); if (until_next_collection > 0) until_next_collection--; } public static void register_root(GC.Root root) { #if GC_DEBUG stderr.printf("GC: registered root %p\n", root); #endif root.next = roots_head; root.prev = null; if (roots_head != null) roots_head.prev = root; roots_head = root; } public static void unregister_root(GC.Root root) { #if GC_DEBUG stderr.printf("GC: unregistered root %p\n", root); #endif if (root.prev == null) roots_head = root.next; else root.prev.next = root.next; if (root.next != null) root.next.prev = root.prev; } private static void statistics(uint before, uint after, uint roots) { #if GC_STATS stderr.printf("GC: %u roots, %u -> %u objects\n", roots, before, after); #endif } public static void collect() { uint orig = 0; uint roots = 0; #if GC_DEBUG stderr.printf("GC: started\n"); #endif for (unowned GC.Object obj = objects.head; obj != null; obj = obj.next) { obj.visited = false; #if GC_DEBUG stderr.printf("GC: considering %p [%s]\n", obj, Type.from_instance(obj).name()); #endif orig++; } ObjectQueue after = { null, null }; until_next_collection = 0; for (unowned GC.Root root = roots_head; root != null; root = root.next) { roots++; if (root.obj != null && !root.obj.visited) { GC.Object obj = root.obj; #if GC_DEBUG stderr.printf("GC: root %p -> %p [%s]\n", root, obj, Type.from_instance(obj).name()); #endif objects.unlink(obj); after.link(obj); obj.visited = true; until_next_collection++; } } for (GC.Object? obj = after.head; obj != null; obj = obj.next) { #if GC_DEBUG stderr.printf("GC: traversing %p [%s]\n", obj, Type.from_instance(obj).name()); #endif obj.gc_traverse((obj2_) => { GC.Object obj2 = obj2_; if (obj2 == null) return; if (!obj2.visited) { #if GC_DEBUG stderr.printf("GC: %p -> %p [%s]\n", obj, obj2, Type.from_instance(obj2).name()); #endif objects.unlink(obj2); after.link(obj2); obj2.visited = true; until_next_collection++; } }); } // Manually free everything, to avoid stack overflow while // recursing down the list unreffing them all objects.tail = null; while (objects.head != null) { #if GC_DEBUG stderr.printf("GC: collecting %p [%s]\n", objects.head, Type.from_instance(objects.head).name()); #endif objects.head = objects.head.next; } objects = after; #if GC_DEBUG stderr.printf("GC: finished\n"); #endif statistics(orig, until_next_collection, roots); } public static void maybe_collect() { #if !GC_ALWAYS if (until_next_collection > 0) return; #endif collect(); } } ================================================ FILE: impls/vala/printer.vala ================================================ namespace Mal { string pr_str(Mal.Val val, bool print_readably = true) { if (val is Mal.Nil) return "nil"; if (val is Mal.Bool) return (val as Mal.Bool).v ? "true" : "false"; if (val is Mal.Sym) return (val as Mal.Sym).v; if (val is Mal.Keyword) return ":" + (val as Mal.Keyword).v; if (val is Mal.Num) return ("%"+int64.FORMAT_MODIFIER+"d") .printf((val as Mal.Num).v); if (val is Mal.String) { string s = (val as Mal.String).v; if (print_readably) s = "\"%s\"".printf(s.replace("\\", "\\\\") .replace("\n", "\\n"). replace("\"", "\\\"")); return s; } if (val is Mal.Listlike) { bool vec = val is Mal.Vector; string toret = vec ? "[" : "("; string sep = ""; for (var iter = (val as Mal.Listlike).iter(); iter.nonempty(); iter.step()) { toret += sep + pr_str(iter.deref(), print_readably); sep = " "; } toret += vec ? "]" : ")"; return toret; } if (val is Mal.Hashmap) { string toret = "{"; string sep = ""; var map = (val as Mal.Hashmap).vs; foreach (var key in map.get_keys()) { toret += (sep + pr_str(key, print_readably) + " " + pr_str(map[key], print_readably)); sep = " "; } toret += "}"; return toret; } if (val is Mal.BuiltinFunction) { return "#".printf((val as Mal.BuiltinFunction).name()); } if (val is Mal.Function) { return "#"; } if (val is Mal.Atom) { return "(atom %s)".printf( pr_str((val as Mal.Atom).v, print_readably)); } return "??"; } } ================================================ FILE: impls/vala/reader.vala ================================================ class Mal.Reader : GLib.Object { static Regex tok_re; static Regex tok_num; int origlen; string data; int pos; string next_token; static construct { tok_re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;[^\n]*|[^\s\[\]{}('"`,;)]*)/; // comment to unconfuse emacs vala-mode "]); tok_num = /^-?[0-9]/; } private string poserr(string fmt, ...) { return "char %d: %s".printf(origlen - data.length, fmt.vprintf(va_list())); } private void advance() throws Error { do { MatchInfo info; if (!tok_re.match(data, 0, out info)) throw new Error.BAD_TOKEN(poserr("bad token")); next_token = info.fetch(1); int tokenend; info.fetch_pos(1, null, out tokenend); data = data[tokenend:data.length]; } while (next_token.has_prefix(";")); } public Reader(string str) throws Error { data = str; origlen = data.length; pos = 0; advance(); } public string peek() throws Error { return next_token; } public string next() throws Error { advance(); return peek(); } public static Mal.Val? read_str(string str) throws Error { var rdr = new Reader(str); if (rdr.peek() == "") return null; var toret = rdr.read_form(); if (rdr.peek() != "") throw new Mal.Error.PARSE_ERROR( rdr.poserr("trailing junk after expression")); return toret; } public Mal.Val read_form() throws Error { string token = peek(); if (token == "(") { next(); // eat ( return new Mal.List(read_list(")")); } else { return read_atom(); } } public GLib.List read_list(string endtok) throws Error { var list = new GLib.List(); string token; while (true) { token = peek(); if (token == "") throw new Mal.Error.PARSE_ERROR(poserr("unbalanced parens")); if (token == endtok) { next(); // eat end token return list; } list.append(read_form()); } } public Mal.Hashmap read_hashmap() throws Error { var map = new Mal.Hashmap(); string token; while (true) { Mal.Val vals[2]; for (int i = 0; i < 2; i++) { token = peek(); if (token == "") throw new Mal.Error.PARSE_ERROR( poserr("unbalanced braces")); if (token == "}") { if (i != 0) throw new Mal.Error.PARSE_ERROR( poserr("odd number of elements in hashmap")); next(); // eat end token return map; } vals[i] = read_form(); } map.insert(vals[0], vals[1]); } } public Mal.Val read_atom() throws Error { string token = peek(); next(); if (tok_num.match(token)) return new Mal.Num(int64.parse(token)); if (token.has_prefix(":")) return new Mal.Keyword(token[1:token.length]); if (token.has_prefix("\"")) { if (token.length < 2 || !token.has_suffix("\"")) throw new Mal.Error.BAD_TOKEN( poserr("end of input in mid-string")); token = token[1:token.length-1]; int end = 0; int pos = 0; string strval = ""; while ((pos = token.index_of ("\\", end)) != -1) { strval += token[end:pos]; if (token.length - pos < 2) throw new Mal.Error.BAD_TOKEN( poserr("end of input in mid-string")); switch (token[pos:pos+2]) { case "\\\\": strval += "\\"; break; case "\\\"": strval += "\""; break; case "\\n": strval += "\n"; break; } end = pos+2; } strval += token[end:token.length]; return new Mal.String(strval); } switch (token) { case "nil": return new Mal.Nil(); case "true": return new Mal.Bool(true); case "false": return new Mal.Bool(false); case "[": return new Mal.Vector.from_list(read_list("]")); case "{": return read_hashmap(); case "'": case "`": case "~": case "~@": case "@": var list = new GLib.List(); list.append(new Mal.Sym( token == "'" ? "quote" : token == "`" ? "quasiquote" : token == "~" ? "unquote" : token == "~@" ? "splice-unquote" : "deref")); list.append(read_form()); return new Mal.List(list); case "^": var list = new GLib.List(); list.append(new Mal.Sym("with-meta")); var metadata = read_form(); list.append(read_form()); list.append(metadata); return new Mal.List(list); default: return new Mal.Sym(token); } } } ================================================ FILE: impls/vala/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/vala/step0_repl.vala ================================================ class Mal.Main : GLib.Object { public static string? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); } else { stdout.printf("\n"); } return line; } public static string EVAL(string expr) { return expr; } public static void PRINT(string value) { stdout.printf("%s\n", value); } public static bool rep() { string? line = READ(); if (line == null) return false; if (line.length > 0) { string value = EVAL(line); PRINT(value); } return true; } public static int main(string[] args) { while (rep()); return 0; } } ================================================ FILE: impls/vala/step1_read_print.vala ================================================ class Mal.Main : GLib.Object { static bool eof; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } public static Mal.Val EVAL(Mal.Val expr) { return expr; } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep() { Mal.Val? val = READ(); if (val != null) { val = EVAL(val); PRINT(val); GC.Core.maybe_collect(); } } public static int main(string[] args) { while (!eof) rep(); return 0; } } ================================================ FILE: impls/vala/step2_eval.vala ================================================ abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { public abstract int64 result(int64 a, int64 b); public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num; unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num; if (a == null || b == null) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); return new Mal.Num(result(a.v, b.v)); } } class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAdd(); } public override string name() { return "+"; } public override int64 result(int64 a, int64 b) { return a+b; } } class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSub(); } public override string name() { return "-"; } public override int64 result(int64 a, int64 b) { return a-b; } } class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMul(); } public override string name() { return "*"; } public override int64 result(int64 a, int64 b) { return a*b; } } class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionDiv(); } public override string name() { return "/"; } public override int64 result(int64 a, int64 b) { return a/b; } } class Mal.Env : GLib.Object { public GLib.HashTable data; construct { data = new GLib.HashTable( Mal.Hashable.hash, Mal.Hashable.equal); } // Use the 'new' keyword to silence warnings about 'set' and 'get' // already having meanings that we're overwriting public new void set(Mal.Sym key, Mal.Val f) { data[key] = f; } public new Mal.Val get(Mal.Sym key) throws Mal.Error { var toret = data[key]; if (toret == null) throw new Error.ENV_LOOKUP_FAILED("no such variable '%s'", key.v); return toret; } } class Mal.Main : GLib.Object { static bool eof; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) throws Mal.Error { var ast_root = new GC.Root(ast); (void)ast_root; GC.Core.maybe_collect(); // stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) return env.get(ast as Mal.Sym); if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); return (firstdata as Mal.BuiltinFunction).call(newlist); } else { return ast; } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static int main(string[] args) { var env = new Mal.Env(); env.set(new Mal.Sym("+"), new BuiltinFunctionAdd()); env.set(new Mal.Sym("-"), new BuiltinFunctionSub()); env.set(new Mal.Sym("*"), new BuiltinFunctionMul()); env.set(new Mal.Sym("/"), new BuiltinFunctionDiv()); while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } return 0; } } ================================================ FILE: impls/vala/step3_env.vala ================================================ abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction { public abstract int64 result(int64 a, int64 b); public override Mal.Val call(Mal.List args) throws Mal.Error { if (args.vs.length() != 2) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num; unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num; if (a == null || b == null) throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name()); return new Mal.Num(result(a.v, b.v)); } } class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionAdd(); } public override string name() { return "+"; } public override int64 result(int64 a, int64 b) { return a+b; } } class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionSub(); } public override string name() { return "-"; } public override int64 result(int64 a, int64 b) { return a-b; } } class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionMul(); } public override string name() { return "*"; } public override int64 result(int64 a, int64 b) { return a*b; } } class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionDiv(); } public override string name() { return "/"; } public override int64 result(int64 a, int64 b) { return a/b; } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); return val; } public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) throws Mal.Error { var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; var newenv = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, newenv); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], newenv); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } return EVAL(list.nth(2).data, newenv); } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); if (firstdata is Mal.BuiltinFunction) { return (firstdata as Mal.BuiltinFunction).call(newlist); } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; env.set(new Mal.Sym("+"), new BuiltinFunctionAdd()); env.set(new Mal.Sym("-"), new BuiltinFunctionSub()); env.set(new Mal.Sym("*"), new BuiltinFunctionMul()); env.set(new Mal.Sym("/"), new BuiltinFunctionDiv()); while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } return 0; } } ================================================ FILE: impls/vala/step4_if_fn_do.vala ================================================ class Mal.Main: GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); return val; } public static Mal.Val EVAL(Mal.Val ast, Mal.Env env) throws Mal.Error { var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; var newenv = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, newenv); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], newenv); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } return EVAL(list.nth(2).data, newenv); case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } return EVAL(list.data, env); case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); if (firstdata is Mal.BuiltinFunction) { return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; var newenv = new Mal.Env.funcall( fn.env, fn.parameters, newlist); return EVAL(fn.body, newenv); } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); try { EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"), env); } catch (Mal.Error err) { assert(false); // shouldn't happen } while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } return 0; } } ================================================ FILE: impls/vala/step5_tco.vala ================================================ class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); return val; } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); if (firstdata is Mal.BuiltinFunction) { return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); try { EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"), env); } catch (Mal.Error err) { assert(false); // shouldn't happen } while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } return 0; } } ================================================ FILE: impls/vala/step6_file.vala ================================================ class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { public Mal.Env env; public BuiltinFunctionEval(Mal.Env env_) { env = env_; } public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEval(env); } public override string name() { return "eval"; } 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()); return Mal.Main.EVAL(args.vs.data, env); } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); return val; } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); if (firstdata is Mal.BuiltinFunction) { return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static void setup(string line, Mal.Env env) { try { EVAL(Reader.read_str(line), env); } catch (Mal.Error err) { assert(false); // shouldn't happen } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); setup("(def! not (fn* (a) (if a false true)))", env); setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); var ARGV = new GLib.List(); if (args.length > 1) { for (int i = args.length - 1; i >= 2; i--) ARGV.prepend(new Mal.String(args[i])); } env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); if (args.length > 1) { var contents = new GLib.List(); contents.prepend(new Mal.String(args[1])); contents.prepend(new Mal.Sym("load-file")); try { EVAL(new Mal.List(contents), env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return 1; } } else { while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } } return 0; } } ================================================ FILE: impls/vala/step7_quote.vala ================================================ class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { public Mal.Env env; public BuiltinFunctionEval(Mal.Env env_) { env = env_; } public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEval(env); } public override string name() { return "eval"; } 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()); return Mal.Main.EVAL(args.vs.data, env); } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); 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 (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; } } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); case "quote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quasiquote: expected one argument"); ast = quasiquote(list.next.data); continue; // tail-call optimisation } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; for (var iter = (ast as Mal.Listlike).iter().step(); iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); if (firstdata is Mal.BuiltinFunction) { return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static void setup(string line, Mal.Env env) { try { EVAL(Reader.read_str(line), env); } catch (Mal.Error err) { assert(false); // shouldn't happen } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); setup("(def! not (fn* (a) (if a false true)))", env); setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); var ARGV = new GLib.List(); if (args.length > 1) { for (int i = args.length - 1; i >= 2; i--) ARGV.prepend(new Mal.String(args[i])); } env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); if (args.length > 1) { var contents = new GLib.List(); contents.prepend(new Mal.String(args[1])); contents.prepend(new Mal.Sym("load-file")); try { EVAL(new Mal.List(contents), env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return 1; } } else { while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } } return 0; } } ================================================ FILE: impls/vala/step8_macros.vala ================================================ class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { public Mal.Env env; public BuiltinFunctionEval(Mal.Env env_) { env = env_; } public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEval(env); } public override string name() { return "eval"; } 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()); return Mal.Main.EVAL(args.vs.data, env); } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); 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 (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; } } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "defmacro!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected two values"); var symkey = list.next.data as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expects a symbol"); var val = EVAL(list.next.next.data, env) as Mal.Function; if (val == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected a function"); val = val.copy() as Mal.Function; val.is_macro = true; env.set(symkey, val); return val; case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); case "quote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quasiquote: expected one argument"); ast = quasiquote(list.next.data); continue; // tail-call optimisation } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; var iter = (ast as Mal.Listlike).iter().step(); if (firstdata is Mal.BuiltinFunction) { for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; if (fn.is_macro) { for (; iter.nonempty(); iter.step()) newlist.vs.append(iter.deref()); var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = EVAL(fn.body, fenv); continue; } for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static void setup(string line, Mal.Env env) { try { EVAL(Reader.read_str(line), env); } catch (Mal.Error err) { assert(false); // shouldn't happen } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); setup("(def! not (fn* (a) (if a false true)))", env); setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); setup("(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)))))))", env); var ARGV = new GLib.List(); if (args.length > 1) { for (int i = args.length - 1; i >= 2; i--) ARGV.prepend(new Mal.String(args[i])); } env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); if (args.length > 1) { var contents = new GLib.List(); contents.prepend(new Mal.String(args[1])); contents.prepend(new Mal.Sym("load-file")); try { EVAL(new Mal.List(contents), env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return 1; } } else { while (!eof) { try { rep(env); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } } return 0; } } ================================================ FILE: impls/vala/step9_try.vala ================================================ class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { public Mal.Env env; public BuiltinFunctionEval(Mal.Env env_) { env = env_; } public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEval(env); } public override string name() { return "eval"; } 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()); return Mal.Main.EVAL(args.vs.data, env); } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { Mal.BuiltinFunctionThrow.clear(); GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); 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 (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; } } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "defmacro!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected two values"); var symkey = list.next.data as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expects a symbol"); var val = EVAL(list.next.next.data, env) as Mal.Function; if (val == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected a function"); val = val.copy() as Mal.Function; val.is_macro = true; env.set(symkey, val); return val; case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); case "quote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quasiquote: expected one argument"); ast = quasiquote(list.next.data); continue; // tail-call optimisation case "try*": if (list.length() != 2 && list.length() != 3) throw new Mal.Error.BAD_PARAMS( "try*: expected one or two arguments"); var trybody = list.next.data; if (list.length() == 2) { // Trivial catchless form of try ast = trybody; continue; // tail-call optimisation } var catchclause = list.next.next.data as Mal.List; if (!(catchclause.vs.data is Mal.Sym) || (catchclause.vs.data as Mal.Sym).v != "catch*") throw new Mal.Error.BAD_PARAMS( "try*: expected catch*"); if (catchclause.vs.length() != 3) throw new Mal.Error.BAD_PARAMS( "catch*: expected two arguments"); var catchparam = catchclause.vs.next.data as Mal.Sym; if (catchparam == null) throw new Mal.Error.BAD_PARAMS( "catch*: expected a parameter name"); var catchbody = catchclause.vs.next.next.data; try { return EVAL(trybody, env); } catch (Mal.Error exc) { var catchenv = new Mal.Env.within(env); catchenv.set(catchparam, Mal.BuiltinFunctionThrow. thrown_value(exc)); ast = catchbody; env = catchenv; continue; // tail-call optimisation } } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; var iter = (ast as Mal.Listlike).iter().step(); if (firstdata is Mal.BuiltinFunction) { for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; if (fn.is_macro) { for (; iter.nonempty(); iter.step()) newlist.vs.append(iter.deref()); var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = EVAL(fn.body, fenv); continue; } for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static void setup(string line, Mal.Env env) { try { EVAL(Reader.read_str(line), env); } catch (Mal.Error err) { stderr.printf("Error during setup:\n%s\n-> %s\n", line, err.message); GLib.Process.exit(1); } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); setup("(def! not (fn* (a) (if a false true)))", env); setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); setup("(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)))))))", env); var ARGV = new GLib.List(); if (args.length > 1) { for (int i = args.length - 1; i >= 2; i--) ARGV.prepend(new Mal.String(args[i])); } env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); if (args.length > 1) { var contents = new GLib.List(); contents.prepend(new Mal.String(args[1])); contents.prepend(new Mal.Sym("load-file")); try { EVAL(new Mal.List(contents), env); } catch (Mal.Error.EXCEPTION_THROWN exc) { GLib.stderr.printf( "uncaught exception: %s\n", pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return 1; } } else { while (!eof) { try { rep(env); } catch (Mal.Error.EXCEPTION_THROWN exc) { GLib.stderr.printf( "uncaught exception: %s\n", pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } } return 0; } } ================================================ FILE: impls/vala/stepA_mal.vala ================================================ class Mal.BuiltinFunctionEval : Mal.BuiltinFunction { public Mal.Env env; public BuiltinFunctionEval(Mal.Env env_) { env = env_; } public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionEval(env); } public override string name() { return "eval"; } 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()); return Mal.Main.EVAL(args.vs.data, env); } } class Mal.Main : GLib.Object { static bool eof; static Mal.Sym dbgevalsym; static construct { eof = false; } public static Mal.Val? READ() { string? line = Readline.readline("user> "); if (line != null) { if (line.length > 0) Readline.History.add(line); try { return Reader.read_str(line); } catch (Mal.Error err) { Mal.BuiltinFunctionThrow.clear(); GLib.stderr.printf("%s\n", err.message); return null; } } else { stdout.printf("\n"); eof = true; return null; } } private static Mal.Val define_eval(Mal.Val key, Mal.Val value, Mal.Env env) throws Mal.Error { var rootk = new GC.Root(key); (void)rootk; var roote = new GC.Root(env); (void)roote; var symkey = key as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "let*: expected a symbol to define"); var val = EVAL(value, env); env.set(symkey, val); 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 (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; } } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) throws Mal.Error { // Copy the implicitly 'unowned' function arguments into // ordinary owned variables which increment the objects' // reference counts. This is so that when we overwrite these // variables within the loop (for TCO) the objects we assign // into them don't immediately get garbage-collected. Mal.Val ast = ast_; Mal.Env env = env_; var ast_root = new GC.Root(ast); (void)ast_root; var env_root = new GC.Root(env); (void)env_root; while (true) { ast_root.obj = ast; env_root.obj = env; GC.Core.maybe_collect(); if (dbgevalsym == null) dbgevalsym = new Mal.Sym("DEBUG-EVAL"); var dbgeval = env.get(dbgevalsym); if (dbgeval != null && dbgeval.truth_value()) stdout.printf("EVAL: %s\n", pr_str(ast)); if (ast is Mal.Sym) { var key = ast as Mal.Sym; var val = env.get(key); if (val == null) throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v); return val; } if (ast is Mal.Vector) { var vec = ast as Mal.Vector; var result = new Mal.Vector.with_size(vec.length); var root = new GC.Root(result); (void)root; for (var i = 0; i < vec.length; i++) result[i] = EVAL(vec[i], env); return result; } if (ast is Mal.Hashmap) { var result = new Mal.Hashmap(); var root = new GC.Root(result); (void)root; var map = (ast as Mal.Hashmap).vs; foreach (var key in map.get_keys()) result.insert(key, EVAL(map[key], env)); return result; } if (ast is Mal.List) { unowned GLib.List list = (ast as Mal.List).vs; if (list.first() == null) return ast; var first = list.first().data; if (first is Mal.Sym) { var sym = first as Mal.Sym; switch (sym.v) { case "def!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "def!: expected two values"); return define_eval(list.next.data, list.next.next.data, env); case "defmacro!": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected two values"); var symkey = list.next.data as Mal.Sym; if (symkey == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expects a symbol"); var val = EVAL(list.next.next.data, env) as Mal.Function; if (val == null) throw new Mal.Error.BAD_PARAMS( "defmacro!: expected a function"); val = val.copy() as Mal.Function; val.is_macro = true; env.set(symkey, val); return val; case "let*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "let*: expected two values"); var defns = list.nth(1).data; env = new Mal.Env.within(env); if (defns is Mal.List) { for (unowned GLib.List iter = (defns as Mal.List).vs; iter != null; iter = iter.next.next) { if (iter.next == null) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length list" + " of definitions"); define_eval(iter.data, iter.next.data, env); } } else if (defns is Mal.Vector) { var vec = defns as Mal.Vector; if (vec.length % 2 != 0) throw new Mal.Error.BAD_PARAMS( "let*: expected an even-length vector" + " of definitions"); for (var i = 0; i < vec.length; i += 2) define_eval(vec[i], vec[i+1], env); } else { throw new Mal.Error.BAD_PARAMS( "let*: expected a list or vector of definitions"); } ast = list.nth(2).data; continue; // tail-call optimisation case "do": Mal.Val result = null; for (list = list.next; list != null; list = list.next) result = EVAL(list.data, env); if (result == null) throw new Mal.Error.BAD_PARAMS( "do: expected at least one argument"); return result; case "if": if (list.length() != 3 && list.length() != 4) throw new Mal.Error.BAD_PARAMS( "if: expected two or three arguments"); list = list.next; var cond = EVAL(list.data, env); list = list.next; if (!cond.truth_value()) { // Skip to the else clause, which defaults to nil. list = list.next; if (list == null) return new Mal.Nil(); } ast = list.data; continue; // tail-call optimisation case "fn*": if (list.length() != 3) throw new Mal.Error.BAD_PARAMS( "fn*: expected two arguments"); var binds = list.next.data as Mal.Listlike; var body = list.next.next.data; if (binds == null) throw new Mal.Error.BAD_PARAMS( "fn*: expected a list of parameter names"); for (var iter = binds.iter(); iter.nonempty(); iter.step()) if (!(iter.deref() is Mal.Sym)) throw new Mal.Error.BAD_PARAMS( "fn*: expected parameter name to be "+ "symbol"); return new Mal.Function(binds, body, env); case "quote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( "quasiquote: expected one argument"); ast = quasiquote(list.next.data); continue; // tail-call optimisation case "try*": if (list.length() != 2 && list.length() != 3) throw new Mal.Error.BAD_PARAMS( "try*: expected one or two arguments"); var trybody = list.next.data; if (list.length() == 2) { // Trivial catchless form of try ast = trybody; continue; // tail-call optimisation } var catchclause = list.next.next.data as Mal.List; if (!(catchclause.vs.data is Mal.Sym) || (catchclause.vs.data as Mal.Sym).v != "catch*") throw new Mal.Error.BAD_PARAMS( "try*: expected catch*"); if (catchclause.vs.length() != 3) throw new Mal.Error.BAD_PARAMS( "catch*: expected two arguments"); var catchparam = catchclause.vs.next.data as Mal.Sym; if (catchparam == null) throw new Mal.Error.BAD_PARAMS( "catch*: expected a parameter name"); var catchbody = catchclause.vs.next.next.data; try { return EVAL(trybody, env); } catch (Mal.Error exc) { var catchenv = new Mal.Env.within(env); catchenv.set(catchparam, Mal.BuiltinFunctionThrow. thrown_value(exc)); ast = catchbody; env = catchenv; continue; // tail-call optimisation } } } Mal.Val firstdata = EVAL(list.first().data, env); var newlist = new Mal.List.empty(); var root = new GC.Root(newlist); (void)root; var iter = (ast as Mal.Listlike).iter().step(); if (firstdata is Mal.BuiltinFunction) { for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); return (firstdata as Mal.BuiltinFunction).call(newlist); } else if (firstdata is Mal.Function) { var fn = firstdata as Mal.Function; if (fn.is_macro) { for (; iter.nonempty(); iter.step()) newlist.vs.append(iter.deref()); var fenv = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = EVAL(fn.body, fenv); continue; } for (; iter.nonempty(); iter.step()) newlist.vs.append(EVAL(iter.deref(), env)); env = new Mal.Env.funcall(fn.env, fn.parameters, newlist); ast = fn.body; continue; // tail-call optimisation } else { throw new Mal.Error.CANNOT_APPLY( "bad value at start of list"); } } else { return ast; } } } public static void PRINT(Mal.Val value) { stdout.printf("%s\n", pr_str(value)); } public static void rep(Mal.Env env) throws Mal.Error { Mal.Val? val = READ(); if (val != null) { val = EVAL(val, env); PRINT(val); } } public static void setup(string line, Mal.Env env) { try { EVAL(Reader.read_str(line), env); } catch (Mal.Error err) { stderr.printf("Error during setup:\n%s\n-> %s\n", line, err.message); GLib.Process.exit(1); } } public static int main(string[] args) { var env = new Mal.Env(); var root = new GC.Root(env); (void)root; Mal.Core.make_ns(); foreach (var key in Mal.Core.ns.get_keys()) env.set(new Mal.Sym(key), Mal.Core.ns[key]); env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env)); env.set(new Mal.Sym("*host-language*"), new Mal.String("vala")); setup("(def! not (fn* (a) (if a false true)))", env); setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", env); setup("(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)))))))", env); var ARGV = new GLib.List(); if (args.length > 1) { for (int i = args.length - 1; i >= 2; i--) ARGV.prepend(new Mal.String(args[i])); } env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV)); if (args.length > 1) { var contents = new GLib.List(); contents.prepend(new Mal.String(args[1])); contents.prepend(new Mal.Sym("load-file")); try { EVAL(new Mal.List(contents), env); } catch (Mal.Error.EXCEPTION_THROWN exc) { GLib.stderr.printf( "uncaught exception: %s\n", pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); return 1; } } else { setup("(println (str \"Mal [\" *host-language* \"]\"))", env); while (!eof) { try { rep(env); } catch (Mal.Error.EXCEPTION_THROWN exc) { GLib.stderr.printf( "uncaught exception: %s\n", pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc))); } catch (Mal.Error err) { GLib.stderr.printf("%s\n", err.message); } } } return 0; } } ================================================ FILE: impls/vala/types.vala ================================================ public errordomain Mal.Error { BAD_TOKEN, PARSE_ERROR, HASH_KEY_TYPE_ERROR, ENV_LOOKUP_FAILED, BAD_PARAMS, CANNOT_APPLY, EXCEPTION_THROWN, NOT_IMPLEMENTED_IN_THIS_STEP, } abstract class Mal.Val : GC.Object { public abstract bool truth_value(); } abstract class Mal.Hashable : Mal.Val { public string hashkey; public static uint hash(Hashable h) { return str_hash(h.hashkey); } public static bool equal(Hashable hl, Hashable hr) { return hl.hashkey == hr.hashkey; } } class Mal.Bool : Mal.Hashable { public bool v; public Bool(bool value) { v = value; hashkey = value ? "bt" : "bf"; } public override bool truth_value() { return v; } public override void gc_traverse(GC.Object.VisitorFunc visit) {} } // Mal.Listlike is a subclass of Mal.Val which includes both lists and // vectors, and provides a common iterator API so that core functions // and special forms can treat them the same. // // Most core functions that take a list argument also accept nil. To // make that easy, Mal.Nil also derives from Mal.Listlike. abstract class Mal.Listlike : Mal.ValWithMetadata { public abstract Mal.Iterator iter(); } abstract class Mal.Iterator : GLib.Object { public abstract Mal.Val? deref(); public abstract Mal.Iterator step(); public bool empty() { return deref() == null; } public bool nonempty() { return deref() != null; } } // ValWithMetadata is a subclass of Mal.Val which includes every value // type you can put metadata on. Value types implementing this class // must provide a copy() method, because with-meta has to make a copy // of the value with new metadata. abstract class Mal.ValWithMetadata : Mal.Val { public Mal.Val? metadata; construct { metadata = null; } public abstract Mal.ValWithMetadata copy(); public abstract void gc_traverse_m(GC.Object.VisitorFunc visit); public override void gc_traverse(GC.Object.VisitorFunc visit) { visit(metadata); gc_traverse_m(visit); } } class Mal.Nil : Mal.Listlike { public override bool truth_value() { return false; } public override Mal.Iterator iter() { return new Mal.NilIterator(); } public override Mal.ValWithMetadata copy() { return new Mal.Nil(); } public override void gc_traverse_m(GC.Object.VisitorFunc visit) {} } class Mal.NilIterator : Mal.Iterator { public override Mal.Val? deref() { return null; } public override Mal.Iterator step() { return this; } } class Mal.List : Mal.Listlike { public GLib.List vs; public List(GLib.List values) { foreach (var value in values) { vs.append(value); } } public List.empty() { } public override bool truth_value() { return true; } public override Mal.Iterator iter() { var toret = new Mal.ListIterator(); toret.node = vs; return toret; } public override Mal.ValWithMetadata copy() { return new Mal.List(vs); } public override void gc_traverse_m(GC.Object.VisitorFunc visit) { foreach (var v in vs) visit(v); } } class Mal.ListIterator : Mal.Iterator { public unowned GLib.List? node; public override Mal.Val? deref() { return node == null ? null : node.data; } public override Mal.Iterator step() { if (node != null) node = node.next; return this; } } class Mal.Vector : Mal.Listlike { struct Ref { weak Mal.Val v; } private Ref[] rs; public Vector.from_list(GLib.List values) { rs = new Ref[values.length()]; int i = 0; foreach (var value in values) { rs[i++] = { value }; } } public Vector.with_size(uint size) { rs = new Ref[size]; } private Vector.copy_of(Vector v) { rs = v.rs; } public override bool truth_value() { return true; } public override Mal.Iterator iter() { var toret = new Mal.VectorIterator(); toret.vec = this; toret.pos = 0; return toret; } public override Mal.ValWithMetadata copy() { return new Mal.Vector.copy_of(this); } public uint length { get { return rs.length; } } public new Mal.Val @get(uint pos) { assert(pos < rs.length); return rs[pos].v; } public new void @set(uint pos, Mal.Val v) { assert(pos < rs.length); rs[pos].v = v; } public override void gc_traverse_m(GC.Object.VisitorFunc visit) { foreach (var r in rs) visit(r.v); } } class Mal.VectorIterator : Mal.Iterator { public Mal.Vector vec; public int pos; public override Mal.Val? deref() { return pos >= vec.length ? null : vec[pos]; } public override Mal.Iterator step() { if (pos < vec.length) pos++; return this; } } class Mal.Num : Mal.Hashable { public int64 v; public Num(int64 value) { v = value; hashkey = "N" + v.to_string(); } public override bool truth_value() { return true; } public override void gc_traverse(GC.Object.VisitorFunc visit) {} } abstract class Mal.SymBase : Mal.Hashable { public string v; public override bool truth_value() { return true; } public override void gc_traverse(GC.Object.VisitorFunc visit) {} } class Mal.Sym : Mal.SymBase { public Sym(string value) { v = value; hashkey = "'" + v; } } class Mal.Keyword : Mal.SymBase { public Keyword(string value) { v = value; hashkey = ":" + v; } } class Mal.String : Mal.Hashable { public string v; public String(string value) { v = value; hashkey = "\"" + v; } public override bool truth_value() { return true; } public override void gc_traverse(GC.Object.VisitorFunc visit) {} } class Mal.Hashmap : Mal.ValWithMetadata { public GLib.HashTable vs; construct { vs = new GLib.HashTable( Mal.Hashable.hash, Mal.Hashable.equal); } public void insert(Mal.Val key, Mal.Val value) throws Mal.Error { var hkey = key as Mal.Hashable; if (hkey == null) throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key"); vs[hkey] = value; } public void remove(Mal.Val key) throws Mal.Error { var hkey = key as Mal.Hashable; if (hkey == null) throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key"); vs.remove(hkey); } public override bool truth_value() { return true; } public override Mal.ValWithMetadata copy() { var toret = new Mal.Hashmap(); toret.vs = vs; return toret; } public override void gc_traverse_m(GC.Object.VisitorFunc visit) { foreach (var key in vs.get_keys()) { visit(key); visit(vs[key]); } } } abstract class Mal.BuiltinFunction : Mal.ValWithMetadata { public abstract string name(); public abstract Mal.Val call(Mal.List args) throws Mal.Error; public override bool truth_value() { return true; } public override void gc_traverse_m(GC.Object.VisitorFunc visit) {} } class Mal.Function : Mal.ValWithMetadata { public bool is_macro; #if !NO_ENV public weak Mal.Listlike parameters; public weak Mal.Val body; public weak Mal.Env env; public Function(Mal.Listlike parameters_, Mal.Val body_, Mal.Env env_) { parameters = parameters_; body = body_; env = env_; is_macro = false; } #endif public override Mal.ValWithMetadata copy() { #if !NO_ENV var copied = new Mal.Function(parameters, body, env); copied.is_macro = is_macro; return copied; #else throw new Mal.Error.NOT_IMPLEMENTED_IN_THIS_STEP( "can't copy a Mal.Function without Mal.Env existing"); #endif } public override bool truth_value() { return true; } public override void gc_traverse_m(GC.Object.VisitorFunc visit) { #if !NO_ENV visit(parameters); visit(body); visit(env); #endif } } class Mal.Atom : Mal.Val { public weak Mal.Val v; public Atom(Mal.Val v_) { v = v_; } public override bool truth_value() { return true; } public override void gc_traverse(GC.Object.VisitorFunc visit) { visit(v); } } ================================================ FILE: impls/vb/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # Deps for Mono-based languages (C#, VB.Net) RUN apt-get -y install tzdata mono-runtime mono-mcs mono-vbnc mono-devel ================================================ FILE: impls/vb/Makefile ================================================ ##################### DEBUG = SOURCES_BASE = readline.vb types.vb reader.vb printer.vb SOURCES_LISP = env.vb core.vb stepA_mal.vb SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) ##################### SRCS = step0_repl.vb step1_read_print.vb step2_eval.vb \ step3_env.vb step4_if_fn_do.vb step5_tco.vb step6_file.vb \ step7_quote.vb step8_macros.vb step9_try.vb stepA_mal.vb LIB_CS_SRCS = getline.cs LIB_VB_SRCS = $(filter-out step%,$(filter %.vb,$(SOURCES))) FLAGS = $(if $(strip $(DEBUG)),-debug:full,) ##################### all: $(patsubst %.vb,%.exe,$(SRCS)) dist: mal.exe mal.exe: $(patsubst %.vb,%.exe,$(word $(words $(SOURCES)),$(SOURCES))) cp $< $@ mal_cs.dll: $(LIB_CS_SRCS) mcs $(FLAGS) -target:library $+ -out:$@ mal_vb.dll: mal_cs.dll $(LIB_VB_SRCS) vbnc $(FLAGS) -target:library -r:mal_cs.dll $(LIB_VB_SRCS) -out:$@ %.exe: %.vb mal_vb.dll vbnc $(FLAGS) -r:mal_vb.dll -r:mal_cs.dll $< clean: rm -f *.dll *.exe *.mdb ================================================ FILE: impls/vb/core.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports MalVal = Mal.types.MalVal Imports MalConstant = Mal.types.MalConstant Imports MalInt = Mal.types.MalInt Imports MalSymbol = Mal.types.MalSymbol Imports MalString = Mal.types.MalString Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalAtom = Mal.types.MalAtom Imports MalFunc = Mal.types.MalFunc Namespace Mal Public Class core Shared Nil As MalConstant = Mal.types.Nil Shared MalTrue As MalConstant = Mal.types.MalTrue Shared MalFalse As MalConstant = Mal.types.MalFalse ' Errors/Exceptions Shared Function mal_throw(a As MalList) As MalVal throw New Mal.types.MalException(a(0)) End Function ' General functions Shared Function equal_Q(a As MalList) As MalVal If Mal.types._equal_Q(a(0), a(1)) Then return MalTrue Else return MalFalse End If End Function ' Scalar functions Shared Function nil_Q(a As MalList) As MalVal If a(0) Is Nil Then return MalTrue Else return MalFalse End If End Function Shared Function true_Q(a As MalList) As MalVal If a(0) Is MalTrue Then return MalTrue Else return MalFalse End If End Function Shared Function false_Q(a As MalList) As MalVal If a(0) Is MalFalse Then return MalTrue Else return MalFalse End If End Function Shared Function symbol(a As MalList) As MalVal return new MalSymbol(DirectCast(a(0),MalString)) End Function Shared Function symbol_Q(a As MalList) As MalVal If TypeOf a(0) Is MalSymbol Then return MalTrue Else return MalFalse End If End Function Shared Function string_Q(a As MalList) As MalVal If TypeOf a(0) Is MalString Then Dim s As String = DirectCast(a(0),MalString).getValue() If s.Length = 0 Then return MalTrue Elseif s.Substring(0,1) = Strings.ChrW(&H029e) Then return MalFalse Else return MalTrue End If Else return MalFalse End If End Function Shared Function keyword(a As MalList) As MalVal Dim s As String = DirectCast(a(0),MalString).getValue() If s.Substring(0,1) = Strings.ChrW(&H029e) Then Return a(0) End If return new MalString(ChrW(&H029e) & s) End Function Shared Function keyword_Q(a As MalList) As MalVal If TypeOf a(0) Is MalString Then Dim s As String = DirectCast(a(0),MalString).getValue() If s.Length = 0 Then return MalFalse Elseif s.Substring(0,1) = Strings.ChrW(&H029e) Then return MalTrue Else return MalFalse End If Else return MalFalse End If End Function Shared Function number_Q(a As MalList) As MalVal If TypeOf a(0) Is MalInt Then return MalTrue Else return MalFalse End If End Function Shared Function fn_Q(a As MalList) As MalVal If TypeOf a(0) Is MalFunc AndAlso Not DirectCast(a(0),MalFunc).isMacro() Then return MalTrue Else return MalFalse End If End Function Shared Function macro_Q(a As MalList) As MalVal If TypeOf a(0) Is MalFunc AndAlso DirectCast(a(0),MalFunc).isMacro() Then return MalTrue Else return MalFalse End If End Function ' Number functions Shared Function lt(a As MalList) As MalVal return DirectCast(a(0),MalInt) < DirectCast(a(1),MalInt) End Function Shared Function lte(a As MalList) As MalVal return DirectCast(a(0),MalInt) <= DirectCast(a(1),MalInt) End Function Shared Function gt(a As MalList) As MalVal return DirectCast(a(0),MalInt) > DirectCast(a(1),MalInt) End Function Shared Function gte(a As MalList) As MalVal return DirectCast(a(0),MalInt) >= DirectCast(a(1),MalInt) End Function Shared Function plus(a As MalList) As MalVal return DirectCast(a(0),MalInt) + DirectCast(a(1),MalInt) End Function Shared Function minus(a As MalList) As MalVal return DirectCast(a(0),MalInt) - DirectCast(a(1),MalInt) End Function Shared Function mult(a As MalList) As MalVal return DirectCast(a(0),MalInt) * DirectCast(a(1),MalInt) End Function Shared Function div(a As MalList) As MalVal return DirectCast(a(0),MalInt) / DirectCast(a(1),MalInt) End Function Shared Function time_ms(a As MalList) As MalVal return New MalInt(DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond) End Function ' String functions Shared Function pr_str(a As MalList) As MalVal return New MalString(printer._pr_str_args(a, " ", true)) End Function Shared Function str(a As MalList) As MalVal return new MalString(printer._pr_str_args(a, "", false)) End Function Shared Function prn(a As MalList) As MalVal Console.WriteLine(printer._pr_str_args(a, " ", true)) return Nil End Function Shared Function println(a As MalList) As MalVal Console.WriteLine(printer._pr_str_args(a, " ", false)) return Nil End Function Shared Function mal_readline(a As MalList) As MalVal Dim line As String line = readline.Readline(DirectCast(a(0),MalString).getValue()) If line Is Nothing Then return types.Nil Else return New MalString(line) End If End Function Shared Function read_string(a As MalList) As MalVal return reader.read_str(DirectCast(a(0),MalString).getValue()) End Function Shared Function slurp(a As MalList) As MalVal return New MalString(File.ReadAllText(DirectCast(a(0),MalString).getValue())) End Function ' List/Vector functions Shared Function list(a As MalList) As MalVal return New MalList(a.getValue()) End Function Shared Function list_Q(a As MalList) As MalVal If TypeOf a(0) Is MalList And Not TypeOf a(0) Is MalVector Then return MalTrue Else return MalFalse End If End Function Shared Function vector(a As MalList) As MalVal return New MalVector(a.getValue()) End Function Shared Function vector_Q(a As MalList) As MalVal If TypeOf a(0) Is MalVector Then return MalTrue Else return MalFalse End If End Function ' HashMap functions Shared Function hash_map(a As MalList) As MalVal return New MalHashMap(a) End Function Shared Function hash_map_Q(a As MalList) As MalVal If TypeOf a(0) Is MalHashMap Then return MalTrue Else return MalFalse End If End Function Shared Function contains_Q(a As MalList) As MalVal Dim key As String = DirectCast(a(1),MalString).getValue() Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue() If dict.ContainsKey(key) Then return MalTrue Else return MalFalse End If End Function Shared Function assoc(a As MalList) As MalVal Dim new_hm As MalHashMap = DirectCast(a(0),MalHashMap).copy() return new_hm.assoc_BANG(DirectCast(a.slice(1),MalList)) End Function Shared Function dissoc(a As MalList) As MalVal Dim new_hm As MalHashMap = DirectCast(a(0),MalHashMap).copy() return new_hm.dissoc_BANG(DirectCast(a.slice(1),MalList)) End Function Shared Function do_get(a As MalList) As MalVal Dim k As String = DirectCast(a(1),MalString).getValue() If a(0) Is Nil Then return Nil Else Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue() If dict.ContainsKey(k) Then return dict(k) Else return Nil End If End If End Function Shared Function keys(a As MalList) As MalVal Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue() Dim key_lst As MalList = New MalList() For Each key As String in dict.Keys key_lst.conj_BANG(new MalString(key)) Next return key_lst End Function Shared Function vals(a As MalList) As MalVal Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue() Dim val_lst As MalList = New MalList() For Each val As MalVal In dict.Values val_lst.conj_BANG(val) Next return val_lst End Function ' Sequence functions Shared Function sequential_Q(a As MalList) As MalVal If TypeOf a(0) Is MalList Then return MalTrue Else return MalFalse End If End Function Shared Function cons(a As MalList) As MalVal Dim lst As New List(Of MalVal) lst.Add(a(0)) lst.AddRange(DirectCast(a(1),MalList).getValue()) return DirectCast(New MalList(lst),MalVal) End Function Shared Function concat(a As MalList) As MalVal If a.size() = 0 Then return new MalList() End If Dim lst As New List(Of MalVal) lst.AddRange(DirectCast(a(0),MalList).getValue()) for i As Integer = 1 To a.size()-1 lst.AddRange(DirectCast(a(i),MalList).getValue()) Next 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 return DirectCast(a(0),MalList)( idx ) Else throw new Mal.types.MalException( "nth: index out of range") End If End Function Shared Function first(a As MalList) As MalVal If a(0) Is Nil Then return Nil Else return DirectCast(a(0),MalList)(0) End If End Function Shared Function rest(a As MalList) As MalVal If a(0) Is Nil Then return new MalList() Else return DirectCast(a(0),MalList).rest() End If End Function Shared Function empty_Q(a As MalList) As MalVal If DirectCast(a(0),MalList).size() = 0 Then return MalTrue Else return MalFalse End If End Function Shared Function count(a As MalList) As MalVal If a(0) Is Nil Then return new MalInt(0) Else return new MalInt(DirectCast(a(0),MalList).size()) End If End Function Shared Function conj(a As MalList) As MalVal Dim src_lst As List(Of MalVal) = DirectCast(a(0),MalList).getValue() Dim new_lst As New List(Of MalVal) new_lst.AddRange(src_lst) If TypeOf a(0) Is MalVector Then For i As Integer = 1 To a.size()-1 new_lst.Add(a(i)) Next return new MalVector(new_lst) Else For i As Integer = 1 To a.size()-1 new_lst.Insert(0, a(i)) Next return new MalList(new_lst) End If End Function Shared Function seq(a As MalList) As MalVal If a(0) Is Nil Then return Nil Elseif TypeOf a(0) is MalVector Then If DirectCast(a(0),MalVector).size() = 0 Then return Nil End If return new MalList(DirectCast(a(0),MalVector).getValue()) Elseif TypeOf a(0) is MalList Then If DirectCast(a(0),MalList).size() = 0 Then return Nil End If return a(0) Elseif TypeOf a(0) is MalString Then Dim s As String = DirectCast(a(0),MalString).getValue() If s.Length = 0 Then return Nil End If Dim chars_list As New List(Of MalVal) For Each c As Char In s chars_list.Add(new MalString(c.ToString())) Next return new MalList(chars_list) Else return Nil End If End Function ' General list related functions Shared Function apply(a As MalList) As MalVal Dim f As MalFunc = DirectCast(a(0),MalFunc) Dim lst As New List(Of MalVal) lst.AddRange(a.slice(1,a.size()-1).getValue()) lst.AddRange(DirectCast(a(a.size()-1),MalList).getValue()) return f.apply(New MalList(lst)) End Function Shared Function map(a As MalList) As MalVal Dim f As MalFunc = DirectCast(a(0),MalFunc) Dim src_lst As List(Of MalVal) = DirectCast(a(1),MalList).getValue() Dim new_lst As New List(Of MalVal) for i As Integer = 0 To src_lst.Count-1 new_lst.Add(f.apply(New MalList(src_lst(i)))) Next return new MalList(new_lst) End Function ' Metadata functions Shared Function atom(a As MalList) As MalVal return new MalAtom(a(0)) End Function Shared Function meta(a As MalList) As MalVal return a(0).getMeta() End Function Shared Function with_meta(a As MalList) As MalVal return DirectCast(a(0),MalVal).copy().setMeta(a(1)) End Function ' Atom functions Shared Function atom_Q(a As MalList) As MalVal If TypeOf a(0) Is MalAtom Then return MalTrue Else return MalFalse End If End Function Shared Function deref(a As MalList) As MalVal return DirectCast(a(0),MalAtom).getValue() End Function Shared Function reset_BANG(a As MalList) As MalVal return DirectCast(a(0),MalAtom).setValue(a(1)) End Function Shared Function swap_BANG(a As MalList) As MalVal Dim atm As MalAtom = DirectCast(a(0),MalAtom) Dim f As MalFunc = DirectCast(a(1),MalFunc) Dim new_lst As New List(Of MalVal) new_lst.Add(atm.getValue()) new_lst.AddRange(DirectCast(a.slice(2),MalList).getValue()) return atm.setValue(f.apply(New MalList(new_lst))) End Function Shared Function ns As Dictionary(Of String, MalVal) Dim ns As New Dictionary(Of String, MalVal) ns.Add("=", New MalFunc(AddressOf equal_Q)) ns.Add("throw", New MalFunc(AddressOf mal_throw)) ns.Add("nil?", New MalFunc(AddressOf nil_Q)) ns.Add("true?", New MalFunc(AddressOf true_Q)) ns.Add("false?", New MalFunc(AddressOf false_Q)) ns.Add("symbol", new MalFunc(AddressOf symbol)) ns.Add("symbol?", New MalFunc(AddressOf symbol_Q)) ns.Add("string?", New MalFunc(AddressOf string_Q)) ns.Add("keyword", new MalFunc(AddressOf keyword)) ns.Add("keyword?", New MalFunc(AddressOf keyword_Q)) ns.Add("number?", New MalFunc(AddressOf number_Q)) ns.Add("fn?", New MalFunc(AddressOf fn_Q)) ns.Add("macro?", New MalFunc(AddressOf macro_Q)) ns.Add("pr-str",New MalFunc(AddressOf pr_str)) ns.Add("str", New MalFunc(AddressOf str)) ns.Add("prn", New MalFunc(AddressOf prn)) ns.Add("println", New MalFunc(AddressOf println)) ns.Add("readline", New MalFunc(AddressOf mal_readline)) ns.Add("read-string", New MalFunc(AddressOf read_string)) ns.Add("slurp", New MalFunc(AddressOf slurp)) ns.Add("<", New MalFunc(AddressOf lt)) ns.Add("<=", New MalFunc(AddressOf lte)) ns.Add(">", New MalFunc(AddressOf gt)) ns.Add(">=", New MalFunc(AddressOf gte)) ns.Add("+", New MalFunc(AddressOf plus)) ns.Add("-", New MalFunc(AddressOf minus)) ns.Add("*", New MalFunc(AddressOf mult)) ns.Add("/", New MalFunc(AddressOf div)) ns.Add("time-ms", New MalFunc(AddressOf time_ms)) ns.Add("list", New MalFunc(AddressOf list)) ns.Add("list?", New MalFunc(AddressOf list_Q)) ns.Add("vector", new MalFunc(AddressOf vector)) ns.Add("vector?", New MalFunc(AddressOf vector_Q)) ns.Add("hash-map", new MalFunc(AddressOf hash_map)) ns.Add("map?", New MalFunc(AddressOf hash_map_Q)) ns.Add("contains?", New MalFunc(AddressOf contains_Q)) ns.Add("assoc", New MalFunc(AddressOf assoc)) ns.Add("dissoc", New MalFunc(AddressOf dissoc)) ns.Add("get", New MalFunc(AddressOf do_get)) ns.Add("keys", New MalFunc(AddressOf keys)) ns.Add("vals", New MalFunc(AddressOf vals)) 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)) ns.Add("empty?", New MalFunc(AddressOf empty_Q)) ns.Add("count",New MalFunc(AddressOf count)) ns.Add("conj", New MalFunc(AddressOf conj)) ns.Add("seq", New MalFunc(AddressOf seq)) ns.Add("apply", New MalFunc(AddressOf apply)) ns.Add("map", New MalFunc(AddressOf map)) ns.Add("with-meta", New MalFunc(AddressOf with_meta)) ns.Add("meta", New MalFunc(AddressOf meta)) ns.Add("atom", new MalFunc(AddressOf atom)) ns.Add("atom?", New MalFunc(AddressOf atom_Q)) ns.Add("deref", New MalFunc(AddressOf deref)) ns.Add("reset!", New MalFunc(AddressOf reset_BANG)) ns.Add("swap!", New MalFunc(AddressOf swap_BANG)) return ns End Function End Class End Namespace ================================================ FILE: impls/vb/env.vb ================================================ Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Namespace Mal Public Class env Public Class Env Dim outer As Env = Nothing Dim data As Dictionary(Of String, MalVal) = New Dictionary(Of String, MalVal) Public Sub New(new_outer As Env) outer = new_outer End Sub Public Sub New(new_outer As Env, binds As MalList, exprs As MalList) outer = new_outer For i As Integer = 0 To binds.size()-1 Dim sym As String = DirectCast(binds.nth(i),MalSymbol).getName() If sym = "&" Then data(DirectCast(binds.nth(i+1),MalSymbol).getName()) = exprs.slice(i) Exit For Else data(sym) = exprs.nth(i) End If Next End Sub Public Function do_get(key As String) As MalVal If data.ContainsKey(key) Then return data(key) Else If outer IsNot Nothing Then return outer.do_get(key) Else return Nothing End If End Function Public Function do_set(key As MalSymbol, value As MalVal) As Env data(key.getName()) = value return Me End Function End Class End Class End Namespace ================================================ FILE: impls/vb/getline.cs ================================================ // // getline.cs: A command line editor // // Authors: // Miguel de Icaza (miguel@novell.com) // // Copyright 2008 Novell, Inc. // // Dual-licensed under the terms of the MIT X11 license or the // Apache License 2.0 // // USE -define:DEMO to build this as a standalone file and test it // // TODO: // Enter an error (a = 1); Notice how the prompt is in the wrong line // This is caused by Stderr not being tracked by System.Console. // Completion support // Why is Thread.Interrupt not working? Currently I resort to Abort which is too much. // // Limitations in System.Console: // Console needs SIGWINCH support of some sort // Console needs a way of updating its position after things have been written // behind its back (P/Invoke puts for example). // System.Console needs to get the DELETE character, and report accordingly. // using System; using System.Text; using System.IO; using System.Threading; using System.Reflection; namespace Mono.Terminal { public class LineEditor { public class Completion { public string [] Result; public string Prefix; public Completion (string prefix, string [] result) { Prefix = prefix; Result = result; } } public delegate Completion AutoCompleteHandler (string text, int pos); //static StreamWriter log; // The text being edited. StringBuilder text; // The text as it is rendered (replaces (char)1 with ^A on display for example). StringBuilder rendered_text; // The prompt specified, and the prompt shown to the user. string prompt; string shown_prompt; // The current cursor position, indexes into "text", for an index // into rendered_text, use TextToRenderPos int cursor; // The row where we started displaying data. int home_row; // The maximum length that has been displayed on the screen int max_rendered; // If we are done editing, this breaks the interactive loop bool done = false; // The thread where the Editing started taking place Thread edit_thread; // Our object that tracks history History history; // The contents of the kill buffer (cut/paste in Emacs parlance) string kill_buffer = ""; // The string being searched for string search; string last_search; // whether we are searching (-1= reverse; 0 = no; 1 = forward) int searching; // The position where we found the match. int match_at; // Used to implement the Kill semantics (multiple Alt-Ds accumulate) KeyHandler last_handler; delegate void KeyHandler (); struct Handler { public ConsoleKeyInfo CKI; public KeyHandler KeyHandler; public Handler (ConsoleKey key, KeyHandler h) { CKI = new ConsoleKeyInfo ((char) 0, key, false, false, false); KeyHandler = h; } public Handler (char c, KeyHandler h) { KeyHandler = h; // Use the "Zoom" as a flag that we only have a character. CKI = new ConsoleKeyInfo (c, ConsoleKey.Zoom, false, false, false); } public Handler (ConsoleKeyInfo cki, KeyHandler h) { CKI = cki; KeyHandler = h; } public static Handler Control (char c, KeyHandler h) { return new Handler ((char) (c - 'A' + 1), h); } public static Handler Alt (char c, ConsoleKey k, KeyHandler h) { ConsoleKeyInfo cki = new ConsoleKeyInfo ((char) c, k, false, true, false); return new Handler (cki, h); } } /// /// Invoked when the user requests auto-completion using the tab character /// /// /// The result is null for no values found, an array with a single /// string, in that case the string should be the text to be inserted /// for example if the word at pos is "T", the result for a completion /// of "ToString" should be "oString", not "ToString". /// /// When there are multiple results, the result should be the full /// text /// public AutoCompleteHandler AutoCompleteEvent; static Handler [] handlers; public LineEditor (string name) : this (name, 10) { } public LineEditor (string name, int histsize) { handlers = new Handler [] { new Handler (ConsoleKey.Home, CmdHome), new Handler (ConsoleKey.End, CmdEnd), new Handler (ConsoleKey.LeftArrow, CmdLeft), new Handler (ConsoleKey.RightArrow, CmdRight), new Handler (ConsoleKey.UpArrow, CmdHistoryPrev), new Handler (ConsoleKey.DownArrow, CmdHistoryNext), new Handler (ConsoleKey.Enter, CmdDone), new Handler (ConsoleKey.Backspace, CmdBackspace), new Handler (ConsoleKey.Delete, CmdDeleteChar), new Handler (ConsoleKey.Tab, CmdTabOrComplete), // Emacs keys Handler.Control ('A', CmdHome), Handler.Control ('E', CmdEnd), Handler.Control ('B', CmdLeft), Handler.Control ('F', CmdRight), Handler.Control ('P', CmdHistoryPrev), Handler.Control ('N', CmdHistoryNext), Handler.Control ('K', CmdKillToEOF), Handler.Control ('Y', CmdYank), Handler.Control ('D', CmdDeleteChar), Handler.Control ('L', CmdRefresh), Handler.Control ('R', CmdReverseSearch), Handler.Control ('G', delegate {} ), Handler.Alt ('B', ConsoleKey.B, CmdBackwardWord), Handler.Alt ('F', ConsoleKey.F, CmdForwardWord), Handler.Alt ('D', ConsoleKey.D, CmdDeleteWord), Handler.Alt ((char) 8, ConsoleKey.Backspace, CmdDeleteBackword), // DEBUG //Handler.Control ('T', CmdDebug), // quote Handler.Control ('Q', delegate { HandleChar (Console.ReadKey (true).KeyChar); }) }; rendered_text = new StringBuilder (); text = new StringBuilder (); history = new History (name, histsize); //if (File.Exists ("log"))File.Delete ("log"); //log = File.CreateText ("log"); } void CmdDebug () { history.Dump (); Console.WriteLine (); Render (); } void Render () { Console.Write (shown_prompt); Console.Write (rendered_text); int max = System.Math.Max (rendered_text.Length + shown_prompt.Length, max_rendered); for (int i = rendered_text.Length + shown_prompt.Length; i < max_rendered; i++) Console.Write (' '); max_rendered = shown_prompt.Length + rendered_text.Length; // Write one more to ensure that we always wrap around properly if we are at the // end of a line. Console.Write (' '); UpdateHomeRow (max); } void UpdateHomeRow (int screenpos) { int lines = 1 + (screenpos / Console.WindowWidth); home_row = Console.CursorTop - (lines - 1); if (home_row < 0) home_row = 0; } void RenderFrom (int pos) { int rpos = TextToRenderPos (pos); int i; for (i = rpos; i < rendered_text.Length; i++) Console.Write (rendered_text [i]); if ((shown_prompt.Length + rendered_text.Length) > max_rendered) max_rendered = shown_prompt.Length + rendered_text.Length; else { int max_extra = max_rendered - shown_prompt.Length; for (; i < max_extra; i++) Console.Write (' '); } } void ComputeRendered () { rendered_text.Length = 0; for (int i = 0; i < text.Length; i++){ int c = (int) text [i]; if (c < 26){ if (c == '\t') rendered_text.Append (" "); else { rendered_text.Append ('^'); rendered_text.Append ((char) (c + (int) 'A' - 1)); } } else rendered_text.Append ((char)c); } } int TextToRenderPos (int pos) { int p = 0; for (int i = 0; i < pos; i++){ int c; c = (int) text [i]; if (c < 26){ if (c == 9) p += 4; else p += 2; } else p++; } return p; } int TextToScreenPos (int pos) { return shown_prompt.Length + TextToRenderPos (pos); } string Prompt { get { return prompt; } set { prompt = value; } } int LineCount { get { return (shown_prompt.Length + rendered_text.Length)/Console.WindowWidth; } } void ForceCursor (int newpos) { cursor = newpos; int actual_pos = shown_prompt.Length + TextToRenderPos (cursor); int row = home_row + (actual_pos/Console.WindowWidth); int col = actual_pos % Console.WindowWidth; if (row >= Console.BufferHeight) row = Console.BufferHeight-1; Console.SetCursorPosition (col, row); //log.WriteLine ("Going to cursor={0} row={1} col={2} actual={3} prompt={4} ttr={5} old={6}", newpos, row, col, actual_pos, prompt.Length, TextToRenderPos (cursor), cursor); //log.Flush (); } void UpdateCursor (int newpos) { if (cursor == newpos) return; ForceCursor (newpos); } void InsertChar (char c) { int prev_lines = LineCount; text = text.Insert (cursor, c); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); ForceCursor (++cursor); } else { RenderFrom (cursor); ForceCursor (++cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } // // Commands // void CmdDone () { done = true; } void CmdTabOrComplete () { bool complete = false; if (AutoCompleteEvent != null){ if (TabAtStartCompletes) complete = true; else { for (int i = 0; i < cursor; i++){ if (!Char.IsWhiteSpace (text [i])){ complete = true; break; } } } if (complete){ Completion completion = AutoCompleteEvent (text.ToString (), cursor); string [] completions = completion.Result; if (completions == null) return; int ncompletions = completions.Length; if (ncompletions == 0) return; if (completions.Length == 1){ InsertTextAtCursor (completions [0]); } else { int last = -1; for (int p = 0; p < completions [0].Length; p++){ char c = completions [0][p]; for (int i = 1; i < ncompletions; i++){ if (completions [i].Length < p) goto mismatch; if (completions [i][p] != c){ goto mismatch; } } last = p; } mismatch: if (last != -1){ InsertTextAtCursor (completions [0].Substring (0, last+1)); } Console.WriteLine (); foreach (string s in completions){ Console.Write (completion.Prefix); Console.Write (s); Console.Write (' '); } Console.WriteLine (); Render (); ForceCursor (cursor); } } else HandleChar ('\t'); } else HandleChar ('t'); } void CmdHome () { UpdateCursor (0); } void CmdEnd () { UpdateCursor (text.Length); } void CmdLeft () { if (cursor == 0) return; UpdateCursor (cursor-1); } void CmdBackwardWord () { int p = WordBackward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdForwardWord () { int p = WordForward (cursor); if (p == -1) return; UpdateCursor (p); } void CmdRight () { if (cursor == text.Length) return; UpdateCursor (cursor+1); } void RenderAfter (int p) { ForceCursor (p); RenderFrom (p); ForceCursor (cursor); } void CmdBackspace () { if (cursor == 0) return; text.Remove (--cursor, 1); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteChar () { // If there is no input, this behaves like EOF if (text.Length == 0){ done = true; text = null; Console.WriteLine (); return; } if (cursor == text.Length) return; text.Remove (cursor, 1); ComputeRendered (); RenderAfter (cursor); } int WordForward (int p) { if (p >= text.Length) return -1; int i = p; if (Char.IsPunctuation (text [p]) || Char.IsSymbol (text [p]) || Char.IsWhiteSpace (text[p])){ for (; i < text.Length; i++){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } else { for (; i < text.Length; i++){ if (!Char.IsLetterOrDigit (text [i])) break; } } if (i != p) return i; return -1; } int WordBackward (int p) { if (p == 0) return -1; int i = p-1; if (i == 0) return 0; if (Char.IsPunctuation (text [i]) || Char.IsSymbol (text [i]) || Char.IsWhiteSpace (text[i])){ for (; i >= 0; i--){ if (Char.IsLetterOrDigit (text [i])) break; } for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text[i])) break; } } else { for (; i >= 0; i--){ if (!Char.IsLetterOrDigit (text [i])) break; } } i++; if (i != p) return i; return -1; } void CmdDeleteWord () { int pos = WordForward (cursor); if (pos == -1) return; string k = text.ToString (cursor, pos-cursor); if (last_handler == CmdDeleteWord) kill_buffer = kill_buffer + k; else kill_buffer = k; text.Remove (cursor, pos-cursor); ComputeRendered (); RenderAfter (cursor); } void CmdDeleteBackword () { int pos = WordBackward (cursor); if (pos == -1) return; string k = text.ToString (pos, cursor-pos); if (last_handler == CmdDeleteBackword) kill_buffer = k + kill_buffer; else kill_buffer = k; text.Remove (pos, cursor-pos); ComputeRendered (); RenderAfter (pos); } // // Adds the current line to the history if needed // void HistoryUpdateLine () { history.Update (text.ToString ()); } void CmdHistoryPrev () { if (!history.PreviousAvailable ()) return; HistoryUpdateLine (); SetText (history.Previous ()); } void CmdHistoryNext () { if (!history.NextAvailable()) return; history.Update (text.ToString ()); SetText (history.Next ()); } void CmdKillToEOF () { kill_buffer = text.ToString (cursor, text.Length-cursor); text.Length = cursor; ComputeRendered (); RenderAfter (cursor); } void CmdYank () { InsertTextAtCursor (kill_buffer); } void InsertTextAtCursor (string str) { int prev_lines = LineCount; text.Insert (cursor, str); ComputeRendered (); if (prev_lines != LineCount){ Console.SetCursorPosition (0, home_row); Render (); cursor += str.Length; ForceCursor (cursor); } else { RenderFrom (cursor); cursor += str.Length; ForceCursor (cursor); UpdateHomeRow (TextToScreenPos (cursor)); } } void SetSearchPrompt (string s) { SetPrompt ("(reverse-i-search)`" + s + "': "); } void ReverseSearch () { int p; if (cursor == text.Length){ // The cursor is at the end of the string p = text.ToString ().LastIndexOf (search); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } else { // The cursor is somewhere in the middle of the string int start = (cursor == match_at) ? cursor - 1 : cursor; if (start != -1){ p = text.ToString ().LastIndexOf (search, start); if (p != -1){ match_at = p; cursor = p; ForceCursor (cursor); return; } } } // Need to search backwards in history HistoryUpdateLine (); string s = history.SearchBackward (search); if (s != null){ match_at = -1; SetText (s); ReverseSearch (); } } void CmdReverseSearch () { if (searching == 0){ match_at = -1; last_search = search; searching = -1; search = ""; SetSearchPrompt (""); } else { if (search == ""){ if (last_search != "" && last_search != null){ search = last_search; SetSearchPrompt (search); ReverseSearch (); } return; } ReverseSearch (); } } void SearchAppend (char c) { search = search + c; SetSearchPrompt (search); // // If the new typed data still matches the current text, stay here // if (cursor < text.Length){ string r = text.ToString (cursor, text.Length - cursor); if (r.StartsWith (search)) return; } ReverseSearch (); } void CmdRefresh () { Console.Clear (); max_rendered = 0; Render (); ForceCursor (cursor); } void InterruptEdit (object sender, ConsoleCancelEventArgs a) { // Do not abort our program: a.Cancel = true; // Interrupt the editor edit_thread.Abort(); } void HandleChar (char c) { if (searching != 0) SearchAppend (c); else InsertChar (c); } void EditLoop () { ConsoleKeyInfo cki; while (!done){ ConsoleModifiers mod; cki = Console.ReadKey (true); if (cki.Key == ConsoleKey.Escape){ cki = Console.ReadKey (true); mod = ConsoleModifiers.Alt; } else mod = cki.Modifiers; bool handled = false; foreach (Handler handler in handlers){ ConsoleKeyInfo t = handler.CKI; if (t.Key == cki.Key && t.Modifiers == mod){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } else if (t.KeyChar == cki.KeyChar && t.Key == ConsoleKey.Zoom){ handled = true; handler.KeyHandler (); last_handler = handler.KeyHandler; break; } } if (handled){ if (searching != 0){ if (last_handler != CmdReverseSearch){ searching = 0; SetPrompt (prompt); } } continue; } if (cki.KeyChar != (char) 0) HandleChar (cki.KeyChar); } } void InitText (string initial) { text = new StringBuilder (initial); ComputeRendered (); cursor = text.Length; Render (); ForceCursor (cursor); } void SetText (string newtext) { Console.SetCursorPosition (0, home_row); InitText (newtext); } void SetPrompt (string newprompt) { shown_prompt = newprompt; Console.SetCursorPosition (0, home_row); Render (); ForceCursor (cursor); } public string Edit (string prompt, string initial) { edit_thread = Thread.CurrentThread; searching = 0; Console.CancelKeyPress += InterruptEdit; done = false; history.CursorToEnd (); max_rendered = 0; Prompt = prompt; shown_prompt = prompt; InitText (initial); history.Append (initial); do { try { EditLoop (); } catch (ThreadAbortException){ searching = 0; Thread.ResetAbort (); Console.WriteLine (); SetPrompt (prompt); SetText (""); } } while (!done); Console.WriteLine (); Console.CancelKeyPress -= InterruptEdit; if (text == null){ history.Close (); return null; } string result = text.ToString (); if (result != "") history.Accept (result); else history.RemoveLast (); return result; } public void SaveHistory () { if (history != null) { history.Close (); } } public bool TabAtStartCompletes { get; set; } // // Emulates the bash-like behavior, where edits done to the // history are recorded // class History { string [] history; int head, tail; int cursor, count; string histfile; public History (string app, int size) { if (size < 1) throw new ArgumentException ("size"); if (app != null){ string dir = Environment.GetFolderPath (Environment.SpecialFolder.Personal); //Console.WriteLine (dir); /* if (!Directory.Exists (dir)){ try { Directory.CreateDirectory (dir); } catch { app = null; } } if (app != null) histfile = Path.Combine (dir, app) + ".history"; */ histfile = Path.Combine (dir, ".mal-history"); } history = new string [size]; head = tail = cursor = 0; if (File.Exists (histfile)){ using (StreamReader sr = File.OpenText (histfile)){ string line; while ((line = sr.ReadLine ()) != null){ if (line != "") Append (line); } } } } public void Close () { if (histfile == null) return; try { using (StreamWriter sw = File.CreateText (histfile)){ int start = (count == history.Length) ? head : tail; for (int i = start; i < start+count; i++){ int p = i % history.Length; sw.WriteLine (history [p]); } } } catch { // ignore } } // // Appends a value to the history // public void Append (string s) { //Console.WriteLine ("APPENDING {0} head={1} tail={2}", s, head, tail); history [head] = s; head = (head+1) % history.Length; if (head == tail) tail = (tail+1 % history.Length); if (count != history.Length) count++; //Console.WriteLine ("DONE: head={1} tail={2}", s, head, tail); } // // Updates the current cursor location with the string, // to support editing of history items. For the current // line to participate, an Append must be done before. // public void Update (string s) { history [cursor] = s; } public void RemoveLast () { head = head-1; if (head < 0) head = history.Length-1; } public void Accept (string s) { int t = head-1; if (t < 0) t = history.Length-1; history [t] = s; } public bool PreviousAvailable () { //Console.WriteLine ("h={0} t={1} cursor={2}", head, tail, cursor); if (count == 0) return false; int next = cursor-1; if (next < 0) next = count-1; if (next == head) return false; return true; } public bool NextAvailable () { if (count == 0) return false; int next = (cursor + 1) % history.Length; if (next == head) return false; return true; } // // Returns: a string with the previous line contents, or // nul if there is no data in the history to move to. // public string Previous () { if (!PreviousAvailable ()) return null; cursor--; if (cursor < 0) cursor = history.Length - 1; return history [cursor]; } public string Next () { if (!NextAvailable ()) return null; cursor = (cursor + 1) % history.Length; return history [cursor]; } public void CursorToEnd () { if (head == tail) return; cursor = head; } public void Dump () { Console.WriteLine ("Head={0} Tail={1} Cursor={2} count={3}", head, tail, cursor, count); for (int i = 0; i < history.Length;i++){ Console.WriteLine (" {0} {1}: {2}", i == cursor ? "==>" : " ", i, history[i]); } //log.Flush (); } public string SearchBackward (string term) { for (int i = 0; i < count; i++){ int slot = cursor-i-1; if (slot < 0) slot = history.Length+slot; if (slot >= history.Length) slot = 0; if (history [slot] != null && history [slot].IndexOf (term) != -1){ cursor = slot; return history [slot]; } } return null; } } } #if DEMO class Demo { static void Main () { LineEditor le = new LineEditor ("foo"); string s; while ((s = le.Edit ("shell> ", "")) != null){ Console.WriteLine ("----> [{0}]", s); } } } #endif } ================================================ FILE: impls/vb/printer.vb ================================================ Imports System Imports System.Collections.Generic Imports System.Text.RegularExpressions Imports Mal Imports MalVal = Mal.types.MalVal Imports MalList = Mal.types.MalList Namespace Mal Public Class printer Shared Function join(value As List(Of MalVal), delim As String, print_readably As Boolean) As String Dim strs As New List(Of String) For Each mv As MalVal In value strs.Add(mv.ToString(print_readably)) Next return String.Join(delim, strs.ToArray()) End Function Shared Function join(value As Dictionary(Of String, MalVal), delim As String, print_readably As Boolean) As String Dim strs As New List(Of String) For Each entry As KeyValuePair(Of String, MalVal) In value If entry.Key.Length > 0 and entry.Key(0) = ChrW(&H029e) Then strs.Add(":" & entry.Key.Substring(1)) Else If print_readably Then strs.Add("""" & entry.Key.ToString() & """") Else strs.Add(entry.Key.ToString()) End If strs.Add(entry.Value.ToString(print_readably)) Next return String.Join(delim, strs.ToArray()) End Function Shared Function _pr_str(mv As MalVal, print_readably As Boolean) As String return mv.ToString(print_readably) End Function Shared Function _pr_str_args(args As MalList, sep As String, print_readably As Boolean) As String return join(args.getValue(), sep, print_readably) End Function Shared Function escapeString(str As String) As String return Regex.Escape(str) End Function End Class End Namespace ================================================ FILE: impls/vb/reader.vb ================================================ Imports System Imports System.Collections Imports System.Collections.Generic Imports System.Text.RegularExpressions Imports Mal Imports MalVal = Mal.types.MalVal Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalThrowable = Mal.types.MalThrowable Imports MalContinue = Mal.types.MalContinue Namespace Mal Public Class reader Public Class ParseError Inherits MalThrowable Public Sub New(msg As String) MyBase.New(msg) End Sub End Class Public Class Reader Private tokens As New List(Of String) Private position As Int32 = 0 Sub New(t As List(Of String)) tokens = t position = 0 End Sub Public Function peek() As String If position >= tokens.Count Then return Nothing Else return tokens(position) End If End Function Public Function get_next() As String If position >= tokens.Count Then return Nothing Else position += 1 return tokens(position-1) End If End Function End Class Shared Function tokenize(str As String) As List(Of String) Dim tokens As New List(Of String) Dim pattern As String = "[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""?|;.*|[^\s \[\]{}()'""`~@,;]*)" Dim regex As New Regex(pattern) For Each match As Match In regex.Matches(str) Dim token As String = match.Groups(1).Value If Not token Is Nothing _ AndAlso Not token = "" _ AndAlso Not token(0) = ";" Then 'Console.WriteLine("match: ^" & match.Groups[1] & "$") tokens.Add(token) End If Next return tokens End Function Shared Function read_atom(rdr As Reader) As MalVal Dim token As String = rdr.get_next() Dim pattern As String = "(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|(^""(?:[\\].|[^\\""])*""$)|^("".*)|^:(.*)|(^[^""]*$)" Dim regex As Regex = New Regex(pattern) Dim match As Match = regex.Match(token) 'Console.WriteLine("token: ^" + token + "$") If not match.Success Then throw New ParseError("unrecognized token '" & token & "'") End If If match.Groups(1).Value <> String.Empty Then return New Mal.types.MalInt(Integer.Parse(match.Groups(1).Value)) Else If match.Groups(3).Value <> String.Empty Then return Mal.types.Nil Else If match.Groups(4).Value <> String.Empty Then return Mal.types.MalTrue Else If match.Groups(5).Value <> String.Empty Then return Mal.types.MalFalse Else If match.Groups(6).Value <> String.Empty Then Dim str As String = match.Groups(6).Value return New Mal.types.MalString( str.Substring(1, str.Length-2) _ .Replace("\\", ChrW(&H029e)) _ .Replace("\""", """") _ .Replace("\n", Environment.NewLine) _ .Replace(ChrW(&H029e), "\")) Else If match.Groups(7).Value <> String.Empty Then throw New ParseError("expected '""', got EOF") Else If match.Groups(8).Value <> String.Empty Then return New Mal.types.MalString(ChrW(&H029e) & match.Groups(8).Value) Else If match.Groups(9).Value <> String.Empty Then return New Mal.types.MalSymbol(match.Groups(9).Value) Else throw New ParseError("unrecognized '" & match.Groups(0).Value & "'") End If End Function Shared Function read_list(rdr As Reader, lst As MalList, start As String, last As String) As MalVal Dim token As String = rdr.get_next() If token(0) <> start Then throw New ParseError("expected '" & start & "'") End If token = rdr.peek() While token IsNot Nothing AndAlso token(0) <> last lst.conj_BANG(read_form(rdr)) token = rdr.peek() End While If token Is Nothing Then throw New ParseError("expected '" & last & "', got EOF") End If rdr.get_next() return lst End Function Shared Function read_hash_map(rdr As Reader) As MalVal Dim lst As MalList = DirectCast(read_list(rdr, new MalList(), "{", "}"),MalList) return New MalHashMap(lst) End Function Shared Function read_form(rdr As Reader) As MalVal Dim token As String = rdr.peek() If token Is Nothing Then throw New MalContinue() End If Dim form As MalVal = Nothing Select token Case "'" rdr.get_next() return New MalList(New MalSymbol("quote"), read_form(rdr)) Case "`" rdr.get_next() return New MalList(New MalSymbol("quasiquote"), read_form(rdr)) Case "~" rdr.get_next() return New MalList(New MalSymbol("unquote"), read_form(rdr)) Case "~@" rdr.get_next() return new MalList(New MalSymbol("splice-unquote"), read_form(rdr)) Case "^" rdr.get_next() Dim meta As MalVal = read_form(rdr) return new MalList(New MalSymbol("with-meta"), read_form(rdr), meta) Case "@" rdr.get_next() return new MalList(New MalSymbol("deref"), read_form(rdr)) Case "(" form = read_list(rdr, New MalList(), "(" , ")") Case ")" throw New ParseError("unexpected ')'") Case "[" form = read_list(rdr, New MalVector(), "[" , "]") Case "]" throw New ParseError("unexpected ']'") Case "{" form = read_hash_map(rdr) Case "}" throw New ParseError("unexpected '}'") Case Else form = read_atom(rdr) End Select return form End Function Shared Function read_str(str As string) As MalVal return read_form(New Reader(tokenize(str))) End Function End Class End Namespace ================================================ FILE: impls/vb/readline.vb ================================================ Imports System Imports Mono.Terminal ' LineEditor (getline.cs) Namespace Mal Public Class readline Enum Modes Terminal Raw End Enum Public Shared mode As Modes = Modes.Terminal Shared lineedit As LineEditor = Nothing Public Shared Sub SetMode(new_mode As Modes) mode = new_mode End Sub Public Shared Function Readline(prompt As String) As String If mode = Modes.Terminal Then If lineedit Is Nothing Then lineedit = New LineEditor("Mal") End If return lineedit.Edit(prompt, "") Else Console.Write(prompt) Console.Out.Flush() return Console.ReadLine() End If End Function End Class End Namespace ================================================ FILE: impls/vb/run ================================================ #!/usr/bin/env bash exec mono $(dirname $0)/${STEP:-stepA_mal}.exe ${RAW:+--raw} "${@}" ================================================ FILE: impls/vb/step0_repl.vb ================================================ Imports System Imports Mal Namespace Mal Class step0_repl ' read Shared Function READ(str As String) As String Return str End Function ' eval Shared Function EVAL(ast As String, env As String) As String Return ast End Function ' print Shared Function PRINT(exp As String) As String Return exp End Function ' repl Shared Function REP(str As String, env As String) As String Return PRINT(EVAL(READ(str), env)) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Console.WriteLine(REP(line, "")) Loop While True Return 0 End function End Class End Namespace ================================================ FILE: impls/vb/step1_read_print.vb ================================================ Imports System Imports System.IO Imports Mal Imports MalVal = Mal.types.MalVal Namespace Mal Class step1_read_print ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval Shared Function EVAL(ast As MalVal, env As String) As MalVal Return ast End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), "")) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step2_eval.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Namespace Mal Class step2_eval ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) If TypeOf orig_ast Is MalSymbol Then Dim sym As MalSymbol = DirectCast(orig_ast, MalSymbol) return env.Item(sym.getName()) Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As Dictionary(Of String, MalVal) Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function add(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) + DirectCast(a.Item(1),MalInt) End Function Shared Function minus(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) - DirectCast(a.Item(1),MalInt) End Function Shared Function mult(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) * DirectCast(a.Item(1),MalInt) End Function Shared Function div(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) / DirectCast(a.Item(1),MalInt) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New Dictionary(Of String, MalVal) repl_env.Add("+", New MalFunc(AddressOf add)) repl_env.Add("-", New MalFunc(AddressOf minus)) repl_env.Add("*", New MalFunc(AddressOf mult)) repl_env.Add("/", New MalFunc(AddressOf div)) If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step3_env.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step3_env ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Select DirectCast(a0,MalSymbol).getName() Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next return EVAL(a2, let_env) Case Else Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function add(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) + DirectCast(a.Item(1),MalInt) End Function Shared Function minus(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) - DirectCast(a.Item(1),MalInt) End Function Shared Function mult(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) * DirectCast(a.Item(1),MalInt) End Function Shared Function div(a As MalList) As MalVal Return DirectCast(a.Item(0),MalInt) / DirectCast(a.Item(1),MalInt) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) repl_env.do_set(new MalSymbol("+"), New MalFunc(AddressOf add)) repl_env.do_set(new MalSymbol("-"), New MalFunc(AddressOf minus)) repl_env.do_set(new MalSymbol("*"), New MalFunc(AddressOf mult)) repl_env.do_set(new MalSymbol("/"), New MalFunc(AddressOf div)) If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step4_if_fn_do.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step4_if_fn_do ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next return EVAL(a2, let_env) Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next return EVAL(ast(ast.size()-1), env) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then Dim a3 As MalVal = ast(3) return EVAL(a3, env) Else return Mal.types.Nil End If Else ' eval true slot form Dim a2 As MalVal = ast(2) return EVAL(a2, env) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(f) return DirectCast(mf,MalVal) Case Else Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step5_tco.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step5_tco ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(el.rest()) Else Return f.apply(el.rest()) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step6_file.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalString = Mal.types.MalString Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step6_file ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(el.rest()) Else Return f.apply(el.rest()) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function do_eval(args As MalList) As MalVal Return EVAL(args(0), repl_env) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) Dim fileIdx As Integer = 1 If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) fileIdx = 2 End If Dim argv As New MalList() For i As Integer = fileIdx+1 To args.Length-1 argv.conj_BANG(new MalString(args(i))) Next repl_env.do_set(new MalSymbol("*ARGV*"), argv) ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") return 0 End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step7_quote.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalString = Mal.types.MalString Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step7_quote ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval 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 TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) 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 ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "quote" return ast(1) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim el As MalList = New MalList Dim mv As MalVal For Each mv In ast.getValue() el.conj_BANG(EVAL(mv, env)) Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(el.rest()) Else Return f.apply(el.rest()) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function do_eval(args As MalList) As MalVal Return EVAL(args(0), repl_env) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) Dim fileIdx As Integer = 1 If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) fileIdx = 2 End If Dim argv As New MalList() For i As Integer = fileIdx+1 To args.Length-1 argv.conj_BANG(new MalString(args(i))) Next repl_env.do_set(new MalSymbol("*ARGV*"), argv) ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") return 0 End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step8_macros.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalString = Mal.types.MalString Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step8_macros ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval 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 TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) 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 ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "quote" return ast(1) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() env.do_set(DirectCast(a1,MalSymbol), res) return res Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) If f.isMacro() Then orig_ast = f.apply(ast.rest()) Continue Do End If Dim args As MalList = New MalList For i As Integer = 1 To ast.size()-1 args.conj_BANG(EVAL(ast(i), env)) Next Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(args) Else Return f.apply(args) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function do_eval(args As MalList) As MalVal Return EVAL(args(0), repl_env) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) Dim fileIdx As Integer = 1 If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) fileIdx = 2 End If Dim argv As New MalList() For i As Integer = fileIdx+1 To args.Length-1 argv.conj_BANG(new MalString(args(i))) Next repl_env.do_set(new MalSymbol("*ARGV*"), argv) ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") return 0 End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e as Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/step9_try.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalString = Mal.types.MalString Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class step9_try ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval 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 TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) 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 ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "quote" return ast(1) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() env.do_set(DirectCast(a1,MalSymbol), res) return res Case "try*" Try return EVAL(ast(1), env) Catch e As Exception If ast.size() > 2 Then Dim exc As MalVal Dim a2 As MalVal = ast(2) Dim a20 As MalVal = DirectCast(a2,MalList)(0) If DirectCast(a20,MalSymbol).getName() = "catch*" Then If TypeOf e Is Mal.types.MalException Then exc = DirectCast(e,Mal.types.MalException).getValue() Else exc = New MalString(e.Message) End If return EVAL( DirectCast(a2,MalList)(2), New MalEnv(env, DirectCast(a2,MalList).slice(1,2), New MalList(exc))) End If End If Throw e End Try Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) If f.isMacro() Then orig_ast = f.apply(ast.rest()) Continue Do End If Dim args As MalList = New MalList For i As Integer = 1 To ast.size()-1 args.conj_BANG(EVAL(ast(i), env)) Next Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(args) Else Return f.apply(args) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function do_eval(args As MalList) As MalVal Return EVAL(args(0), repl_env) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) Dim fileIdx As Integer = 1 If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) fileIdx = 2 End If Dim argv As New MalList() For i As Integer = fileIdx+1 To args.Length-1 argv.conj_BANG(new MalString(args(i))) Next repl_env.do_set(new MalSymbol("*ARGV*"), argv) ' core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") return 0 End If ' repl loop Dim line As String Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e As Mal.types.MalException Console.WriteLine("Error: " & _ printer._pr_str(e.getValue(), False)) Continue Do Catch e As Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/stepA_mal.vb ================================================ Imports System Imports System.IO Imports System.Collections.Generic Imports Mal Imports MalVal = Mal.types.MalVal Imports MalInt = Mal.types.MalInt Imports MalString = Mal.types.MalString Imports MalSymbol = Mal.types.MalSymbol Imports MalList = Mal.types.MalList Imports MalVector = Mal.types.MalVector Imports MalHashMap = Mal.types.MalHashMap Imports MalFunc = Mal.types.MalFunc Imports MalEnv = Mal.env.Env Namespace Mal Class stepA_mal ' read Shared Function READ(str As String) As MalVal Return reader.read_str(str) End Function ' eval 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 TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) 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 ' TODO: move to types.vb when it is ported Class FClosure Public ast As MalVal Public params As MalList Public env As MalEnv Function fn(args as MalList) As MalVal return EVAL(ast, new MalEnv(env, params, args)) End Function End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) End If If TypeOf orig_ast Is MalSymbol Then Dim key As String = DirectCast(orig_ast, MalSymbol).getName() Dim result As MalVal = env.do_get(key) If result Is Nothing Then throw New Mal.types.MalException("'" & key & "' not found") End If return result Else If TypeOf orig_ast Is MalVector Then Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList new_lst = DirectCast(New MalVector, MalList) Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst Else If TypeOf orig_ast Is MalHashMap Then Dim new_dict As New Dictionary(Of String, MalVal) Dim entry As KeyValuePair(Of String, MalVal) For Each entry in DirectCast(orig_ast,MalHashMap).getValue() new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) Next return New MalHashMap(new_dict) Else If not orig_ast.list_Q() Then return orig_ast End If ' apply list Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast End If Dim a0 As MalVal = ast(0) Dim a0sym As String If TypeOf a0 is MalSymbol Then a0sym = DirectCast(a0,MalSymbol).getName() Else a0sym = "__<*fn*>__" End If Select a0sym Case "def!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = EVAL(a2, env) env.do_set(DirectCast(a1,MalSymbol), res) return res Case "let*" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim key As MalSymbol Dim val as MalVal Dim let_env As new MalEnv(env) For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) val = DirectCast(a1,MalList)(i+1) let_env.do_set(key, EVAL(val, let_env)) Next orig_ast = a2 env = let_env Case "quote" return ast(1) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" Dim a1 As MalVal = ast(1) Dim a2 As MalVal = ast(2) Dim res As MalVal = DirectCast(EVAL(a2, env), MalFunc).asMacro() env.do_set(DirectCast(a1,MalSymbol), res) return res Case "try*" Try return EVAL(ast(1), env) Catch e As Exception If ast.size() > 2 Then Dim exc As MalVal Dim a2 As MalVal = ast(2) Dim a20 As MalVal = DirectCast(a2,MalList)(0) If DirectCast(a20,MalSymbol).getName() = "catch*" Then If TypeOf e Is Mal.types.MalException Then exc = DirectCast(e,Mal.types.MalException).getValue() Else exc = New MalString(e.Message) End If return EVAL( DirectCast(a2,MalList)(2), New MalEnv(env, DirectCast(a2,MalList).slice(1,2), New MalList(exc))) End If End If Throw e End Try Case "do" For i As Integer = 1 To ast.size()-2 EVAL(ast(i), env) Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then ' eval false slot form If ast.size() > 3 Then orig_ast = ast(3) Else return Mal.types.Nil End If Else ' eval true slot form orig_ast = ast(2) End If Case "fn*" Dim fc As New FClosure() fc.ast = ast(2) fc.params = DirectCast(ast(1),MalLIst) fc.env = env Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn Dim mf As new MalFunc(ast(2), env, DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else Dim f As MalFunc = DirectCast(EVAL(a0, env), MalFunc) If f.isMacro() Then orig_ast = f.apply(ast.rest()) Continue Do End If Dim args As MalList = New MalList For i As Integer = 1 To ast.size()-1 args.conj_BANG(EVAL(ast(i), env)) Next Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast env = f.genEnv(args) Else Return f.apply(args) End If End Select Loop While True End Function ' print Shared Function PRINT(exp As MalVal) As String return printer._pr_str(exp, TRUE) End Function ' repl Shared repl_env As MalEnv Shared Function REP(str As String) As String Return PRINT(EVAL(READ(str), repl_env)) End Function Shared Function do_eval(args As MalList) As MalVal Return EVAL(args(0), repl_env) End Function Shared Function Main As Integer Dim args As String() = Environment.GetCommandLineArgs() repl_env = New MalEnv(Nothing) ' core.vb: defined using VB.NET For Each entry As KeyValuePair(Of String,MalVal) In core.ns() repl_env.do_set(new MalSymbol(entry.Key), entry.Value) Next repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) Dim fileIdx As Integer = 1 If args.Length > 1 AndAlso args(1) = "--raw" Then Mal.readline.SetMode(Mal.readline.Modes.Raw) fileIdx = 2 End If Dim argv As New MalList() For i As Integer = fileIdx+1 To args.Length-1 argv.conj_BANG(new MalString(args(i))) Next repl_env.do_set(new MalSymbol("*ARGV*"), argv) ' core.mal: defined using the language itself REP("(def! *host-language* ""VB.NET"")") REP("(def! not (fn* (a) (if a false true)))") REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))") REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") If args.Length > fileIdx Then REP("(load-file """ & args(fileIdx) & """)") return 0 End If ' repl loop Dim line As String REP("(println (str ""Mal ["" *host-language* ""]""))") Do Try line = Mal.readline.Readline("user> ") If line is Nothing Then Exit Do End If If line = "" Then Continue Do End If Catch e As IOException Console.WriteLine("IOException: " & e.Message) End Try Try Console.WriteLine(REP(line)) Catch e As Mal.types.MalException Console.WriteLine("Error: " & _ printer._pr_str(e.getValue(), False)) Continue Do Catch e As Exception Console.WriteLine("Error: " & e.Message) Console.WriteLine(e.StackTrace) Continue Do End Try Loop While True End function End Class End Namespace ================================================ FILE: impls/vb/tests/step5_tco.mal ================================================ ;; VB: skipping non-TCO recursion ;; Reason: unrecoverable segfault at 10,000 ================================================ FILE: impls/vb/types.vb ================================================ Imports System Imports System.Collections.Generic Imports System.Text.RegularExpressions Imports Mal namespace Mal Public Class types ' ' Exceptions/Errors ' Public Class MalThrowable Inherits Exception Public Sub New() MyBase.New() End Sub Public Sub New(msg As String) MyBase.New(msg) End Sub End Class Public Class MalError Inherits MalThrowable Public Sub New(msg As String) MyBase.New(msg) End Sub End Class Public Class MalContinue Inherits MalThrowable End Class ' Thrown by throw function Public Class MalException Inherits MalThrowable Private value As MalVal 'string Message Public Sub New(new_value As MalVal) value = new_value End Sub Public Sub New(new_value As String) MyBase.New(new_value) value = New MalString(new_value) End Sub Public Function getValue() As MalVal return value End Function End Class ' ' General functions ' Public Shared Function _equal_Q(a As MalVal, b As MalVal) As Boolean Dim ota As Type = a.GetType() Dim otb As Type = b.GetType() If not (ota = otb Or (TypeOf a Is MalList and TypeOf b Is MalList)) Then return False Else If TypeOf a Is MalInt Then return DirectCast(a,MalInt).getValue() = DirectCast(b,MalInt).getValue() Else If TypeOf a Is MalSymbol Then return DirectCast(a,MalSymbol).getName() = DirectCast(b,MalSymbol).getName() Else If TypeOf a Is MalString Then return DirectCast(a,MalString).getValue() = DirectCast(b,MalString).getValue() Else If TypeOf a Is MalList Then If DirectCast(a,MalList).size() <> DirectCast(b,MalList).size() return False End If for i As Integer = 0 To DirectCast(a,MalList).size()-1 If not _equal_Q(DirectCast(a,MalList)(i), DirectCast(b,MalList)(i)) return False End If Next return True Else If TypeOf a Is MalHashMap Then Dim ahm As Dictionary(Of String,MalVal) = DirectCast(a,MalHashMap).getValue() Dim bhm As Dictionary(Of String,MalVal) = DirectCast(b,MalHashMap).getValue() For Each key As String in ahm.keys If not bhm.ContainsKey(key) Then return False End If If not _equal_Q(DirectCast(a,MalHashMap).getValue()(key), DirectCast(b,MalHashMap).getValue()(key)) return False End If Next return True Else return a Is b End If End If End Function Public MustInherit Class MalVal Private meta As MalVal = Nil Public Overridable Function copy() As MalVal return DirectCast(Me.MemberwiseClone(),MalVal) End Function ' Default is just to call regular toString() Public Overridable Function ToString() As String throw New MalException("ToString called on abstract MalVal") End Function Public Overridable Function ToString(print_readably As Boolean) As String return Me.ToString() End Function Public Function getMeta() As MalVal return meta End Function Public Function setMeta(m As MalVal) As MalVal meta = m return Me End Function Public Overridable Function list_Q() As Boolean return False End Function End Class Public Class MalConstant Inherits MalVal Private value As String Public Sub New(name As String) value = name End Sub Public Shadows Function copy() As MalConstant return Me End Function Public Overrides Function ToString() As String return value End Function Public Overrides Function ToString(print_readably As Boolean) As String return value End Function End Class Public Shared Nil As MalConstant = New MalConstant("nil") Public Shared MalTrue As MalConstant = New MalConstant("true") Public Shared MalFalse As MalConstant = New MalConstant("false") Public Class MalInt Inherits MalVal Private value As Int64 Public Sub New(v As Int64) value = v End Sub Public Shadows Function copy() As MalInt return Me End Function Public Function getValue() As Int64 return value End Function Public Overrides Function ToString() As String return value.ToString() End Function Public Overrides Function ToString(print_readably As Boolean) As String return value.ToString() End Function Public Shared Operator <(a As MalInt, b As Malint) As MalConstant If a.getValue() < b.getValue() Then return MalTrue Else return MalFalse End If End Operator Public Shared Operator <=(a As MalInt, b As Malint) As MalConstant If a.getValue() <= b.getValue() Then return MalTrue Else return MalFalse End If End Operator Public Shared Operator >(a As MalInt, b As Malint) As MalConstant If a.getValue() > b.getValue() Then return MalTrue Else return MalFalse End If End Operator Public Shared Operator >=(a As MalInt, b As Malint) As MalConstant If a.getValue() >= b.getValue() Then return MalTrue Else return MalFalse End If End Operator Public Shared Operator +(a As MalInt, b As Malint) As MalInt return new MalInt(a.getValue() + b.getValue()) End Operator Public Shared Operator -(a As MalInt, b As Malint) As MalInt return new MalInt(a.getValue() - b.getValue()) End Operator Public Shared Operator *(a As MalInt, b As Malint) As MalInt return new MalInt(a.getValue() * b.getValue()) End Operator Public Shared Operator /(a As MalInt, b As Malint) As MalInt return new MalInt(a.getValue() / b.getValue()) End Operator End Class Public Class MalSymbol Inherits MalVal Private value As String Public Sub New(v As String) value = v End Sub Public Sub New(v As MalString) value = v.getValue() End Sub Public Shadows Function copy() As MalSymbol return Me End Function Public Function getName() As String return value End Function Public Overrides Function ToString() As String return value End Function Public Overrides Function ToString(print_readably As Boolean) As String return value End Function End Class Public Class MalString Inherits MalVal Private value As String Public Sub New(v As String) value = v End Sub Public Shadows Function copy() As MalString return Me End Function Public Function getValue() As String return value End Function Public Overrides Function ToString() As String return """" & value & """" End Function Public Overrides Function ToString(print_readably As Boolean) As String If value.Length > 0 AndAlso value(0) = ChrW(&H029e) Then return ":" & value.Substring(1) Else If print_readably Then return """" & _ value.Replace("\", "\\") _ .Replace("""", "\""") _ .Replace(Environment.NewLine, "\n") & _ """" Else return value End If End Function End Class Public Class MalList Inherits MalVal Public start As String = "(" Public last As String = ")" Private value As List(Of MalVal) Public Sub New() value = New List(Of MalVal) End Sub Public Sub New(val As List(Of MalVal)) value = val End Sub Public Sub New(ParamArray mvs() As MalVal) value = New List(Of MalVal) conj_BANG(mvs) End Sub Public Function getValue() As List(Of MalVal) return value End Function Public Overrides Function list_Q() As Boolean return True End Function Public Overrides Function ToString() As String return start & printer.join(value, " ", true) & last End Function Public Overrides Function ToString(print_readably As Boolean) As String return start & printer.join(value, " ", print_readably) & last End Function Public Function conj_BANG(ParamArray mvs() As MalVal) As MalList For i As Integer = 0 To mvs.Length-1 value.Add(mvs(i)) Next return Me End Function Public Function size() As Int64 return value.Count End Function Public Function nth(ByVal idx As Integer) As MalVal If value.Count > idx Then return value(idx) Else return Nil End If End Function Default Public ReadOnly Property Item(idx As Integer) As MalVal Get If value.Count > idx then return value(idx) Else return Nil End If End Get End Property Public Function rest() As MalList If size() > 0 Then return New MalList(value.GetRange(1, value.Count-1)) Else return New MalList() End If End Function Public Overridable Function slice(start As Int64) As MalList return New MalList(value.GetRange(start, value.Count-start)) End Function Public Overridable Function slice(start As Int64, last As Int64) As MalList return New MalList(value.GetRange(start, last-start)) End Function End Class Public Class MalVector Inherits MalList ' ' Same implementation except for instantiation methods Public Sub New() MyBase.New() start = "[" last = "]" End Sub Public Sub New(val As List(Of MalVal)) MyBase.New(val) start = "[" last = "]" End Sub Public Overrides Function list_Q() As Boolean return False End Function Public Overrides Function slice(start As Int64, last As Int64) As MalList Dim val As List(Of MalVal) = Me.getValue() return New MalVector(val.GetRange(start, val.Count-start)) End Function End Class Public Class MalHashMap Inherits MalVal Private value As Dictionary(Of string, MalVal) Public Sub New(val As Dictionary(Of String, MalVal)) value = val End Sub Public Sub New(lst As MalList) value = New Dictionary(Of String, MalVal) assoc_BANG(lst) End Sub Public Shadows Function copy() As MalHashMap Dim new_self As MalHashMap = DirectCast(Me.MemberwiseClone(),MalHashMap) new_self.value = New Dictionary(Of String, MalVal)(value) return new_self End Function Public Function getValue() As Dictionary(Of String, MalVal) return value End Function Public Overrides Function ToString() As String return "{" & printer.join(value, " ", true) & "}" End Function Public Overrides Function ToString(print_readably As Boolean) As String return "{" & printer.join(value, " ", print_readably) & "}" End Function Public Function assoc_BANG(lst As MalList) As MalHashMap For i As Integer = 0 To lst.size()-1 Step 2 value(DirectCast(lst(i),MalString).getValue()) = lst(i+1) Next return Me End Function Public Function dissoc_BANG(lst As MalList) As MalHashMap for i As Integer = 0 To lst.size()-1 value.Remove(DirectCast(lst.nth(i),MalString).getValue()) Next return Me End Function End Class Public Class MalAtom Inherits MalVal Private value As MalVal Public Sub New(val As MalVal) value = val End Sub 'Public MalAtom copy() { return New MalAtom(value) } Public Function getValue() As MalVal return value End Function Public Function setValue(val As MalVal) As MalVal value = val return value End Function Public Overrides Function ToString() As String return "(atom " & printer._pr_str(value, true) & ")" End Function Public Overrides Function ToString(print_readably As Boolean) As String return "(atom " & printer._pr_str(value, print_readably) & ")" End Function End Class Public Class MalFunc Inherits MalVal Private fn As Func(Of MalList, MalVal) = Nothing Private ast As MalVal = Nothing Private env As Mal.env.Env = Nothing Private fparams As MalList Private macro As Boolean = False Public Sub New(new_fn As Func(Of MalList, MalVal)) fn = new_fn End Sub Public Sub New(new_ast As MalVal, new_env As Mal.env.Env, new_fparams As MalList, new_fn As Func(Of MalList, MalVal)) fn = new_fn ast = new_ast env = new_env fparams = new_fparams End Sub Public Overrides Function ToString() As String If Not ast Is Nothing Then return "" Else return "" End If End Function Public Function apply(args As MalList) As MalVal return fn(args) End Function Public Function getAst() As MalVal return ast End Function Public Function getEnv() As Mal.env.Env return env End Function Public Function getFParams() As MalList return fparams End Function Public Function genEnv(args As MalList) As Mal.env.Env return New Mal.env.Env(env, fparams, args) End Function Public Function isMacro() As Boolean return macro End Function Public Function asMacro() As MalVal Dim res As new MalFunc (ast, env, fparams, fn) res.macro = true return res End Function End Class End Class End Namespace ================================================ FILE: impls/vbs/Makefile ================================================ all: true clean: ================================================ FILE: impls/vbs/core.vbs ================================================ Option Explicit Sub CheckArgNum(objArgs, lngArgNum) If objArgs.Count - 1 <> lngArgNum Then Err.Raise vbObjectError, _ "CheckArgNum", "Wrong number of arguments." End IF End Sub Sub CheckType(objMal, varType) If objMal.Type <> varType Then Err.Raise vbObjectError, _ "CheckType", "Wrong argument type." End IF End Sub Function IsListOrVec(objMal) IsListOrVec = _ objMal.Type = TYPES.LIST Or _ objMal.Type = TYPES.VECTOR End Function Sub CheckListOrVec(objMal) If Not IsListOrVec(objMal) Then Err.Raise vbObjectError, _ "CheckListOrVec", _ "Wrong argument type, need a list or a vector." End If End Sub Dim objNS Set objNS = NewEnv(Nothing) Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MAdd = NewMalNum( _ objArgs.Item(1).Value + objArgs.Item(2).Value) End Function objNS.Add "+", NewVbsProc("MAdd", False) Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MSub = NewMalNum( _ objArgs.Item(1).Value - objArgs.Item(2).Value) End Function objNS.Add "-", NewVbsProc("MSub", False) Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MMul = NewMalNum( _ objArgs.Item(1).Value * objArgs.Item(2).Value) End Function objNS.Add "*", NewVbsProc("MMul", False) Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MDiv = NewMalNum( _ objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function objNS.Add "/", NewVbsProc("MDiv", False) Function MList(objArgs, objEnv) Dim varRet Set varRet = NewMalList(Array()) Dim i For i = 1 To objArgs.Count - 1 varRet.Add objArgs.Item(i) Next Set MList = varRet End Function objNS.Add "list", NewVbsProc("MList", False) Function MIsList(objArgs, objEnv) CheckArgNum objArgs, 1 Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST) End Function objNS.Add "list?", NewVbsProc("MIsList", False) Function MIsEmpty(objArgs, objEnv) CheckArgNum objArgs, 1 CheckListOrVec objArgs.Item(1) Set MIsEmpty = NewMalBool(objArgs.Item(1).Count = 0) End Function objNS.Add "empty?", NewVbsProc("MIsEmpty", False) Function MCount(objArgs, objEnv) CheckArgNum objArgs, 1 If objArgs.Item(1).Type = TYPES.NIL Then Set MCount = NewMalNum(0) Else CheckListOrVec objArgs.Item(1) Set MCount = NewMalNum(objArgs.Item(1).Count) End If End Function objNS.Add "count", NewVbsProc("MCount", False) Function MEqual(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim boolResult, i If IsListOrVec(objArgs.Item(1)) And _ IsListOrVec(objArgs.Item(2)) Then If objArgs.Item(1).Count <> objArgs.Item(2).Count Then Set varRet = NewMalBool(False) Else boolResult = True For i = 0 To objArgs.Item(1).Count - 1 boolResult = boolResult And _ MEqual(NewMalList(Array(Nothing, _ objArgs.Item(1).Item(i), _ objArgs.Item(2).Item(i))), objEnv).Value Next Set varRet = NewMalBool(boolResult) End If Else If objArgs.Item(1).Type <> objArgs.Item(2).Type Then Set varRet = NewMalBool(False) Else Select Case objArgs.Item(1).Type Case TYPES.HASHMAP 'Err.Raise vbObjectError, _ ' "MEqual", "Not implement yet~" If UBound(objArgs.Item(1).Keys) <> UBound(objArgs.Item(2).Keys) Then Set varRet = NewMalBool(False) Set MEqual = varRet Exit Function End If boolResult = True For Each i In objArgs.Item(1).Keys If Not objArgs.Item(2).Exists(i) Then Set varRet = NewMalBool(False) Set MEqual = varRet Exit Function End If boolResult = boolResult And _ MEqual(NewMalList(Array(Nothing, objArgs.Item(1).Item(i), objArgs.Item(2).Item(i))), objEnv).Value Next Set varRet = NewMalBool(boolResult) Case Else Set varRet = NewMalBool( _ objArgs.Item(1).Value = objArgs.Item(2).Value) End Select End If End If Set MEqual = varRet End Function objNS.Add "=", NewVbsProc("MEqual", False) Function MGreater(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set varRet = NewMalBool( _ objArgs.Item(1).Value > objArgs.Item(2).Value) Set MGreater = varRet End Function objNS.Add ">", NewVbsProc("MGreater", False) Function MPrStr(objArgs, objEnv) Dim varRet Dim strRet strRet = "" Dim i If objArgs.Count - 1 >= 1 Then strRet = PrintMalType(objArgs.Item(1), True) End If For i = 2 To objArgs.Count - 1 strRet = strRet + " " + _ PrintMalType(objArgs.Item(i), True) Next Set varRet = NewMalStr(strRet) Set MPrStr = varRet End Function objNS.Add "pr-str", NewVbsProc("MPrStr", False) Function MStr(objArgs, objEnv) Dim varRet Dim strRet strRet = "" Dim i For i = 1 To objArgs.Count - 1 strRet = strRet + _ PrintMalType(objArgs.Item(i), False) Next Set varRet = NewMalStr(strRet) Set MStr = varRet End Function objNS.Add "str", NewVbsProc("MStr", False) Function MPrn(objArgs, objEnv) Dim varRet Dim objStr Set objStr = MPrStr(objArgs, objEnv) IO.WriteLine objStr.Value Set varRet = NewMalNil() Set MPrn = varRet End Function objNS.Add "prn", NewVbsProc("MPrn", False) Function MPrintln(objArgs, objEnv) Dim varRet Dim strRes strRes = "" Dim i If objArgs.Count - 1 >= 1 Then strRes = PrintMalType(objArgs.Item(1), False) End If For i = 2 To objArgs.Count - 1 strRes = strRes + " " + _ PrintMalType(objArgs.Item(i), False) Next IO.WriteLine strRes Set varRet = NewMalNil() Set MPrintln = varRet End Function objNS.Add "println", NewVbsProc("MPrintln", False) Sub InitBuiltIn() REP "(def! not (fn* [bool] (if bool false true)))" REP "(def! <= (fn* [a b] (not (> a b))))" REP "(def! < (fn* [a b] (> b a)))" REP "(def! >= (fn* [a b] (not (> b a))))" REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" REP "(def! cons (fn* [a b] (concat (list a) b)))" REP "(def! nil? (fn* [x] (= x nil)))" REP "(def! true? (fn* [x] (= x true)))" REP "(def! false? (fn* [x] (= x false)))" REP "(def! vector (fn* [& args] (vec args)))" REP "(def! vals (fn* [hmap] (map (fn* [key] (get hmap key)) (keys hmap))))" REP "(def! *host-language* ""VBScript"")" End Sub Function MReadStr(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING Set varRes = ReadString(objArgs.Item(1).Value) If TypeName(varRes) = "Nothing" Then Set varRes = NewMalNil() End If Set MReadStr = varRes End Function objNS.Add "read-string", NewVbsProc("MReadStr", False) Function MSlurp(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING Dim strRes With CreateObject("Scripting.FileSystemObject") strRes = .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & objArgs.Item(1).Value).ReadAll End With Set varRes = NewMalStr(strRes) Set MSlurp = varRes End Function objNS.Add "slurp", NewVbsProc("MSlurp", False) Function MAtom(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalAtom(objArgs.Item(1)) Set MAtom = varRes End Function objNS.Add "atom", NewVbsProc("MAtom", False) Function MIsAtom(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.ATOM) Set MIsAtom = varRes End Function objNS.Add "atom?", NewVbsProc("MIsAtom", False) Function MDeref(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.ATOM Set varRes = objArgs.Item(1).Value Set MDeref = varRes End Function objNS.Add "deref", NewVbsProc("MDeref", False) Function MReset(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.ATOM objArgs.Item(1).Reset objArgs.Item(2) Set varRes = objArgs.Item(2) Set MReset = varRes End Function objNS.Add "reset!", NewVbsProc("MReset", False) Function MSwap(objArgs, objEnv) Dim varRes If objArgs.Count - 1 < 2 Then Err.Raise vbObjectError, _ "MSwap", "Need more arguments." End If Dim objAtom, objFn Set objAtom = objArgs.Item(1) CheckType objAtom, TYPES.ATOM Set objFn = objArgs.Item(2) CheckType objFn, TYPES.PROCEDURE Dim objProg Set objProg = NewMalList(Array(objFn)) objProg.Add objAtom.Value Dim i For i = 3 To objArgs.Count - 1 objProg.Add objArgs.Item(i) Next objAtom.Reset objFn.ApplyWithoutEval(objProg, objEnv) Set varRes = objAtom.Value Set MSwap = varRes End Function objNS.Add "swap!", NewVbsProc("MSwap", False) Function MConcat(objArgs, objEnv) Dim varRes Dim i, j Set varRes = NewMalList(Array()) For i = 1 To objArgs.Count - 1 If Not IsListOrVec(objArgs.Item(i)) Then Err.Raise vbObjectError, _ "MConcat", "Invaild argument(s)." End If For j = 0 To objArgs.Item(i).Count - 1 varRes.Add objArgs.Item(i).Item(j) Next Next Set MConcat = varRes End Function objNS.Add "concat", NewVbsProc("MConcat", False) Function MVec(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckListOrVec objArgs.Item(1) Set varRes = NewMalVec(Array()) Dim i For i = 0 To objArgs.Item(1).Count - 1 varRes.Add objArgs.Item(1).Item(i) Next Set MVec = varRes End Function objNS.Add "vec", NewVbsProc("MVec", False) Function MNth(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 2 CheckListOrVec objArgs.Item(1) CheckType objArgs.Item(2), TYPES.NUMBER If objArgs.Item(2).Value < objArgs.Item(1).Count Then Set varRes = objArgs.Item(1).Item(objArgs.Item(2).Value) Else Err.Raise vbObjectError, _ "MNth", "Index out of bounds." End If Set MNth = varRes End Function objNS.Add "nth", NewVbsProc("MNth", False) Function MFirst(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 If objArgs.Item(1).Type = TYPES.NIL Then Set varRes = NewMalNil() Set MFirst = varRes Exit Function End If CheckListOrVec objArgs.Item(1) If objArgs.Item(1).Count < 1 Then Set varRes = NewMalNil() Else Set varRes = objArgs.Item(1).Item(0) End If Set MFirst = varRes End Function objNS.Add "first", NewVbsProc("MFirst", False) Function MRest(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 If objArgs.Item(1).Type = TYPES.NIL Then Set varRes = NewMalList(Array()) Set MRest = varRes Exit Function End If Dim objList Set objList = objArgs.Item(1) CheckListOrVec objList Set varRes = NewMalList(Array()) Dim i For i = 1 To objList.Count - 1 varRes.Add objList.Item(i) Next Set MRest = varRes End Function objNS.Add "rest", NewVbsProc("MRest", False) Sub InitMacro() REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons'cond (rest (rest xs)))))))" 'REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" REP "(def! *gensym-counter* (atom 0))" REP "(def! gensym (fn* [] (symbol (str ""G__"" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" End Sub Class MalException Private objDict Private Sub Class_Initialize Set objDict = CreateObject("Scripting.Dictionary") End Sub Public Sub Add(varKey, varValue) objDict.Add varKey, varValue End Sub Public Function Item(varKey) Set Item = objDict.Item(varKey) End Function Public Sub Remove(varKey) objDict.Remove varKey End Sub End Class Dim objExceptions Set objExceptions = New MalException Function MThrow(objArgs, objEnv) CheckArgNum objArgs, 1 Dim strRnd strRnd = CStr(Rnd()) objExceptions.Add strRnd, objArgs.Item(1) Err.Raise vbObjectError, _ "MThrow", strRnd End Function objNS.Add "throw", NewVbsProc("MThrow", False) Function MApply(objArgs, objEnv) Dim varRes If objArgs.Count - 1 < 2 Then Err.Raise vbObjectError, _ "MApply", "Need more arguments." End If Dim objFn Set objFn = objArgs.Item(1) CheckType objFn, TYPES.PROCEDURE ' If objFn.IsSpecial Or objFn.IsMacro Then ' Err.Raise vbObjectError, _ ' "MApply", "Need a function." ' End If Dim objAST Set objAST = NewMalList(Array(objFn)) Dim i For i = 2 To objArgs.Count - 2 objAST.Add objArgs.Item(i) Next Dim objSeq Set objSeq = objArgs.Item(objArgs.Count - 1) CheckListOrVec objSeq For i = 0 To objSeq.Count - 1 objAST.Add objSeq.Item(i) Next Set varRes = objFn.ApplyWithoutEval(objAST, objEnv) Set MApply = varRes End Function objNS.Add "apply", NewVbsProc("MApply", False) Function MMap(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 2 Dim objFn, objSeq Set objFn = objArgs.Item(1) Set objSeq = objArgs.Item(2) CheckType objFn, TYPES.PROCEDURE CheckListOrVec objSeq If objFn.IsSpecial Or objFn.IsMacro Then Err.Raise vbObjectError, _ "MApply", "Need a function." End If Set varRes = NewMalList(Array()) Dim i For i = 0 To objSeq.Count - 1 varRes.Add objFn.ApplyWithoutEval(NewMalList(Array( _ objFn, objSeq.Item(i))), objEnv) Next Set MMap = varRes End Function objNS.Add "map", NewVbsProc("MMap", False) Function MIsSymbol(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.SYMBOL) Set MIsSymbol = varRes End Function objNS.Add "symbol?", NewVbsProc("MIsSymbol", False) Function MSymbol(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING Set varRes = NewMalSym(objArgs.Item(1).Value) Set MSymbol = varRes End Function objNS.Add "symbol", NewVbsProc("MSymbol", False) Function MKeyword(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Select Case objArgs.Item(1).Type Case TYPES.STRING Set varRes = NewMalKwd(":" + objArgs.Item(1).Value) Case TYPES.KEYWORD Set varRes = objArgs.Item(1) Case Else Err.Raise vbObjectError, _ "MKeyword", "Unexpect argument(s)." End Select Set MKeyword = varRes End Function objNS.Add "keyword", NewVbsProc("MKeyword", False) Function MIsKeyword(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.KEYWORD) Set MIsKeyword = varRes End Function objNS.Add "keyword?", NewVbsProc("MIsKeyword", False) Function MIsSeq(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool( _ objArgs.Item(1).Type = TYPES.LIST Or _ objArgs.Item(1).Type = TYPES.VECTOR) Set MIsSeq = varRes End Function objNS.Add "sequential?", NewVbsProc("MIsSeq", False) Function MIsVec(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.VECTOR) Set MIsVec = varRes End Function objNS.Add "vector?", NewVbsProc("MIsVec", False) Function MIsMap(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.HASHMAP) Set MIsMap = varRes End Function objNS.Add "map?", NewVbsProc("MIsMap", False) Function MHashMap(objArgs, objEnv) Dim varRes If objArgs.Count Mod 2 <> 1 Then Err.Raise vbObjectError, _ "MHashMap", "Unexpect argument(s)." End If Set varRes = NewMalMap(Array(), Array()) Dim i For i = 1 To objArgs.Count - 1 Step 2 varRes.Add objArgs.Item(i), objArgs.Item(i + 1) Next Set MHashMap = varRes End Function objNS.Add "hash-map", NewVbsProc("MHashMap", False) Function MAssoc(objArgs, objEnv) Dim varRes If objArgs.Count - 1 < 3 Or objArgs.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MHashMap", "Unexpect argument(s)." End If Dim objMap Set objMap = objArgs.Item(1) CheckType objMap, TYPES.HASHMAP Dim i Set varRes = NewMalMap(Array(), Array()) For Each i In objMap.Keys varRes.Add i, objMap.Item(i) Next For i = 2 To objArgs.Count - 1 Step 2 varRes.Add objArgs.Item(i), objArgs.Item(i + 1) Next Set MAssoc = varRes End Function objNS.Add "assoc", NewVbsProc("MAssoc", False) Function MGet(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 2 If objArgs.Item(1).Type = TYPES.NIL Then Set varRes = NewMalNil() Else CheckType objArgs.Item(1), TYPES.HASHMAP If objArgs.Item(1).Exists(objArgs.Item(2)) Then Set varRes = objArgs.Item(1).Item(objArgs.Item(2)) Else Set varRes = NewMalNil() End If End If Set MGet = varRes End Function objNS.Add "get", NewVbsProc("MGet", False) Function MDissoc(objArgs, objEnv) Dim varRes 'CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.HASHMAP If objArgs.Item(1).Exists(objArgs.Item(2)) Then Set varRes = NewMalMap(Array(), Array()) Dim i Dim j, boolFlag For Each i In objArgs.Item(1).Keys boolFlag = True For j = 2 To objArgs.Count - 1 If i.Type = objArgs.Item(j).Type And _ i.Value = objArgs.Item(j).Value Then boolFlag = False End If Next If boolFlag Then varRes.Add i, objArgs.Item(1).Item(i) End If Next Else Set varRes = objArgs.Item(1) End If Set MDissoc = varRes End Function objNS.Add "dissoc", NewVbsProc("MDissoc", False) Function MKeys(objArgs, objEnv) CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.HASHMAP Set MKeys = NewMalList(objArgs.Item(1).Keys) End Function objNS.Add "keys", NewVbsProc("MKeys", False) Function MIsContains(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.HASHMAP Set MIsContains = NewMalBool(objArgs.Item(1).Exists(objArgs.Item(2))) End Function objNS.Add "contains?", NewVbsProc("MIsContains", False) Function MReadLine(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING Dim strInput IO.Write objArgs.Item(1).Value On Error Resume Next strInput = IO.ReadLine If Err.Number <> 0 Then Set varRes = NewMalNil() Else Set varRes = NewMalStr(strInput) End If On Error Goto 0 Set MReadLine = varRes End Function objNS.Add "readline", NewVbsProc("MReadLine", False) Function MTimeMs(objArgs, objEnv) Set MTimeMs = NewMalNum(CLng(Timer * 1000)) End Function objNS.Add "time-ms", NewVbsProc("MTimeMs", False) Function MIsStr(objArgs, objEnv) CheckArgNum objArgs, 1 Set MIsStr = NewMalBool(objArgs.Item(1).Type = TYPES.STRING) End Function objNS.Add "string?", NewVbsProc("MIsStr", False) Function MIsNum(objArgs, objEnv) CheckArgNum objArgs, 1 Set MIsNum = NewMalBool(objArgs.Item(1).Type = TYPES.NUMBER) End Function objNS.Add "number?", NewVbsProc("MIsNum", False) Function MIsFn(objArgs, objEnv) CheckArgNum objArgs, 1 Dim varRes varRes = objArgs.Item(1).Type = TYPES.PROCEDURE If varRes Then varRes = (Not objArgs.Item(1).IsMacro) And _ (Not objArgs.Item(1).IsSpecial) End If Set MIsFn = NewMalBool(varRes) End Function objNS.Add "fn?", NewVbsProc("MIsFn", False) Function MIsMacro(objArgs, objEnv) CheckArgNum objArgs, 1 Dim varRes varRes = objArgs.Item(1).Type = TYPES.PROCEDURE If varRes Then varRes = objArgs.Item(1).IsMacro And _ (Not objArgs.Item(1).IsSpecial) End If Set MIsMacro = NewMalBool(varRes) End Function objNS.Add "macro?", NewVbsProc("MIsMacro", False) Function MMeta(objArgs, objEnv) CheckArgNum objArgs, 1 'CheckType objArgs.Item(1), TYPES.PROCEDURE Dim varRes Set varRes = GetMeta(objArgs.Item(1)) Set MMeta = varRes End Function objNS.Add "meta", NewVbsProc("MMeta", False) Function MWithMeta(objArgs, objEnv) CheckArgNum objArgs, 2 'CheckType objArgs.Item(1), TYPES.PROCEDURE Dim varRes Set varRes = SetMeta(objArgs.Item(1), objArgs.Item(2)) Set MWithMeta = varRes End Function objNS.Add "with-meta", NewVbsProc("MWithMeta", False) Function MConj(objArgs, objEnv) If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MConj", "Need more arguments." End If Dim varRes Dim objSeq Set objSeq = objArgs.Item(1) Dim i Select Case objSeq.Type Case TYPES.LIST Set varRes = NewMalList(Array()) For i = objArgs.Count - 1 To 2 Step -1 varRes.Add objArgs.Item(i) Next For i = 0 To objSeq.Count - 1 varRes.Add objSeq.Item(i) Next Case TYPES.VECTOR Set varRes = NewMalVec(Array()) For i = 0 To objSeq.Count - 1 varRes.Add objSeq.Item(i) Next For i = 2 To objArgs.Count - 1 varRes.Add objArgs.Item(i) Next Case Else Err.Raise vbObjectError, _ "MConj", "Unexpect argument type." End Select Set MConj = varRes End Function objNS.Add "conj", NewVbsProc("MConj", False) Function MSeq(objArgs, objEnv) CheckArgNum objArgs, 1 Dim objSeq Set objSeq = objArgs.Item(1) Dim varRes Dim i Select Case objSeq.Type Case TYPES.STRING If objSeq.Value = "" Then Set varRes = NewMalNil() Else Set varRes = NewMalList(Array()) For i = 1 To Len(objSeq.Value) varRes.Add NewMalStr(Mid(objSeq.Value, i, 1)) Next End If Case TYPES.LIST If objSeq.Count = 0 Then Set varRes = NewMalNil() Else Set varRes = objSeq End If Case TYPES.VECTOR If objSeq.Count = 0 Then Set varRes = NewMalNil() Else Set varRes = NewMalList(Array()) For i = 0 To objSeq.Count - 1 varRes.Add objSeq.Item(i) Next End If Case TYPES.NIL Set varRes = NewMalNil() Case Else Err.Raise vbObjectError, _ "MSeq", "Unexpect argument type." End Select Set MSeq = varRes End Function objNS.Add "seq", NewVbsProc("MSeq", False) ================================================ FILE: impls/vbs/env.vbs ================================================ Option Explicit Function NewEnv(objOuter) Set NewEnv = New Environment Set NewEnv.Outer = objOuter End Function Class Environment Public objOuter Public objBinds Private Sub Class_Initialize() Set objBinds = CreateObject("Scripting.Dictionary") Set objOuter = Nothing End Sub Public Property Set Outer(objEnv) Set objOuter = objEnv End Property Public Sub Add(varKey, varValue) Set objBinds.Item(varKey) = varValue End Sub Public Function [Get](varKey) Dim objEnv, varRet Set objEnv = Me Do If objEnv.objBinds.Exists(varKey) Then Set varRet = objEnv.objBinds(varKey) Exit Do End If Set objEnv = objEnv.objOuter If TypeName(objEnv) = "Nothing" Then Set varRet = Nothing Exit Do End If Loop Set [Get] = varRet End Function End Class ================================================ FILE: impls/vbs/install.vbs ================================================ On Error Resume Next CreateObject("System.Collections.ArrayList") ================================================ FILE: impls/vbs/io.vbs ================================================ Option Explicit Class IOWrap Public NoStdErr Public EchoStdIn Private Sub Class_Initialize With WScript.CreateObject("WScript.Shell") NoStdErr = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_NO_STDERR%") <> "%MAL_VBS_IMPL_NO_STDERR%" EchoStdIn = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_ECHO_STDIN%") <> "%MAL_VBS_IMPL_ECHO_STDIN%" End With End Sub Public Sub Write(sText) WScript.StdOut.Write sText End Sub Public Sub WriteLine(sText) WScript.StdOut.WriteLine sText End Sub Public Function ReadLine() ReadLine = WScript.StdIn.ReadLine If EchoStdIn Then WScript.StdOut.WriteLine ReadLine End If End Function Public Sub WriteErr(sText) If Not NoStdErr Then WScript.StdErr.Write sText Else ' Redirect to StdOut WScript.StdOut.Write sText End If End Sub Public Sub WriteErrLine(sText) If Not NoStdErr Then WScript.StdErr.WriteLine sText Else ' Redirect to StdOut WScript.StdOut.WriteLine sText End If End Sub End Class Dim IO Set IO = New IOWrap ================================================ FILE: impls/vbs/printer.vbs ================================================ Option Explicit Function PrintMalType(objMal, boolReadable) Dim varResult varResult = "" If TypeName(objMal) = "Nothing" Then PrintMalType = "" Exit Function End If Dim i Select Case objMal.Type Case TYPES.LIST With objMal For i = 0 To .Count - 2 varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " Next If .Count > 0 Then varResult = varResult & _ PrintMalType(.Item(.Count - 1), boolReadable) End If End With varResult = "(" & varResult & ")" Case TYPES.VECTOR With objMal For i = 0 To .Count - 2 varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " Next If .Count > 0 Then varResult = varResult & _ PrintMalType(.Item(.Count - 1), boolReadable) End If End With varResult = "[" & varResult & "]" Case TYPES.HASHMAP With objMal Dim arrKeys arrKeys = .Keys For i = 0 To .Count - 2 varResult = varResult & _ PrintMalType(arrKeys(i), boolReadable) & " " & _ PrintMalType(.Item(arrKeys(i)), boolReadable) & " " Next If .Count > 0 Then varResult = varResult & _ PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _ PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable) End If End With varResult = "{" & varResult & "}" Case TYPES.STRING If boolReadable Then varResult = EscapeString(objMal.Value) Else varResult = objMal.Value End If Case TYPES.BOOLEAN If objMal.Value Then varResult = "true" Else varResult = "false" End If Case TYPES.NIL varResult = "nil" Case TYPES.NUMBER varResult = CStr(objMal.Value) Case TYPES.PROCEDURE varResult = "#" Case TYPES.KEYWORD varResult = objMal.Value Case TYPES.SYMBOL varResult = objMal.Value Case TYPES.ATOM varResult = "(atom " + PrintMalType(objMal.Value, boolReadable) + ")" Case Else Err.Raise vbObjectError, _ "PrintMalType", "Unknown type." End Select PrintMalType = varResult End Function Function EscapeString(strRaw) EscapeString = strRaw EscapeString = Replace(EscapeString, "\", "\\") EscapeString = Replace(EscapeString, vbCrLf, vbLf) EscapeString = Replace(EscapeString, vbCr, vbLf) EscapeString = Replace(EscapeString, vbLf, "\n") EscapeString = Replace(EscapeString, """", "\""") EscapeString = """" & EscapeString & """" End Function ================================================ FILE: impls/vbs/reader.vbs ================================================ Option Explicit Function ReadString(strCode) Dim objTokens Set objTokens = Tokenize(strCode) Set ReadString = ReadForm(objTokens) If Not objTokens.AtEnd() Then Err.Raise vbObjectError, _ "ReadForm", "extra token '" + objTokens.Current() + "'." End If End Function Class Tokens Private objQueue Private objRE Private Sub Class_Initialize Set objRE = New RegExp With objRE .Pattern = "[\s,]*" + _ "(" + _ "~@" + "|" + _ "[\[\]{}()'`~^@]" + "|" + _ """(?:\\.|[^\\""])*""?" + "|" + _ ";.*" + "|" + _ "[^\s\[\]{}('""`,;)]*" + _ ")" .IgnoreCase = True .Global = True End With Set objQueue = CreateObject("System.Collections.Queue") End Sub Public Function Init(strCode) Dim objMatches, objMatch Set objMatches = objRE.Execute(strCode) Dim strToken For Each objMatch In objMatches strToken = Trim(objMatch.SubMatches(0)) If Not (Left(strToken, 1) = ";" Or strToken = "") Then objQueue.Enqueue strToken End If Next End Function Public Function Current() Current = objQueue.Peek() End Function Public Function MoveToNext() MoveToNext = objQueue.Dequeue() End Function Public Function AtEnd() AtEnd = (objQueue.Count = 0) End Function Public Function Count() Count = objQueue.Count End Function End Class Function Tokenize(strCode) ' Return objTokens Dim varResult Set varResult = New Tokens varResult.Init strCode Set Tokenize = varResult End Function Function ReadForm(objTokens) ' Return Nothing / MalType If objTokens.AtEnd() Then Set ReadForm = Nothing Exit Function End If Dim strToken strToken = objTokens.Current() Dim varResult If InStr("([{", strToken) Then Select Case strToken Case "(" Set varResult = ReadList(objTokens) Case "[" Set varResult = ReadVector(objTokens) Case "{" Set varResult = ReadHashmap(objTokens) End Select ElseIf InStr("'`~@", strToken) Then Set varResult = ReadSpecial(objTokens) ElseIf InStr(")]}", strToken) Then Err.Raise vbObjectError, _ "ReadForm", "unbalanced parentheses." ElseIf strToken = "^" Then Set varResult = ReadMetadata(objTokens) Else Set varResult = ReadAtom(objTokens) End If Set ReadForm = varResult End Function Function ReadMetadata(objTokens) Dim varResult Call objTokens.MoveToNext() Dim objTemp Set objTemp = ReadForm(objTokens) Set varResult = NewMalList(Array( _ NewMalSym("with-meta"), _ ReadForm(objTokens), objTemp)) Set ReadMetadata = varResult End Function Function ReadSpecial(objTokens) Dim varResult Dim strToken, strAlias strToken = objTokens.Current() Select Case strToken Case "'" strAlias = "quote" Case "`" strAlias = "quasiquote" Case "~" strAlias = "unquote" Case "~@" strAlias = "splice-unquote" Case "@" strAlias = "deref" Case Else Err.Raise vbObjectError, _ "ReadSpecial", "unknown token '" & strAlias & "'." End Select Call objTokens.MoveToNext() Set varResult = NewMalList(Array( _ NewMalSym(strAlias), _ ReadForm(objTokens))) Set ReadSpecial = varResult End Function Function ReadList(objTokens) Dim varResult Call objTokens.MoveToNext() If objTokens.AtEnd() Then Err.Raise vbObjectError, _ "ReadList", "unbalanced parentheses." End If Set varResult = NewMalList(Array()) With varResult While objTokens.Count() > 1 And objTokens.Current() <> ")" .Add ReadForm(objTokens) Wend End With If objTokens.MoveToNext() <> ")" Then Err.Raise vbObjectError, _ "ReadList", "unbalanced parentheses." End If Set ReadList = varResult End Function Function ReadVector(objTokens) Dim varResult Call objTokens.MoveToNext() If objTokens.AtEnd() Then Err.Raise vbObjectError, _ "ReadVector", "unbalanced parentheses." End If Set varResult = NewMalVec(Array()) With varResult While objTokens.Count() > 1 And objTokens.Current() <> "]" .Add ReadForm(objTokens) Wend End With If objTokens.MoveToNext() <> "]" Then Err.Raise vbObjectError, _ "ReadVector", "unbalanced parentheses." End If Set ReadVector = varResult End Function Function ReadHashmap(objTokens) Dim varResult Call objTokens.MoveToNext() If objTokens.Count = 0 Then Err.Raise vbObjectError, _ "ReadHashmap", "unbalanced parentheses." End If Set varResult = NewMalMap(Array(), Array()) Dim objKey, objValue With varResult While objTokens.Count > 2 And objTokens.Current() <> "}" Set objKey = ReadForm(objTokens) Set objValue = ReadForm(objTokens) .Add objKey, objValue Wend End With If objTokens.MoveToNext() <> "}" Then Err.Raise vbObjectError, _ "ReadHashmap", "unbalanced parentheses." End If Set ReadHashmap = varResult End Function Function ReadAtom(objTokens) Dim varResult Dim strAtom strAtom = objTokens.MoveToNext() Select Case strAtom Case "true" Set varResult = NewMalBool(True) Case "false" Set varResult = NewMalBool(False) Case "nil" Set varResult = NewMalNil() Case Else Select Case Left(strAtom, 1) Case ":" Set varResult = NewMalKwd(strAtom) Case """" Set varResult = NewMalStr(ParseString(strAtom)) Case Else If IsNumeric(strAtom) Then Set varResult = NewMalNum(Eval(strAtom)) Else Set varResult = NewMalSym(strAtom) End If End Select End Select Set ReadAtom = varResult End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then Err.Raise vbObjectError, _ "ParseString", "unterminated string, got EOF." End If Dim strTemp strTemp = Mid(strRaw, 2, Len(strRaw) - 2) Dim i i = 1 ParseString = "" While i <= Len(strTemp) - 1 Select Case Mid(strTemp, i, 2) Case "\\" ParseString = ParseString & "\" Case "\n" ParseString = ParseString & vbCrLf Case "\""" ParseString = ParseString & """" Case Else ParseString = ParseString & Mid(strTemp, i, 1) i = i - 1 End Select i = i + 2 Wend If i <= Len(strTemp) Then ' Last char is not processed. If Right(strTemp, 1) <> "\" Then ParseString = ParseString & Right(strTemp, 1) Else Err.Raise vbObjectError, _ "ParseString", "unterminated string, got EOF." End If End If End Function ================================================ FILE: impls/vbs/run ================================================ #!/usr/bin/env bash MAL_VBS_IMPL_NO_STDERR=1 MAL_VBS_IMPL_ECHO_STDIN=1 \ WSLENV=MAL_VBS_IMPL_NO_STDERR/w:MAL_VBS_IMPL_ECHO_STDIN/w \ cscript.exe -nologo "`wslpath -w "$(dirname $0)/${STEP:-stepA_mal}.vbs"`" "${@}" ================================================ FILE: impls/vbs/step0_repl.vbs ================================================ Option Explicit Include "IO.vbs" Function Read(strCode) Read = strCode End Function Function Evaluate(strCode) Evaluate = strCode End Function Function Print(strCode) Print = strCode End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode))) End Function Dim strCode While True 'REPL WScript.StdOut.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 IO.WriteLine REP(strCode) Wend Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step1_read_print.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Function Evaluate(objCode) Set Evaluate = objCode End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode))) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step2_eval.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Function EnvGet(objDict, objSymbol) If objDict.Exists(objSymbol) Then Set EnvGet = objDict.Item(objSymbol) Else Err.Raise vbObjectError, _ "Enviroment", "Symbol '" + objSymbol + "' not found." End If End Function Dim objEnv Set objEnv = CreateObject("Scripting.Dictionary") Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MAdd = NewMalNum( _ objArgs.Item(1).Value + objArgs.Item(2).Value) End Function objEnv.Add "+", NewVbsProc("MAdd", False) Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MSub = NewMalNum( _ objArgs.Item(1).Value - objArgs.Item(2).Value) End Function objEnv.Add "-", NewVbsProc("MSub", False) Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MMul = NewMalNum( _ objArgs.Item(1).Value * objArgs.Item(2).Value) End Function objEnv.Add "*", NewVbsProc("MMul", False) Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MDiv = NewMalNum( _ objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function objEnv.Add "/", NewVbsProc("MDiv", False) Sub CheckArgNum(objArgs, lngArgNum) If objArgs.Count - 1 <> lngArgNum Then Err.Raise vbObjectError, _ "CheckArgNum", "Wrong number of arguments." End IF End Sub Sub CheckType(objMal, varType) If objMal.Type <> varType Then Err.Raise vbObjectError, _ "CheckType", "Wrong argument type." End IF End Sub Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If ' DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If Set Evaluate = varRet End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = EnvGet(objEnv, objCode.Value) Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objEnv)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step3_env.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Dim objEnv Set objEnv = NewEnv(Nothing) Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MAdd = NewMalNum( _ objArgs.Item(1).Value + objArgs.Item(2).Value) End Function objEnv.Add "+", NewVbsProc("MAdd", False) Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MSub = NewMalNum( _ objArgs.Item(1).Value - objArgs.Item(2).Value) End Function objEnv.Add "-", NewVbsProc("MSub", False) Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MMul = NewMalNum( _ objArgs.Item(1).Value * objArgs.Item(2).Value) End Function objEnv.Add "*", NewVbsProc("MMul", False) Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER Set MDiv = NewMalNum( _ objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function objEnv.Add "/", NewVbsProc("MDiv", False) Sub CheckArgNum(objArgs, lngArgNum) If objArgs.Count - 1 <> lngArgNum Then Err.Raise vbObjectError, _ "CheckArgNum", "Wrong number of arguments." End IF End Sub Sub CheckType(objMal, varType) If objMal.Type <> varType Then Err.Raise vbObjectError, _ "CheckType", "Wrong argument type." End IF End Sub Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objEnv.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) If objBinds.Type <> TYPES.LIST And _ objBinds.Type <> TYPES.VECTOR Then Err.Raise vbObjectError, _ "MLet", "Wrong argument type." End If If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = Evaluate(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objEnv.Add "let*", NewVbsProc("MLet", True) Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If Set Evaluate = varRet End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objEnv)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step4_if_fn_do.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Function EvalLater(objMal, objEnv) ' A fake implement, for compatibility. Dim varRes Set varRes = Evaluate(objMal, objEnv) Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = Evaluate(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 1 Set varRet = Evaluate(objArgs.Item(i), objEnv) Next Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = Evaluate(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = Evaluate(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Call InitBuiltIn() Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If Set Evaluate = varRet End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step5_tco.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Call InitBuiltIn() Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step6_file.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Function MEval(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = Evaluate(objArgs.Item(1), objEnv) Set varRes = EvalLater(varRes, objNS) Set MEval = varRes End Function objNS.Add "eval", NewVbsProc("MEval", True) Call InitBuiltIn() Call InitArgs() Sub InitArgs() Dim objArgs Set objArgs = NewMalList(Array()) Dim i For i = 1 To WScript.Arguments.Count - 1 objArgs.Add NewMalStr(WScript.Arguments.Item(i)) Next objNS.Add "*ARGV*", objArgs If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" WScript.Quit 0 End If End Sub Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step7_quote.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Function MEval(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = Evaluate(objArgs.Item(1), objEnv) Set varRes = EvalLater(varRes, objNS) Set MEval = varRes End Function objNS.Add "eval", NewVbsProc("MEval", True) Function MQuote(objArgs, objEnv) CheckArgNum objArgs, 1 Set MQuote = objArgs.Item(1) End Function objNS.Add "quote", NewVbsProc("MQuote", True) Function MQuasiQuote(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = EvalLater( _ MQuasiQuoteExpand(objArgs, objEnv), objEnv) Set MQuasiQuote = varRes End Function objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) Function MQuasiQuoteExpand(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = ExpandHelper(objArgs.Item(1)) If varRes.Splice Then Err.Raise vbObjectError, _ "MQuasiQuoteExpand", "Wrong return value type." End If Set varRes = varRes.Value Set MQuasiQuoteExpand = varRes End Function Class ExpandType Public Splice Public Value End Class Function NewExpandType(objValue, boolSplice) Dim varRes Set varRes = New ExpandType Set varRes.Value = objValue varRes.Splice = boolSplice Set NewExpandType = varRes End Function Function ExpandHelper(objArg) Dim varRes, boolSplice Dim varBuilder, varEType, i boolSplice = False Select Case objArg.Type Case TYPES.LIST Dim boolNormal boolNormal = False ' Check for unquotes. Select Case objArg.Count Case 2 ' Maybe have a bug here ' like (unquote a b c) should be throw a error If objArg.Item(0).Type = TYPES.SYMBOL Then Select Case objArg.Item(0).Value Case "unquote" Set varRes = objArg.Item(1) Case "splice-unquote" Set varRes = objArg.Item(1) boolSplice = True Case Else boolNormal = True End Select Else boolNormal = True End If Case Else boolNormal = True End Select If boolNormal Then Set varRes = NewMalList(Array()) Set varBuilder = varRes For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next End If Case TYPES.VECTOR Set varRes = NewMalList(Array( _ NewMalSym("vec"), NewMalList(Array()))) Set varBuilder = varRes.Item(1) For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next Case TYPES.HASHMAP ' Maybe have a bug here. ' e.g. {"key" ~value} Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case TYPES.SYMBOL Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case Else ' Maybe have a bug here. ' All unspecified type will return itself. Set varRes = objArg End Select Set ExpandHelper = NewExpandType(varRes, boolSplice) End Function Call InitBuiltIn() Call InitArgs() Sub InitArgs() Dim objArgs Set objArgs = NewMalList(Array()) Dim i For i = 1 To WScript.Arguments.Count - 1 objArgs.Add NewMalStr(WScript.Arguments.Item(i)) Next objNS.Add "*ARGV*", objArgs If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" WScript.Quit 0 End If End Sub Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step8_macros.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Function MEval(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = Evaluate(objArgs.Item(1), objEnv) Set varRes = EvalLater(varRes, objNS) Set MEval = varRes End Function objNS.Add "eval", NewVbsProc("MEval", True) Function MQuote(objArgs, objEnv) CheckArgNum objArgs, 1 Set MQuote = objArgs.Item(1) End Function objNS.Add "quote", NewVbsProc("MQuote", True) Function MQuasiQuote(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = EvalLater( _ MQuasiQuoteExpand(objArgs, objEnv), objEnv) Set MQuasiQuote = varRes End Function objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) Function MQuasiQuoteExpand(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = ExpandHelper(objArgs.Item(1)) If varRes.Splice Then Err.Raise vbObjectError, _ "MQuasiQuoteExpand", "Wrong return value type." End If Set varRes = varRes.Value Set MQuasiQuoteExpand = varRes End Function Class ExpandType Public Splice Public Value End Class Function NewExpandType(objValue, boolSplice) Dim varRes Set varRes = New ExpandType Set varRes.Value = objValue varRes.Splice = boolSplice Set NewExpandType = varRes End Function Function ExpandHelper(objArg) Dim varRes, boolSplice Dim varBuilder, varEType, i boolSplice = False Select Case objArg.Type Case TYPES.LIST Dim boolNormal boolNormal = False ' Check for unquotes. Select Case objArg.Count Case 2 ' Maybe have a bug here ' like (unquote a b c) should be throw a error If objArg.Item(0).Type = TYPES.SYMBOL Then Select Case objArg.Item(0).Value Case "unquote" Set varRes = objArg.Item(1) Case "splice-unquote" Set varRes = objArg.Item(1) boolSplice = True Case Else boolNormal = True End Select Else boolNormal = True End If Case Else boolNormal = True End Select If boolNormal Then Set varRes = NewMalList(Array()) Set varBuilder = varRes For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next End If Case TYPES.VECTOR Set varRes = NewMalList(Array( _ NewMalSym("vec"), NewMalList(Array()))) Set varBuilder = varRes.Item(1) For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next Case TYPES.HASHMAP ' Maybe have a bug here. ' e.g. {"key" ~value} Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case TYPES.SYMBOL Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case Else ' Maybe have a bug here. ' All unspecified type will return itself. Set varRes = objArg End Select Set ExpandHelper = NewExpandType(varRes, boolSplice) End Function Function MDefMacro(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() CheckType varRet, TYPES.PROCEDURE varRet.IsMacro = True objEnv.Add objArgs.Item(1).Value, varRet Set MDefMacro = varRet End Function objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) Call InitBuiltIn() Call InitMacro() Call InitArgs() Sub InitArgs() Dim objArgs Set objArgs = NewMalList(Array()) Dim i For i = 1 To WScript.Arguments.Count - 1 objArgs.Add NewMalStr(WScript.Arguments.Item(i)) Next objNS.Add "*ARGV*", objArgs If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" WScript.Quit 0 End If End Sub Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) If objFirst.IsMacro Then Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) Else Set varRet = objFirst.Apply(objCode, objEnv) End If Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/step9_try.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Function MEval(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = Evaluate(objArgs.Item(1), objEnv) Set varRes = EvalLater(varRes, objNS) Set MEval = varRes End Function objNS.Add "eval", NewVbsProc("MEval", True) Function MQuote(objArgs, objEnv) CheckArgNum objArgs, 1 Set MQuote = objArgs.Item(1) End Function objNS.Add "quote", NewVbsProc("MQuote", True) Function MQuasiQuote(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = EvalLater( _ MQuasiQuoteExpand(objArgs, objEnv), objEnv) Set MQuasiQuote = varRes End Function objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) Function MQuasiQuoteExpand(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = ExpandHelper(objArgs.Item(1)) If varRes.Splice Then Err.Raise vbObjectError, _ "MQuasiQuoteExpand", "Wrong return value type." End If Set varRes = varRes.Value Set MQuasiQuoteExpand = varRes End Function Class ExpandType Public Splice Public Value End Class Function NewExpandType(objValue, boolSplice) Dim varRes Set varRes = New ExpandType Set varRes.Value = objValue varRes.Splice = boolSplice Set NewExpandType = varRes End Function Function ExpandHelper(objArg) Dim varRes, boolSplice Dim varBuilder, varEType, i boolSplice = False Select Case objArg.Type Case TYPES.LIST Dim boolNormal boolNormal = False ' Check for unquotes. Select Case objArg.Count Case 2 ' Maybe have a bug here ' like (unquote a b c) should be throw a error If objArg.Item(0).Type = TYPES.SYMBOL Then Select Case objArg.Item(0).Value Case "unquote" Set varRes = objArg.Item(1) Case "splice-unquote" Set varRes = objArg.Item(1) boolSplice = True Case Else boolNormal = True End Select Else boolNormal = True End If Case Else boolNormal = True End Select If boolNormal Then Set varRes = NewMalList(Array()) Set varBuilder = varRes For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next End If Case TYPES.VECTOR Set varRes = NewMalList(Array( _ NewMalSym("vec"), NewMalList(Array()))) Set varBuilder = varRes.Item(1) For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next Case TYPES.HASHMAP ' Maybe have a bug here. ' e.g. {"key" ~value} Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case TYPES.SYMBOL Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case Else ' Maybe have a bug here. ' All unspecified type will return itself. Set varRes = objArg End Select Set ExpandHelper = NewExpandType(varRes, boolSplice) End Function Function MDefMacro(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() CheckType varRet, TYPES.PROCEDURE varRet.IsMacro = True objEnv.Add objArgs.Item(1).Value, varRet Set MDefMacro = varRet End Function objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) Function MTry(objArgs, objEnv) Dim varRes If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MTry", "Need more arguments." End If If objArgs.Count - 1 = 1 Then Set varRes = EvalLater(objArgs.Item(1), objEnv) Set MTry = varRes Exit Function End If CheckArgNum objArgs, 2 CheckType objArgs.Item(2), TYPES.LIST Dim objTry, objCatch Set objTry = objArgs.Item(1) Set objCatch = objArgs.Item(2) CheckArgNum objCatch, 2 CheckType objCatch.Item(0), TYPES.SYMBOL CheckType objCatch.Item(1), TYPES.SYMBOL If objCatch.Item(0).Value <> "catch*" Then Err.Raise vbObjectError, _ "MTry", "Unexpect argument(s)." End If On Error Resume Next Set varRes = Evaluate(objTry, objEnv) If Err.Number <> 0 Then Dim objException If Err.Source <> "MThrow" Then Set objException = NewMalStr(Err.Description) Else Set objException = objExceptions.Item(Err.Description) objExceptions.Remove Err.Description End If Call Err.Clear() On Error Goto 0 ' The code below may cause error too. ' So we should clear err info & throw out any errors. ' Use 'quote' to avoid eval objExp again. Set varRes = Evaluate(NewMalList(Array( _ NewMalSym("let*"), NewMalList(Array( _ objCatch.Item(1), NewMalList(Array( _ NewMalSym("quote"), objException)))), _ objCatch.Item(2))), objEnv) Else On Error Goto 0 End If Set MTry = varRes End Function objNS.Add "try*", NewVbsProc("MTry", True) Call InitBuiltIn() Call InitMacro() Call InitArgs() Sub InitArgs() Dim objArgs Set objArgs = NewMalList(Array()) Dim i For i = 1 To WScript.Arguments.Count - 1 objArgs.Add NewMalStr(WScript.Arguments.Item(i)) Next objNS.Add "*ARGV*", objArgs If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" WScript.Quit 0 End If End Sub Call REPL() Sub REPL() Dim strCode While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then IO.WriteErrLine "Exception: " + _ PrintMalType(objExceptions.Item(Err.Description), True) objExceptions.Remove Err.Description Else IO.WriteErrLine "Exception: " + Err.Description End If Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) If objFirst.IsMacro Then Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) Else Set varRet = objFirst.Apply(objCode, objEnv) End If Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/stepA_mal.vbs ================================================ Option Explicit Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" Class TailCall Public objMalType Public objEnv End Class Function EvalLater(objMal, objEnv) Dim varRes Set varRes = New TailCall Set varRes.objMalType = objMal Set varRes.objEnv = objEnv Set EvalLater = varRes End Function Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv) objEnv.Add objArgs.Item(1).Value, varRet Set MDef = varRet End Function objNS.Add "def!", NewVbsProc("MDef", True) Function MLet(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objBinds Set objBinds = objArgs.Item(1) CheckListOrVec objBinds If objBinds.Count Mod 2 <> 0 Then Err.Raise vbObjectError, _ "MLet", "Wrong argument count." End If Dim objNewEnv Set objNewEnv = NewEnv(objEnv) Dim i, objSym For i = 0 To objBinds.Count - 1 Step 2 Set objSym = objBinds.Item(i) CheckType objSym, TYPES.SYMBOL objNewEnv.Add objSym.Value, Evaluate(objBinds.Item(i + 1), objNewEnv) Next Set varRet = EvalLater(objArgs.Item(2), objNewEnv) Set MLet = varRet End Function objNS.Add "let*", NewVbsProc("MLet", True) Function MDo(objArgs, objEnv) Dim varRet, i If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MDo", "Need more arguments." End If For i = 1 To objArgs.Count - 2 Call Evaluate(objArgs.Item(i), objEnv) Next Set varRet = EvalLater( _ objArgs.Item(objArgs.Count - 1), _ objEnv) Set MDo = varRet End Function objNS.Add "do", NewVbsProc("MDo", True) Function MIf(objArgs, objEnv) Dim varRet If objArgs.Count - 1 <> 3 And _ objArgs.Count - 1 <> 2 Then Err.Raise vbObjectError, _ "MIf", "Wrong number of arguments." End If Dim objCond Set objCond = Evaluate(objArgs.Item(1), objEnv) Dim boolCond If objCond.Type = TYPES.BOOLEAN Then boolCond = objCond.Value Else boolCond = True End If boolCond = (boolCond And objCond.Type <> TYPES.NIL) If boolCond Then Set varRet = EvalLater(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then Set varRet = EvalLater(objArgs.Item(3), objEnv) Else Set varRet = NewMalNil() End If End If Set MIf = varRet End Function objNS.Add "if", NewVbsProc("MIf", True) Function MFn(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 Dim objParams, objCode Set objParams = objArgs.Item(1) CheckListOrVec objParams Set objCode = objArgs.Item(2) Dim i For i = 0 To objParams.Count - 1 CheckType objParams.Item(i), TYPES.SYMBOL Next Set varRet = NewMalProc(objParams, objCode, objEnv) Set MFn = varRet End Function objNS.Add "fn*", NewVbsProc("MFn", True) Function MEval(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = Evaluate(objArgs.Item(1), objEnv) Set varRes = EvalLater(varRes, objNS) Set MEval = varRes End Function objNS.Add "eval", NewVbsProc("MEval", True) Function MQuote(objArgs, objEnv) CheckArgNum objArgs, 1 Set MQuote = objArgs.Item(1) End Function objNS.Add "quote", NewVbsProc("MQuote", True) Function MQuasiQuote(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = EvalLater( _ MQuasiQuoteExpand(objArgs, objEnv), objEnv) Set MQuasiQuote = varRes End Function objNS.Add "quasiquote", NewVbsProc("MQuasiQuote", True) Function MQuasiQuoteExpand(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 Set varRes = ExpandHelper(objArgs.Item(1)) If varRes.Splice Then Err.Raise vbObjectError, _ "MQuasiQuoteExpand", "Wrong return value type." End If Set varRes = varRes.Value Set MQuasiQuoteExpand = varRes End Function Class ExpandType Public Splice Public Value End Class Function NewExpandType(objValue, boolSplice) Dim varRes Set varRes = New ExpandType Set varRes.Value = objValue varRes.Splice = boolSplice Set NewExpandType = varRes End Function Function ExpandHelper(objArg) Dim varRes, boolSplice Dim varBuilder, varEType, i boolSplice = False Select Case objArg.Type Case TYPES.LIST Dim boolNormal boolNormal = False ' Check for unquotes. Select Case objArg.Count Case 2 ' Maybe have a bug here ' like (unquote a b c) should be throw a error If objArg.Item(0).Type = TYPES.SYMBOL Then Select Case objArg.Item(0).Value Case "unquote" Set varRes = objArg.Item(1) Case "splice-unquote" Set varRes = objArg.Item(1) boolSplice = True Case Else boolNormal = True End Select Else boolNormal = True End If Case Else boolNormal = True End Select If boolNormal Then Set varRes = NewMalList(Array()) Set varBuilder = varRes For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next End If Case TYPES.VECTOR Set varRes = NewMalList(Array( _ NewMalSym("vec"), NewMalList(Array()))) Set varBuilder = varRes.Item(1) For i = 0 To objArg.Count - 1 Set varEType = ExpandHelper(objArg.Item(i)) If varEType.Splice Then varBuilder.Add NewMalSym("concat") Else varBuilder.Add NewMalSym("cons") End If varBuilder.Add varEType.Value varBuilder.Add NewMalList(Array()) Set varBuilder = varBuilder.Item(2) Next Case TYPES.HASHMAP ' Maybe have a bug here. ' e.g. {"key" ~value} Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case TYPES.SYMBOL Set varRes = NewMalList(Array( _ NewMalSym("quote"), objArg)) Case Else ' Maybe have a bug here. ' All unspecified type will return itself. Set varRes = objArg End Select Set ExpandHelper = NewExpandType(varRes, boolSplice) End Function Function MDefMacro(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() CheckType varRet, TYPES.PROCEDURE varRet.IsMacro = True objEnv.Add objArgs.Item(1).Value, varRet Set MDefMacro = varRet End Function objNS.Add "defmacro!", NewVbsProc("MDefMacro", True) Function MTry(objArgs, objEnv) Dim varRes If objArgs.Count - 1 < 1 Then Err.Raise vbObjectError, _ "MTry", "Need more arguments." End If If objArgs.Count - 1 = 1 Then Set varRes = EvalLater(objArgs.Item(1), objEnv) Set MTry = varRes Exit Function End If CheckArgNum objArgs, 2 CheckType objArgs.Item(2), TYPES.LIST Dim objTry, objCatch Set objTry = objArgs.Item(1) Set objCatch = objArgs.Item(2) CheckArgNum objCatch, 2 CheckType objCatch.Item(0), TYPES.SYMBOL CheckType objCatch.Item(1), TYPES.SYMBOL If objCatch.Item(0).Value <> "catch*" Then Err.Raise vbObjectError, _ "MTry", "Unexpect argument(s)." End If On Error Resume Next Set varRes = Evaluate(objTry, objEnv) If Err.Number <> 0 Then Dim objException If Err.Source <> "MThrow" Then Set objException = NewMalStr(Err.Description) Else Set objException = objExceptions.Item(Err.Description) objExceptions.Remove Err.Description End If Call Err.Clear() On Error Goto 0 ' The code below may cause error too. ' So we should clear err info & throw out any errors. ' Use 'quote' to avoid eval objExp again. Set varRes = Evaluate(NewMalList(Array( _ NewMalSym("let*"), NewMalList(Array( _ objCatch.Item(1), NewMalList(Array( _ NewMalSym("quote"), objException)))), _ objCatch.Item(2))), objEnv) Else On Error Goto 0 End If Set MTry = varRes End Function objNS.Add "try*", NewVbsProc("MTry", True) Call InitBuiltIn() Call InitMacro() Call InitArgs() Sub InitArgs() Dim objArgs Set objArgs = NewMalList(Array()) Dim i For i = 1 To WScript.Arguments.Count - 1 objArgs.Add NewMalStr(WScript.Arguments.Item(i)) Next objNS.Add "*ARGV*", objArgs If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" WScript.Quit 0 End If End Sub Call REPL() Sub REPL() Dim strCode REP "(println (str ""Mal [""*host-language*""]""))" While True IO.Write "user> " On Error Resume Next strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 Dim strRes On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then IO.WriteErrLine "Exception: " + _ PrintMalType(objExceptions.Item(Err.Description), True) objExceptions.Remove Err.Description Else IO.WriteErrLine "Exception: " + Err.Description End If Else If strRes <> "" Then IO.WriteLine strRes End If End If On Error Goto 0 Wend End Sub Function Read(strCode) Set Read = ReadString(strCode) End Function Sub DebugEval(objCode, objEnv) Dim value Set value = objEnv.Get("DEBUG-EVAL") ' And and Or do not short-circuit. If TypeName(value) = "Nothing" Then Exit Sub Else Select Case value.Type Case TYPES.NIL Exit Sub Case TYPES.BOOLEAN If Not value.Value Then Exit Sub End If End Select End If IO.WriteLine "EVAL: " + Print(objCode) End Sub Function Evaluate(ByVal objCode, ByVal objEnv) While True If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If DebugEval objCode, objEnv Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If Set objFirst = Evaluate(objCode.Item(0), objEnv) If objFirst.IsMacro Then Set varRet = EvalLater(objFirst.MacroApply(objCode, objEnv), objEnv) Else Set varRet = objFirst.Apply(objCode, objEnv) End If Else Set varRet = EvaluateAST(objCode, objEnv) End If If TypeName(varRet) = "TailCall" Then ' NOTICE: If not specify 'ByVal', ' Change of arguments will influence ' the caller's variable! Set objCode = varRet.objMalType Set objEnv = varRet.objEnv Else Set Evaluate = varRet Exit Function End If Wend End Function Function EvaluateAST(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.SYMBOL Set varRet = objEnv.Get(objCode.Value) If TypeName(varRet) = "Nothing" Then Err.Raise vbObjectError, _ "EvaluateAST", "'" + objCode.Value + "' not found" End If Case TYPES.LIST Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case TYPES.HASHMAP Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next Case Else Set varRet = objCode End Select Set EvaluateAST = varRet End Function Function EvaluateRest(objCode, objEnv) Dim varRet, i Select Case objCode.Type Case TYPES.LIST Set varRet = NewMalList(Array(NewMalNil())) For i = 1 To objCode.Count() - 1 varRet.Add Evaluate(objCode.Item(i), objEnv) Next Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." End Select Set EvaluateRest = varRet End Function Function Print(objCode) Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ .GetParentFolderName( _ .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With End Sub ================================================ FILE: impls/vbs/tests/step4_if_fn_do.mal ================================================ ((fn* [x] [x]) (list 1 2 3)) ;=>[(1 2 3)] ((fn* [x] [x]) [1 2 3]) ;=>[[1 2 3]] ((fn* [x] (list x)) (list 1 2 3)) ;=>((1 2 3)) ((fn* [x] (list x)) [1 2 3]) ;=>([1 2 3]) ((fn* [x] x) (list 1 2 3)) ;=>(1 2 3) ((fn* [x] x) [1 2 3]) ;=>[1 2 3] ================================================ FILE: impls/vbs/tests/step9_try.mal ================================================ (throw (list 1 2 3)) ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*\(1 2 3\).* (try* (throw {}) (catch* e (do (throw e)))) ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*{}.* (try* (throw (list 1 2 3)) (catch* exc (do 7))) ;=>7 (try* (map throw (list "my err")) (catch* exc exc)) ;=>"my err" ================================================ FILE: impls/vbs/types.vbs ================================================ Option Explicit Dim TYPES Set TYPES = New MalTypes Class MalTypes Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL Public KEYWORD, [STRING], NUMBER, SYMBOL Public PROCEDURE, ATOM Public [TypeName] Private Sub Class_Initialize [TypeName] = Array( _ "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ "NIL", "KEYWORD", "STRING", "NUMBER", _ "SYMBOL", "PROCEDURE", "ATOM") Dim i For i = 0 To UBound([TypeName]) Execute "[" + [TypeName](i) + "] = " + CStr(i) Next End Sub End Class Class MalType Public [Type] Public Value Private varMeta Public Property Get MetaData() If IsEmpty(varMeta) Then Set MetaData = NewMalNil() Else Set MetaData = varMeta End If End Property Public Property Set MetaData(objMeta) Set varMeta = objMeta End Property Public Function Copy() Set Copy = NewMalType([Type], Value) End Function Public Function Init(lngType, varValue) [Type] = lngType Value = varValue End Function End Class Function NewMalType(lngType, varValue) Dim varResult Set varResult = New MalType varResult.Init lngType, varValue Set NewMalType = varResult End Function Function NewMalBool(varValue) Set NewMalBool = NewMalType(TYPES.BOOLEAN, varValue) End Function Function NewMalNil() Set NewMalNil = NewMalType(TYPES.NIL, Empty) End Function Function NewMalKwd(varValue) Set NewMalKwd = NewMalType(TYPES.KEYWORD, varValue) End Function Function NewMalStr(varValue) Set NewMalStr = NewMalType(TYPES.STRING, varValue) End Function Function NewMalNum(varValue) Set NewMalNum = NewMalType(TYPES.NUMBER, varValue) End Function Function NewMalSym(varValue) Set NewMalSym = NewMalType(TYPES.SYMBOL, varValue) End Function Class MalAtom Public [Type] Public Value Private varMeta Public Property Get MetaData() If IsEmpty(varMeta) Then Set MetaData = NewMalNil() Else Set MetaData = varMeta End If End Property Public Property Set MetaData(objMeta) Set varMeta = objMeta End Property Public Function Copy() Set Copy = NewMalAtom(Value) End Function Public Sub Reset(objMal) Set Value = objMal End Sub Private Sub Class_Initialize [Type] = TYPES.ATOM End Sub End Class Function NewMalAtom(varValue) Dim varRes Set varRes = New MalAtom varRes.Reset varValue Set NewMalAtom = varRes End Function Class MalList ' Extends MalType Public [Type] Public Value Private varMeta Public Property Get MetaData() If IsEmpty(varMeta) Then Set MetaData = NewMalNil() Else Set MetaData = varMeta End If End Property Public Property Set MetaData(objMeta) Set varMeta = objMeta End Property Public Function Copy() Set Copy = New MalList Set Copy.Value = Value End Function Private Sub Class_Initialize [Type] = TYPES.LIST Set Value = CreateObject("System.Collections.ArrayList") End Sub Public Function Init(arrValues) Dim i For i = 0 To UBound(arrValues) Add arrValues(i) Next End Function Public Function Add(objMalType) Value.Add objMalType End Function Public Property Get Item(i) Set Item = Value.Item(i) End Property Public Property Let Item(i, varValue) Value.Item(i) = varValue End Property Public Property Set Item(i, varValue) Set Value.Item(i) = varValue End Property Public Function Count() Count = Value.Count End Function End Class Function NewMalList(arrValues) Dim varResult Set varResult = New MalList varResult.Init arrValues Set NewMalList = varResult End Function Class MalVector ' Extends MalType Public [Type] Public Value Private varMeta Public Property Get MetaData() If IsEmpty(varMeta) Then Set MetaData = NewMalNil() Else Set MetaData = varMeta End If End Property Public Property Set MetaData(objMeta) Set varMeta = objMeta End Property Public Function Copy() Set Copy = New MalVector Set Copy.Value = Value End Function Private Sub Class_Initialize [Type] = TYPES.VECTOR Set Value = CreateObject("System.Collections.ArrayList") End Sub Public Function Init(arrValues) Dim i For i = 0 To UBound(arrValues) Add arrValues(i) Next End Function Public Function Add(objMalType) Value.Add objMalType End Function Public Property Get Item(i) Set Item = Value.Item(i) End Property Public Property Let Item(i, varValue) Value.Item(i) = varValue End Property Public Property Set Item(i, varValue) Set Value.Item(i) = varValue End Property Public Function Count() Count = Value.Count End Function End Class Function NewMalVec(arrValues) Dim varResult Set varResult = New MalVector varResult.Init arrValues Set NewMalVec = varResult End Function Class MalHashmap 'Extends MalType Public [Type] Public Value Private varMeta Public Property Get MetaData() If IsEmpty(varMeta) Then Set MetaData = NewMalNil() Else Set MetaData = varMeta End If End Property Public Property Set MetaData(objMeta) Set varMeta = objMeta End Property Public Function Copy() Set Copy = New MalHashmap Set Copy.Value = Value End Function Private Sub Class_Initialize [Type] = TYPES.HASHMAP Set Value = CreateObject("Scripting.Dictionary") End Sub Public Function Init(arrKeys, arrValues) Dim i For i = 0 To UBound(arrKeys) Add arrKeys(i), arrValues(i) Next End Function Private Function M2S(objKey) Dim varRes Select Case objKey.Type Case TYPES.STRING varRes = "S" + objKey.Value Case TYPES.KEYWORD varRes = "K" + objKey.Value Case Else Err.Raise vbObjectError, _ "MalHashmap", "Unexpect key type." End Select M2S = varRes End Function Private Function S2M(strKey) Dim varRes Select Case Left(strKey, 1) Case "S" Set varRes = NewMalStr(Right(strKey, Len(strKey) - 1)) Case "K" Set varRes = NewMalKwd(Right(strKey, Len(strKey) - 1)) Case Else Err.Raise vbObjectError, _ "MalHashmap", "Unexpect key type." End Select Set S2M = varRes End Function Public Function Add(varKey, varValue) If varKey.Type <> TYPES.STRING And _ varKey.Type <> TYPES.KEYWORD Then Err.Raise vbObjectError, _ "MalHashmap", "Unexpect key type." End If Set Value.Item(M2S(varKey)) = varValue 'Value.Add M2S(varKey), varValue End Function Public Property Get Keys() Dim aKeys aKeys = Value.Keys Dim aRes() ReDim aRes(UBound(aKeys)) Dim i For i = 0 To UBound(aRes) Set aRes(i) = S2M(aKeys(i)) Next Keys = aRes End Property Public Function Count() Count = Value.Count End Function Public Property Get Item(i) Set Item = Value.Item(M2S(i)) End Property Public Function Exists(varKey) If varKey.Type <> TYPES.STRING And _ varKey.Type <> TYPES.KEYWORD Then Err.Raise vbObjectError, _ "MalHashmap", "Unexpect key type." End If Exists = Value.Exists(M2S(varKey)) End Function Public Property Let Item(i, varValue) Value.Item(M2S(i)) = varValue End Property Public Property Set Item(i, varValue) Set Value.Item(M2S(i)) = varValue End Property End Class Function NewMalMap(arrKeys, arrValues) Dim varResult Set varResult = New MalHashmap varResult.Init arrKeys, arrValues Set NewMalMap = varResult End Function Class VbsProcedure 'Extends MalType Public [Type] Public Value Public IsMacro Public boolSpec Public MetaData Private Sub Class_Initialize [Type] = TYPES.PROCEDURE IsMacro = False Set MetaData = NewMalNil() End Sub Public Property Get IsSpecial() IsSpecial = boolSpec End Property Public Function Init(objFunction, boolIsSpec) Set Value = objFunction boolSpec = boolIsSpec End Function Public Function Apply(objArgs, objEnv) Dim varResult If boolSpec Then Set varResult = Value(objArgs, objEnv) Else Set varResult = Value(EvaluateRest(objArgs, objEnv), objEnv) End If Set Apply = varResult End Function Public Function ApplyWithoutEval(objArgs, objEnv) Dim varResult Set varResult = Value(objArgs, objEnv) Set ApplyWithoutEval = varResult End Function Public Function Copy() Dim varRes Set varRes = New VbsProcedure varRes.Type = [Type] Set varRes.Value = Value varRes.IsMacro = IsMacro varRes.boolSpec = boolSpec Set Copy = varRes End Function End Class Function NewVbsProc(strFnName, boolSpec) Dim varResult Set varResult = New VbsProcedure varResult.Init GetRef(strFnName), boolSpec Set NewVbsProc = varResult End Function Class MalProcedure 'Extends MalType Public [Type] Public Value Public IsMacro Public Property Get IsSpecial() IsSpecial = False End Property Public MetaData Private Sub Class_Initialize [Type] = TYPES.PROCEDURE IsMacro = False Set MetaData = NewMalNil() End Sub Public objParams, objCode, objSavedEnv Public Function Init(objP, objC, objE) Set objParams = objP Set objCode = objC Set objSavedEnv = objE End Function Public Function Apply(objArgs, objEnv) If IsMacro Then Err.Raise vbObjectError, _ "MalProcedureApply", "Not a procedure." End If Dim varRet Dim objNewEnv Set objNewEnv = NewEnv(objSavedEnv) Dim i i = 0 Dim objList While i < objParams.Count If objParams.Item(i).Value = "&" Then If objParams.Count - 1 = i + 1 Then Set objList = NewMalList(Array()) objNewEnv.Add objParams.Item(i + 1).Value, objList While i + 1 < objArgs.Count objList.Add Evaluate(objArgs.Item(i + 1), objEnv) i = i + 1 Wend i = objParams.Count ' Break While Else Err.Raise vbObjectError, _ "MalProcedureApply", "Invalid parameter(s)." End If Else If i + 1 >= objArgs.Count Then Err.Raise vbObjectError, _ "MalProcedureApply", "Need more arguments." End If objNewEnv.Add objParams.Item(i).Value, _ Evaluate(objArgs.Item(i + 1), objEnv) i = i + 1 End If Wend Set varRet = EvalLater(objCode, objNewEnv) Set Apply = varRet End Function Public Function MacroApply(objArgs, objEnv) If Not IsMacro Then Err.Raise vbObjectError, _ "MalMacroApply", "Not a macro." End If Dim varRet Dim objNewEnv Set objNewEnv = NewEnv(objSavedEnv) Dim i i = 0 Dim objList While i < objParams.Count If objParams.Item(i).Value = "&" Then If objParams.Count - 1 = i + 1 Then Set objList = NewMalList(Array()) ' No evaluation objNewEnv.Add objParams.Item(i + 1).Value, objList While i + 1 < objArgs.Count objList.Add objArgs.Item(i + 1) i = i + 1 Wend i = objParams.Count ' Break While Else Err.Raise vbObjectError, _ "MalMacroApply", "Invalid parameter(s)." End If Else If i + 1 >= objArgs.Count Then Err.Raise vbObjectError, _ "MalMacroApply", "Need more arguments." End If ' No evaluation objNewEnv.Add objParams.Item(i).Value, _ objArgs.Item(i + 1) i = i + 1 End If Wend ' EvalLater -> Evaluate Set varRet = Evaluate(objCode, objNewEnv) Set MacroApply = varRet End Function Public Function ApplyWithoutEval(objArgs, objEnv) Dim varRet Dim objNewEnv Set objNewEnv = NewEnv(objSavedEnv) Dim i i = 0 Dim objList While i < objParams.Count If objParams.Item(i).Value = "&" Then If objParams.Count - 1 = i + 1 Then Set objList = NewMalList(Array()) ' No evaluation objNewEnv.Add objParams.Item(i + 1).Value, objList While i + 1 < objArgs.Count objList.Add objArgs.Item(i + 1) i = i + 1 Wend i = objParams.Count ' Break While Else Err.Raise vbObjectError, _ "MalMacroApply", "Invalid parameter(s)." End If Else If i + 1 >= objArgs.Count Then Err.Raise vbObjectError, _ "MalMacroApply", "Need more arguments." End If ' No evaluation objNewEnv.Add objParams.Item(i).Value, _ objArgs.Item(i + 1) i = i + 1 End If Wend ' EvalLater -> Evaluate Set varRet = Evaluate(objCode, objNewEnv) Set ApplyWithoutEval = varRet End Function Public Function Copy() Dim varRes Set varRes = New MalProcedure varRes.Type = [Type] varRes.Value = Value varRes.IsMacro = IsMacro Set varRes.objParams = objParams Set varRes.objCode = objCode Set varRes.objSavedEnv = objSavedEnv Set Copy = varRes End Function End Class Function NewMalProc(objParams, objCode, objEnv) Dim varRet Set varRet = New MalProcedure varRet.Init objParams, objCode, objEnv Set NewMalProc = varRet End Function Function NewMalMacro(objParams, objCode, objEnv) Dim varRet Set varRet = New MalProcedure varRet.Init objParams, objCode, objEnv varRet.IsMacro = True Set NewMalProc = varRet End Function Function SetMeta(objMal, objMeta) Dim varRes Set varRes = objMal.Copy Set varRes.MetaData = objMeta Set SetMeta = varRes End Function Function GetMeta(objMal) Set GetMeta = objMal.MetaData End Function ================================================ FILE: impls/vhdl/.gitignore ================================================ work-obj93.cf ================================================ FILE: impls/vhdl/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install gcc ghdl ghdl-gcc ENV HOME /mal ================================================ FILE: impls/vhdl/Makefile ================================================ SRCS = step0_repl.vhdl step1_read_print.vhdl step2_eval.vhdl step3_env.vhdl \ step4_if_fn_do.vhdl step5_tco.vhdl step6_file.vhdl step7_quote.vhdl \ step8_macros.vhdl step9_try.vhdl stepA_mal.vhdl OBJS = $(SRCS:%.vhdl=%.o) BINS = $(OBJS:%.o=%) OTHER_SRCS = pkg_readline.vhdl types.vhdl printer.vhdl reader.vhdl env.vhdl core.vhdl OTHER_OBJS = $(OTHER_SRCS:%.vhdl=%.o) ##################### all: $(BINS) dist: mal mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ work-obj93.cf: $(OTHER_SRCS) rm -f work-obj93.cf ghdl -i $+ $(OTHER_OBJS): %.o: %.vhdl work-obj93.cf ghdl -a -g $(@:%.o=%.vhdl) $(OBJS): %.o: %.vhdl $(OTHER_OBJS) ghdl -a -g $(@:%.o=%.vhdl) $(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) $(BINS): %: %.o ghdl -e -g $@ # ghdl linker creates a lowercase executable; rename it to stepA_mal if [ "$@" = "stepA_mal" ]; then mv stepa_mal $@; fi clean: rm -f $(OBJS) $(BINS) $(OTHER_OBJS) work-obj93.cf mal ================================================ FILE: impls/vhdl/core.vhdl ================================================ library STD; use STD.textio.all; library WORK; use WORK.types.all; use WORK.env.all; use WORK.reader.all; use WORK.printer.all; use WORK.pkg_readline.all; package core is procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure define_core_functions(e: inout env_ptr); end package core; package body core is procedure fn_equal(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable is_equal: boolean; begin equal_q(args.seq_val(0), args.seq_val(1), is_equal); new_boolean(is_equal, result); end procedure fn_equal; procedure fn_throw(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin err := args.seq_val(0); end procedure fn_throw; procedure fn_nil_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_nil, result); end procedure fn_nil_q; procedure fn_true_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_true, result); end procedure fn_true_q; procedure fn_false_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_false, result); end procedure fn_false_q; procedure fn_string_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_string, result); end procedure fn_string_q; procedure fn_symbol(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_symbol(args.seq_val(0).string_val, result); end procedure fn_symbol; procedure fn_symbol_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_symbol, result); end procedure fn_symbol_q; procedure fn_keyword(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_keyword(args.seq_val(0).string_val, result); end procedure fn_keyword; procedure fn_keyword_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_keyword, result); end procedure fn_keyword_q; procedure fn_number_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_number, result); end procedure fn_number_q; procedure fn_function_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean((args.seq_val(0).val_type = mal_fn and not args.seq_val(0).func_val.f_is_macro) or args.seq_val(0).val_type = mal_nativefn, result); end procedure fn_function_q; procedure fn_macro_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_fn and args.seq_val(0).func_val.f_is_macro, result); end procedure fn_macro_q; procedure fn_pr_str(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable s: line; begin pr_seq("", "", " ", args.seq_val, true, s); new_string(s, result); end procedure fn_pr_str; procedure fn_str(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable s: line; begin pr_seq("", "", "", args.seq_val, false, s); new_string(s, result); end procedure fn_str; procedure fn_prn(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable s: line; begin pr_seq("", "", " ", args.seq_val, true, s); mal_printline(s.all); new_nil(result); end procedure fn_prn; procedure fn_println(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable s: line; begin pr_seq("", "", " ", args.seq_val, false, s); mal_printline(s.all); new_nil(result); end procedure fn_println; procedure fn_read_string(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast: mal_val_ptr; begin read_str(args.seq_val(0).string_val.all, ast, err); if ast = null then new_nil(result); else result := ast; end if; end procedure fn_read_string; procedure fn_readline(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable input_line: line; variable is_eof: boolean; begin mal_readline(args.seq_val(0).string_val.all, is_eof, input_line); if is_eof then new_nil(result); else new_string(input_line, result); end if; end procedure fn_readline; procedure fn_slurp(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is file f: text; variable status: file_open_status; variable save_content, content, one_line: line; begin file_open(status, f, external_name => args.seq_val(0).string_val.all, open_kind => read_mode); if status = open_ok then content := new string'(""); while not endfile(f) loop readline(f, one_line); save_content := content; content := new string'(save_content.all & one_line.all & LF); deallocate(save_content); end loop; file_close(f); new_string(content, result); else new_string("Error opening file", err); end if; end procedure fn_slurp; procedure fn_lt(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).number_val < args.seq_val(1).number_val, result); end procedure fn_lt; procedure fn_lte(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).number_val <= args.seq_val(1).number_val, result); end procedure fn_lte; procedure fn_gt(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).number_val > args.seq_val(1).number_val, result); end procedure fn_gt; procedure fn_gte(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).number_val >= args.seq_val(1).number_val, result); end procedure fn_gte; procedure fn_add(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_number(args.seq_val(0).number_val + args.seq_val(1).number_val, result); end procedure fn_add; procedure fn_sub(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_number(args.seq_val(0).number_val - args.seq_val(1).number_val, result); end procedure fn_sub; procedure fn_mul(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_number(args.seq_val(0).number_val * args.seq_val(1).number_val, result); end procedure fn_mul; procedure fn_div(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_number(args.seq_val(0).number_val / args.seq_val(1).number_val, result); end procedure fn_div; -- Define physical types (c_seconds64, c_microseconds64) because these are -- represented as 64-bit words when passed to C functions type c_seconds64 is range 0 to 1E16 units c_sec; end units c_seconds64; type c_microseconds64 is range 0 to 1E6 units c_usec; end units c_microseconds64; type c_timeval is record tv_sec: c_seconds64; tv_usec: c_microseconds64; end record c_timeval; -- Leave enough room for two 64-bit words type c_timezone is record dummy_1: c_seconds64; dummy_2: c_seconds64; end record c_timezone; function gettimeofday(tv: c_timeval; tz: c_timezone) return integer; attribute foreign of gettimeofday: function is "VHPIDIRECT gettimeofday"; function gettimeofday(tv: c_timeval; tz: c_timezone) return integer is begin assert false severity failure; end function gettimeofday; -- Returns the number of milliseconds since last midnight UTC because a -- standard VHDL integer is 32-bit and therefore cannot hold the number of -- milliseconds since 1970-01-01. procedure fn_time_ms(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable tv: c_timeval; variable dummy: c_timezone; variable rc: integer; begin rc := gettimeofday(tv, dummy); new_number(((tv.tv_sec / 1 c_sec) mod 86400) * 1000 + (tv.tv_usec / 1000 c_usec), result); end procedure fn_time_ms; procedure fn_list(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin result := args; end procedure fn_list; procedure fn_list_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_list, result); end procedure fn_list_q; procedure fn_vector(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin args.val_type := mal_vector; result := args; end procedure fn_vector; procedure fn_vector_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_vector, result); end procedure fn_vector_q; procedure fn_hash_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable new_map: mal_val_ptr; begin new_empty_hashmap(new_map); for i in 0 to args.seq_val'length / 2 - 1 loop hashmap_put(new_map, args.seq_val(2*i), args.seq_val(2*i+1)); end loop; result := new_map; end procedure fn_hash_map; procedure fn_map_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(args.seq_val(0).val_type = mal_hashmap, result); end procedure fn_map_q; procedure fn_assoc(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable new_hashmap: mal_val_ptr; variable i: integer; begin hashmap_copy(args.seq_val(0), new_hashmap); i := 1; while i < args.seq_val'length loop hashmap_put(new_hashmap, args.seq_val(i), args.seq_val(i + 1)); i := i + 2; end loop; result := new_hashmap; end procedure fn_assoc; procedure fn_dissoc(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable new_hashmap: mal_val_ptr; variable i: integer; begin hashmap_copy(args.seq_val(0), new_hashmap); for i in 1 to args.seq_val'high loop hashmap_delete(new_hashmap, args.seq_val(i)); end loop; result := new_hashmap; end procedure fn_dissoc; procedure fn_get(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable a1: mal_val_ptr := args.seq_val(1); variable val: mal_val_ptr; begin if a0.val_type = mal_nil then new_nil(result); else hashmap_get(a0, a1, val); if val = null then new_nil(result); else result := val; end if; end if; end procedure fn_get; procedure fn_contains_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable a1: mal_val_ptr := args.seq_val(1); variable found: boolean; begin hashmap_contains(a0, a1, found); new_boolean(found, result); end procedure fn_contains_q; procedure fn_keys(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to a0.seq_val'length / 2 - 1); for i in seq'range loop seq(i) := a0.seq_val(i * 2); end loop; new_seq_obj(mal_list, seq, result); end procedure fn_keys; procedure fn_vals(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to a0.seq_val'length / 2 - 1); for i in seq'range loop seq(i) := a0.seq_val(i * 2 + 1); end loop; new_seq_obj(mal_list, seq, result); end procedure fn_vals; procedure cons_helper(a0: inout mal_val_ptr; a1: inout mal_val_ptr; result: out mal_val_ptr) is variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to a1.seq_val'length); seq(0) := a0; seq(1 to seq'length - 1) := a1.seq_val(0 to a1.seq_val'length - 1); new_seq_obj(mal_list, seq, result); end procedure cons_helper; procedure fn_cons(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable a1: mal_val_ptr := args.seq_val(1); variable seq: mal_seq_ptr; begin cons_helper(a0, a1, result); end procedure fn_cons; procedure fn_sequential_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_boolean(is_sequential_type(args.seq_val(0).val_type), result); end procedure fn_sequential_q; procedure fn_concat(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable seq: mal_seq_ptr; variable i: integer; begin seq := new mal_seq(0 to -1); for i in args.seq_val'range loop seq := new mal_seq'(seq.all & args.seq_val(i).seq_val.all); end loop; 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; begin if index >= lst_seq'length then new_string("nth: index out of range", err); else result := lst_seq(index); end if; end procedure fn_nth; procedure fn_first(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); begin if a0.val_type = mal_nil or a0.seq_val'length = 0 then new_nil(result); else result := a0.seq_val(0); end if; end procedure fn_first; procedure fn_rest(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable seq: mal_seq_ptr; variable new_list: mal_val_ptr; begin if a0.val_type = mal_nil or a0.seq_val'length = 0 then seq := new mal_seq(0 to -1); new_seq_obj(mal_list, seq, result); else seq_drop_prefix(a0, 1, new_list); new_list.val_type := mal_list; result := new_list; end if; end procedure fn_rest; procedure fn_empty_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable is_empty: boolean; begin case args.seq_val(0).val_type is when mal_nil => new_boolean(true, result); when mal_list | mal_vector => new_boolean(args.seq_val(0).seq_val'length = 0, result); when others => new_string("empty?: invalid argument type", err); end case; end procedure fn_empty_q; procedure fn_count(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable count: integer; begin case args.seq_val(0).val_type is when mal_nil => new_number(0, result); when mal_list | mal_vector => new_number(args.seq_val(0).seq_val'length, result); when others => new_string("count: invalid argument type", err); end case; end procedure fn_count; procedure fn_conj(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable r: mal_val_ptr; variable seq: mal_seq_ptr; begin case a0.val_type is when mal_list => r := a0; for i in 1 to args.seq_val'high loop cons_helper(args.seq_val(i), r, r); end loop; result := r; when mal_vector => seq := new mal_seq(0 to a0.seq_val'length + args.seq_val'length - 2); seq(0 to a0.seq_val'high) := a0.seq_val(a0.seq_val'range); seq(a0.seq_val'high + 1 to seq'high) := args.seq_val(1 to args.seq_val'high); new_seq_obj(mal_vector, seq, result); when others => new_string("conj requires list or vector", err); end case; end procedure fn_conj; procedure fn_seq(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable new_seq: mal_seq_ptr; begin case a0.val_type is when mal_string => if a0.string_val'length = 0 then new_nil(result); else new_seq := new mal_seq(0 to a0.string_val'length - 1); for i in new_seq'range loop new_string("" & a0.string_val(i + 1), new_seq(i)); end loop; new_seq_obj(mal_list, new_seq, result); end if; when mal_list => if a0.seq_val'length = 0 then new_nil(result); else result := a0; end if; when mal_vector => if a0.seq_val'length = 0 then new_nil(result); else new_seq_obj(mal_list, a0.seq_val, result); end if; when mal_nil => new_nil(result); when others => new_string("seq requires string or list or vector or nil", err); end case; end procedure fn_seq; procedure fn_meta(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable meta_val: mal_val_ptr; begin meta_val := args.seq_val(0).meta_val; if meta_val = null then new_nil(result); else result := meta_val; end if; end procedure fn_meta; procedure fn_with_meta(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); begin result := new mal_val'(val_type => a0.val_type, number_val => a0.number_val, string_val => a0.string_val, seq_val => a0.seq_val, func_val => a0.func_val, meta_val => args.seq_val(1)); end procedure fn_with_meta; procedure fn_atom(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin new_atom(args.seq_val(0), result); end procedure fn_atom; procedure fn_atom_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); begin new_boolean(a0.val_type = mal_atom, result); end procedure fn_atom_q; procedure fn_deref(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); begin result := a0.seq_val(0); end procedure fn_deref; procedure fn_reset(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable a0: mal_val_ptr := args.seq_val(0); variable a1: mal_val_ptr := args.seq_val(1); begin a0.seq_val(0) := a1; result := a1; end procedure fn_reset; procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable f: line; begin if func_sym.val_type /= mal_nativefn then new_string("not a native function!", err); return; end if; f := func_sym.string_val; if f.all = "=" then fn_equal(args, result, err); elsif f.all = "throw" then fn_throw(args, result, err); elsif f.all = "nil?" then fn_nil_q(args, result, err); elsif f.all = "true?" then fn_true_q(args, result, err); elsif f.all = "false?" then fn_false_q(args, result, err); elsif f.all = "string?" then fn_string_q(args, result, err); elsif f.all = "symbol" then fn_symbol(args, result, err); elsif f.all = "symbol?" then fn_symbol_q(args, result, err); elsif f.all = "keyword" then fn_keyword(args, result, err); elsif f.all = "keyword?" then fn_keyword_q(args, result, err); elsif f.all = "number?" then fn_number_q(args, result, err); elsif f.all = "fn?" then fn_function_q(args, result, err); elsif f.all = "macro?" then fn_macro_q(args, result, err); elsif f.all = "pr-str" then fn_pr_str(args, result, err); elsif f.all = "str" then fn_str(args, result, err); elsif f.all = "prn" then fn_prn(args, result, err); elsif f.all = "println" then fn_println(args, result, err); elsif f.all = "read-string" then fn_read_string(args, result, err); elsif f.all = "readline" then fn_readline(args, result, err); elsif f.all = "slurp" then fn_slurp(args, result, err); elsif f.all = "<" then fn_lt(args, result, err); elsif f.all = "<=" then fn_lte(args, result, err); elsif f.all = ">" then fn_gt(args, result, err); elsif f.all = ">=" then fn_gte(args, result, err); elsif f.all = "+" then fn_add(args, result, err); elsif f.all = "-" then fn_sub(args, result, err); elsif f.all = "*" then fn_mul(args, result, err); elsif f.all = "/" then fn_div(args, result, err); elsif f.all = "time-ms" then fn_time_ms(args, result, err); elsif f.all = "list" then fn_list(args, result, err); elsif f.all = "list?" then fn_list_q(args, result, err); elsif f.all = "vector" then fn_vector(args, result, err); elsif f.all = "vector?" then fn_vector_q(args, result, err); elsif f.all = "hash-map" then fn_hash_map(args, result, err); elsif f.all = "map?" then fn_map_q(args, result, err); elsif f.all = "assoc" then fn_assoc(args, result, err); elsif f.all = "dissoc" then fn_dissoc(args, result, err); elsif f.all = "get" then fn_get(args, result, err); elsif f.all = "contains?" then fn_contains_q(args, result, err); elsif f.all = "keys" then fn_keys(args, result, err); elsif f.all = "vals" then fn_vals(args, result, err); 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); elsif f.all = "empty?" then fn_empty_q(args, result, err); elsif f.all = "count" then fn_count(args, result, err); elsif f.all = "conj" then fn_conj(args, result, err); elsif f.all = "seq" then fn_seq(args, result, err); elsif f.all = "meta" then fn_meta(args, result, err); elsif f.all = "with-meta" then fn_with_meta(args, result, err); elsif f.all = "atom" then fn_atom(args, result, err); elsif f.all = "atom?" then fn_atom_q(args, result, err); elsif f.all = "deref" then fn_deref(args, result, err); elsif f.all = "reset!" then fn_reset(args, result, err); else result := null; end if; end procedure eval_native_func; procedure define_core_function(e: inout env_ptr; func_name: in string) is variable sym: mal_val_ptr; variable fn: mal_val_ptr; begin new_symbol(func_name, sym); new_nativefn(func_name, fn); env_set(e, sym, fn); end procedure define_core_function; procedure define_core_functions(e: inout env_ptr) is begin define_core_function(e, "="); define_core_function(e, "throw"); define_core_function(e, "nil?"); define_core_function(e, "true?"); define_core_function(e, "false?"); define_core_function(e, "string?"); define_core_function(e, "symbol"); define_core_function(e, "symbol?"); define_core_function(e, "keyword"); define_core_function(e, "keyword?"); define_core_function(e, "number?"); define_core_function(e, "fn?"); define_core_function(e, "macro?"); define_core_function(e, "pr-str"); define_core_function(e, "str"); define_core_function(e, "prn"); define_core_function(e, "println"); define_core_function(e, "read-string"); define_core_function(e, "readline"); define_core_function(e, "slurp"); define_core_function(e, "<"); define_core_function(e, "<="); define_core_function(e, ">"); define_core_function(e, ">="); define_core_function(e, "+"); define_core_function(e, "-"); define_core_function(e, "*"); define_core_function(e, "/"); define_core_function(e, "time-ms"); define_core_function(e, "list"); define_core_function(e, "list?"); define_core_function(e, "vector"); define_core_function(e, "vector?"); define_core_function(e, "hash-map"); define_core_function(e, "map?"); define_core_function(e, "assoc"); define_core_function(e, "dissoc"); define_core_function(e, "get"); define_core_function(e, "contains?"); define_core_function(e, "keys"); define_core_function(e, "vals"); 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"); define_core_function(e, "empty?"); define_core_function(e, "count"); define_core_function(e, "apply"); -- implemented in the stepN_XXX files define_core_function(e, "map"); -- implemented in the stepN_XXX files define_core_function(e, "conj"); define_core_function(e, "seq"); define_core_function(e, "meta"); define_core_function(e, "with-meta"); define_core_function(e, "atom"); define_core_function(e, "atom?"); define_core_function(e, "deref"); define_core_function(e, "reset!"); define_core_function(e, "swap!"); -- implemented in the stepN_XXX files end procedure define_core_functions; end package body core; ================================================ FILE: impls/vhdl/env.vhdl ================================================ library STD; use STD.textio.all; library WORK; use WORK.types.all; package env is procedure new_env(e: out env_ptr; an_outer: inout env_ptr); procedure new_env(e: out env_ptr; an_outer: inout env_ptr; binds: inout mal_val_ptr; exprs: inout mal_val_ptr); procedure env_set(e: inout env_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr); procedure env_get(e : inout env_ptr; key : inout mal_val_ptr; result : out mal_val_ptr); end package env; package body env is procedure new_env(e: out env_ptr; an_outer: inout env_ptr) is variable null_list: mal_val_ptr; begin null_list := null; new_env(e, an_outer, null_list, null_list); end procedure new_env; procedure new_env(e: out env_ptr; an_outer: inout env_ptr; binds: inout mal_val_ptr; exprs: inout mal_val_ptr) is variable the_data, more_exprs: mal_val_ptr; variable i: integer; begin new_empty_hashmap(the_data); if binds /= null then for i in binds.seq_val'range loop if binds.seq_val(i).string_val.all = "&" then seq_drop_prefix(exprs, i, more_exprs); hashmap_put(the_data, binds.seq_val(i + 1), more_exprs); exit; else hashmap_put(the_data, binds.seq_val(i), exprs.seq_val(i)); end if; end loop; end if; e := new env_record'(outer => an_outer, data => the_data); end procedure new_env; procedure env_set(e: inout env_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr) is begin hashmap_put(e.data, key, val); end procedure env_set; procedure env_get(e : inout env_ptr; key : inout mal_val_ptr; result : out mal_val_ptr) is variable environment : env_ptr := e; variable val : mal_val_ptr; begin loop hashmap_get(environment.data, key, val); exit when val /= null; environment := environment.outer; exit when environment = null; end loop; result := val; return; end procedure env_get; end package body env; ================================================ FILE: impls/vhdl/pkg_readline.vhdl ================================================ library STD; use STD.textio.all; package pkg_readline is procedure mal_printstr(l: string); procedure mal_printline(l: string); procedure mal_readline(prompt: string; eof_detected: out boolean; l: inout line); end package pkg_readline; package body pkg_readline is type charfile is file of character; file stdout_char: charfile open write_mode is "STD_OUTPUT"; procedure mal_printstr(l: string) is begin for i in l'range loop write(stdout_char, l(i)); end loop; end procedure mal_printstr; procedure mal_printline(l: string) is begin mal_printstr(l); write(stdout_char, LF); end procedure mal_printline; procedure mal_readline(prompt: string; eof_detected: out boolean; l: inout line) is begin mal_printstr(prompt); if endfile(input) then eof_detected := true; else readline(input, l); eof_detected := false; end if; end procedure mal_readline; end package body pkg_readline; ================================================ FILE: impls/vhdl/printer.vhdl ================================================ library STD; use STD.textio.all; library WORK; use WORK.types.all; package printer is procedure pr_str(ast: inout mal_val_ptr; readable: in boolean; result: out line); procedure pr_seq(start_ch: in string; end_ch: in string; delim: in string; a_seq: inout mal_seq_ptr; readable: in boolean; result: out line); end package printer; package body printer is procedure pr_string(val: inout line; readable: in boolean; result: out line) is variable s: line; variable src_i, dst_i: integer; begin if readable then s := new string(1 to val'length * 2); dst_i := 0; for src_i in val'range loop dst_i := dst_i + 1; case val(src_i) is when LF => s(dst_i) := '\'; dst_i := dst_i + 1; s(dst_i) := 'n'; when '"' => s(dst_i) := '\'; dst_i := dst_i + 1; s(dst_i) := '"'; when '\' => s(dst_i) := '\'; dst_i := dst_i + 1; s(dst_i) := '\'; when others => s(dst_i) := val(src_i); end case; end loop; result := new string'("" & '"' & s(1 to dst_i) & '"'); deallocate(s); else result := val; end if; end; procedure pr_str(ast: inout mal_val_ptr; readable: in boolean; result: out line) is variable l: line; begin case ast.val_type is when mal_nil => result := new string'("nil"); when mal_true => result := new string'("true"); when mal_false => result := new string'("false"); when mal_number => write(l, ast.number_val); result := l; when mal_symbol => result := ast.string_val; when mal_string => pr_string(ast.string_val, readable, result); when mal_keyword => result := new string'(":" & ast.string_val.all); when mal_list => pr_seq("(", ")", " ", ast.seq_val, readable, result); when mal_vector => pr_seq("[", "]", " ", ast.seq_val, readable, result); when mal_hashmap => pr_seq("{", "}", " ", ast.seq_val, readable, result); when mal_atom => pr_str(ast.seq_val(0), true, l); result := new string'("(atom " & l.all & ")"); when mal_nativefn => result := new string'("#"); when mal_fn => result := new string'("#"); end case; end procedure pr_str; procedure pr_seq(start_ch: in string; end_ch: in string; delim: in string; a_seq: inout mal_seq_ptr; readable: in boolean; result: out line) is variable s, element_s: line; begin s := new string'(start_ch); for i in a_seq'range loop pr_str(a_seq(i), readable, element_s); if i = 0 then s := new string'(s.all & element_s.all); else s := new string'(s.all & delim & element_s.all); end if; end loop; s := new string'(s.all & end_ch); result := s; end procedure pr_seq; end package body printer; ================================================ FILE: impls/vhdl/reader.vhdl ================================================ library STD; use STD.textio.all; library WORK; use WORK.types.all; package reader is procedure read_str(s: in string; result: out mal_val_ptr; err: out mal_val_ptr); end package reader; package body reader is type token_list is array(natural range <>) of line; type token_list_ptr is access token_list; function is_eol_char(c: in character) return boolean is begin case c is when LF | CR => return true; when others => return false; end case; end function is_eol_char; function is_separator_char(c: in character) return boolean is begin case c is when LF | CR | ' ' | '[' | ']' | '{' | '}' | '(' | ')' | ''' | '"' | '`' | ',' | ';' => return true; when others => return false; end case; end function is_separator_char; procedure next_token(str: in string; pos: in positive; token: inout line; next_start_pos: out positive; ok: out boolean) is variable ch: character; variable tmppos: positive; begin token := new string'(""); if pos > str'length then ok := false; return; end if; ch := str(pos); case ch is when ' ' | ',' | LF | CR | HT => next_start_pos := pos + 1; token := new string'(""); ok := true; return; when '[' | ']' | '{' | '}' | '(' | ')' | ''' | '`' | '^' | '@' => next_start_pos := pos + 1; token := new string'("" & ch); ok := true; return; when '~' => if str(pos + 1) = '@' then next_start_pos := pos + 2; token := new string'("~@"); else next_start_pos := pos + 1; token := new string'("~"); end if; ok := true; return; when ';' => tmppos := pos + 1; while tmppos <= str'length and not is_eol_char(str(tmppos)) loop tmppos := tmppos + 1; end loop; next_start_pos := tmppos; token := new string'(""); ok := true; return; when '"' => tmppos := pos + 1; while tmppos < str'length and str(tmppos) /= '"' loop if str(tmppos) = '\' then tmppos := tmppos + 2; else tmppos := tmppos + 1; end if; end loop; if tmppos > str'length then tmppos := tmppos - 1; -- unterminated string, will be caught in unescape_string_token end if; token := new string(1 to (tmppos - pos + 1)); token(1 to (tmppos - pos + 1)) := str(pos to tmppos); next_start_pos := tmppos + 1; ok := true; return; when others => tmppos := pos; while tmppos <= str'length and not is_separator_char(str(tmppos)) loop tmppos := tmppos + 1; end loop; token := new string(1 to (tmppos - pos)); token(1 to (tmppos - pos)) := str(pos to tmppos - 1); next_start_pos := tmppos; ok := true; return; end case; ok := false; end procedure next_token; function tokenize(str: in string) return token_list_ptr is variable next_pos: positive := 1; variable ok: boolean := true; variable tokens: token_list_ptr; variable t: line; begin while ok loop next_token(str, next_pos, t, next_pos, ok); if t'length > 0 then if tokens = null then tokens := new token_list(0 to 0); tokens(0) := t; else tokens := new token_list'(tokens.all & t); end if; end if; end loop; return tokens; end function tokenize; type reader_class is record tokens: token_list_ptr; pos: natural; end record reader_class; procedure reader_new(r: inout reader_class; a_tokens: inout token_list_ptr) is begin r := (tokens => a_tokens, pos => 0); end procedure reader_new; procedure reader_peek(r: inout reader_class; token: out line) is begin if r.pos < r.tokens'length then token := r.tokens(r.pos); else token := null; end if; end procedure reader_peek; procedure reader_next(r: inout reader_class; token: out line) is begin reader_peek(r, token); r.pos := r.pos + 1; end procedure reader_next; -- Forward declaration procedure read_form(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr); function is_digit(c: in character) return boolean is begin case c is when '0' to '9' => return true; when others => return false; end case; end function is_digit; function unescape_char(c: in character) return character is begin case c is when 'n' => return LF; when others => return c; end case; end function unescape_char; procedure unescape_string_token(token: inout line; result: out line) is variable s: line; variable src_i, dst_i: integer; begin s := new string(1 to token'length); dst_i := 0; src_i := 2; -- skip the initial quote while src_i <= token'length - 1 loop dst_i := dst_i + 1; if token(src_i) = '\' then s(dst_i) := unescape_char(token(src_i + 1)); src_i := src_i + 2; else s(dst_i) := token(src_i); src_i := src_i + 1; end if; end loop; if src_i <= token'length then result := new string'(s(1 to dst_i)); else result := null; end if; deallocate(s); end procedure unescape_string_token; procedure read_atom(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is variable token, s: line; variable num: integer; variable ch: character; begin reader_next(r, token); if token.all = "nil" then new_nil(result); elsif token.all = "true" then new_true(result); elsif token.all = "false" then new_false(result); else ch := token(1); case ch is when '-' => if token'length > 1 and is_digit(token(2)) then read(token, num); new_number(num, result); else new_symbol(token, result); end if; when '0' to '9' => read(token, num); new_number(num, result); when ':' => s := new string(1 to token'length - 1); s(1 to s'length) := token(2 to token'length); new_keyword(s, result); when '"' => if token(token'length) /= '"' then new_string("expected '""', got EOF", err); result := null; return; end if; unescape_string_token(token, s); if s = null then new_string("expected '""', got EOF", err); result := null; return; end if; new_string(s, result); when others => new_symbol(token, result); end case; end if; end procedure read_atom; procedure read_sequence(list_type: in mal_type_tag; end_ch: in string; r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is variable token: line; variable element, sub_err: mal_val_ptr; variable seq: mal_seq_ptr; begin reader_next(r, token); -- Consume the open paren reader_peek(r, token); seq := new mal_seq(0 to -1); while token /= null and token.all /= end_ch loop read_form(r, element, sub_err); if sub_err /= null then err := sub_err; result := null; return; end if; seq := new mal_seq'(seq.all & element); reader_peek(r, token); end loop; if token = null then new_string("expected '" & end_ch & "', got EOF", err); result := null; return; end if; reader_next(r, token); -- Consume the close paren new_seq_obj(list_type, seq, result); end procedure read_sequence; procedure read_map(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is variable sub_seq, sub_err, new_map: mal_val_ptr; begin read_sequence(mal_hashmap, "}", r, sub_seq, sub_err); if sub_err = null then new_empty_hashmap(new_map); for i in 0 to sub_seq.seq_val'length / 2 - 1 loop hashmap_put(new_map, sub_seq.seq_val(2*i), sub_seq.seq_val(2*i + 1)); end loop; result := new_map; else err := sub_err; result := null; end if; end procedure read_map; procedure reader_macro(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr; sym_name: in string) is variable token, sym_line: line; variable seq: mal_seq_ptr; variable rest, rest_err: mal_val_ptr; begin reader_next(r, token); seq := new mal_seq(0 to 1); sym_line := new string'(sym_name); new_symbol(sym_line, seq(0)); read_form(r, rest, rest_err); if rest_err /= null then err := rest_err; result := null; return; end if; seq(1) := rest; new_seq_obj(mal_list, seq, result); end procedure reader_macro; procedure with_meta_reader_macro(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is variable token, sym_line: line; variable seq: mal_seq_ptr; variable meta, rest, rest_err: mal_val_ptr; begin reader_next(r, token); seq := new mal_seq(0 to 2); sym_line := new string'("with-meta"); new_symbol(sym_line, seq(0)); read_form(r, meta, rest_err); if rest_err /= null then err := rest_err; result := null; return; end if; read_form(r, rest, rest_err); if rest_err /= null then err := rest_err; result := null; return; end if; seq(1) := rest; seq(2) := meta; new_seq_obj(mal_list, seq, result); end procedure with_meta_reader_macro; procedure read_form(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is variable token: line; variable ch: character; begin reader_peek(r, token); ch := token(1); case ch is when ''' => reader_macro(r, result, err, "quote"); when '`' => reader_macro(r, result, err, "quasiquote"); when '~' => if token'length = 1 then reader_macro(r, result, err, "unquote"); else if token(2) = '@' then reader_macro(r, result, err, "splice-unquote"); else new_string("Unknown token", err); end if; end if; when '^' => with_meta_reader_macro(r, result, err); when '@' => reader_macro(r, result, err, "deref"); when '(' => read_sequence(mal_list, ")", r, result, err); when ')' => new_string("unexcepted ')'", err); when '[' => read_sequence(mal_vector, "]", r, result, err); when ']' => new_string("unexcepted ']'", err); when '{' => read_map(r, result, err); when '}' => new_string("unexcepted '}'", err); when others => read_atom(r, result, err); end case; end procedure read_form; procedure read_str(s: in string; result: out mal_val_ptr; err: out mal_val_ptr) is variable tokens: token_list_ptr; variable r: reader_class; begin tokens := tokenize(s); if tokens = null or tokens'length = 0 then result := null; err := null; return; end if; reader_new(r, tokens); read_form(r, result, err); end procedure read_str; end package body reader; ================================================ FILE: impls/vhdl/run ================================================ #!/usr/bin/env bash exec $(dirname $0)/run_vhdl.sh $(dirname $0)/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/vhdl/run_vhdl.sh ================================================ #!/usr/bin/env bash # ghdl doesn't allow passing command-line arguments to the VHDL program. To # circumvent that, we write the command-line arguments as lines in # vhdl_argv.tmp, and read the content of that file at the beginning of the VHDL # program. cleanup() { trap - TERM QUIT INT EXIT rm -f vhdl_argv.tmp } trap "cleanup" TERM QUIT INT EXIT bin="$1" shift for arg in "$@" ; do echo "$arg" done > vhdl_argv.tmp $bin ================================================ FILE: impls/vhdl/step0_repl.vhdl ================================================ entity step0_repl is end entity step0_repl; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; architecture test of step0_repl is function mal_READ(str: in string) return string is begin return str; end function mal_READ; function EVAL(ast: in string; env: in string) return string is begin return ast; end function EVAL; function mal_PRINT(exp: in string) return string is begin return exp; end function mal_PRINT; function REP(str: in string) return string is begin return mal_PRINT(EVAL(mal_READ(str), "")); end function REP; procedure repl is variable is_eof: boolean; variable input_line: line; begin loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; mal_printline(REP(input_line.all)); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step1_read_print.vhdl ================================================ entity step1_read_print is end entity step1_read_print; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; architecture test of step1_read_print is procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; procedure EVAL(ast: inout mal_val_ptr; env: in string; result: out mal_val_ptr) is begin result := ast; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure REP(str: in string; result: out line; err: out mal_val_ptr) is variable ast, eval_res, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, "", eval_res); mal_PRINT(eval_res, result); end procedure REP; procedure repl is variable is_eof: boolean; variable input_line, result: line; variable err: mal_val_ptr; begin loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step2_eval.vhdl ================================================ entity step2_eval is end entity step2_eval; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; architecture test of step2_eval is procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; -- Forward declaration procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is variable num_result: integer; variable a: mal_seq_ptr; begin a := args.seq_val; if func_sym.string_val.all = "+" then new_number(a(0).number_val + a(1).number_val, result); elsif func_sym.string_val.all = "-" then new_number(a(0).number_val - a(1).number_val, result); elsif func_sym.string_val.all = "*" then new_number(a(0).number_val * a(1).number_val, result); elsif func_sym.string_val.all = "/" then new_number(a(0).number_val / a(1).number_val, result); else result := null; end if; end procedure eval_native_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout mal_val_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(ast : inout mal_val_ptr; env : inout mal_val_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable key, val, eval_err, call_args, sub_err, fn: mal_val_ptr; variable new_seq: mal_seq_ptr; -- variable s: line; variable i: integer; begin -- mal_printstr("EVAL: "); -- pr_str(ast, true, s); -- mal_printline(s.all); case ast.val_type is when mal_symbol => new_string(ast.string_val, key); hashmap_get(env, key, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; EVAL(ast.seq_val(0), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); eval_native_func(fn, call_args, result); end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure REP(str: in string; env: inout mal_val_ptr; result: out line; err: out mal_val_ptr) is variable ast, eval_res, read_err, eval_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure repl is variable is_eof: boolean; variable input_line, result: line; variable repl_seq: mal_seq_ptr; variable repl_env, err: mal_val_ptr; begin repl_seq := new mal_seq(0 to 7); new_string("+", repl_seq(0)); new_nativefn("+", repl_seq(1)); new_string("-", repl_seq(2)); new_nativefn("-", repl_seq(3)); new_string("*", repl_seq(4)); new_nativefn("*", repl_seq(5)); new_string("/", repl_seq(6)); new_nativefn("/", repl_seq(7)); new_seq_obj(mal_hashmap, repl_seq, repl_env); loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step3_env.vhdl ================================================ entity step3_env is end entity step3_env; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; architecture test of step3_env is procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; -- Forward declaration procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is variable num_result: integer; variable a: mal_seq_ptr; begin a := args.seq_val; if func_sym.string_val.all = "+" then new_number(a(0).number_val + a(1).number_val, result); elsif func_sym.string_val.all = "-" then new_number(a(0).number_val - a(1).number_val, result); elsif func_sym.string_val.all = "*" then new_number(a(0).number_val * a(1).number_val, result); elsif func_sym.string_val.all = "/" then new_number(a(0).number_val / a(1).number_val, result); else result := null; end if; end procedure eval_native_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(ast : inout mal_val_ptr; env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable let_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; deallocate(let_env); return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; EVAL(ast.seq_val(2), let_env, result, err); deallocate(let_env); else EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); eval_native_func(fn, call_args, result); end if; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable ast, eval_res, read_err, eval_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure repl is variable is_eof: boolean; variable input_line, result: line; variable sym, fn, err: mal_val_ptr; variable outer, repl_env: env_ptr; begin outer := null; new_env(repl_env, outer); new_symbol("+", sym); new_nativefn("+", fn); env_set(repl_env, sym, fn); new_symbol("-", sym); new_nativefn("-", fn); env_set(repl_env, sym, fn); new_symbol("*", sym); new_nativefn("*", fn); env_set(repl_env, sym, fn); new_symbol("/", sym); new_nativefn("/", fn); env_set(repl_env, sym, fn); loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step4_if_fn_do.vhdl ================================================ entity step4_if_fn_do is end entity step4_if_fn_do; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step4_if_fn_do is procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; -- Forward declaration procedure EVAL(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(ast : inout mal_val_ptr; env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable let_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; EVAL(ast.seq_val(2), let_env, result, err); return; elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; return; elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then EVAL(ast.seq_val(3), env, result, err); else new_nil(result); end if; else EVAL(ast.seq_val(2), env, result, err); end if; return; elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); case fn.val_type is when mal_nativefn => eval_native_func(fn, call_args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); end case; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure repl is variable is_eof: boolean; variable input_line, result: line; variable dummy_val, err: mal_val_ptr; variable outer, repl_env: env_ptr; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step5_tco.vhdl ================================================ entity step5_tco is end entity step5_tco; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step5_tco is procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; -- Forward declaration procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); case fn.val_type is when mal_nativefn => eval_native_func(fn, call_args, result, err); return; when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO when others => new_string("not a function", err); return; end case; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure repl is variable is_eof: boolean; variable input_line, result: line; variable dummy_val, err: mal_val_ptr; variable outer, repl_env: env_ptr; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step6_file.vhdl ================================================ entity step6_file is end entity step6_file; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step6_file is shared variable repl_env: env_ptr; procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; -- Forward declaration procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); end procedure fn_eval; procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable atom: mal_val_ptr := args.seq_val(0); variable fn: mal_val_ptr := args.seq_val(1); variable call_args_seq: mal_seq_ptr; variable call_args, eval_res, sub_err: mal_val_ptr; begin call_args_seq := new mal_seq(0 to args.seq_val'length - 2); call_args_seq(0) := atom.seq_val(0); call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, eval_res, sub_err); if sub_err /= null then err := sub_err; return; end if; atom.seq_val(0) := eval_res; result := eval_res; end procedure fn_swap; procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin if func_sym.string_val.all = "eval" then fn_eval(args, result, err); elsif func_sym.string_val.all = "swap!" then fn_swap(args, result, err); else eval_native_func(func_sym, args, result, err); end if; end procedure apply_native_func; procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn_env: env_ptr; begin case fn.val_type is when mal_nativefn => apply_native_func(fn, args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); return; end case; end procedure apply_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); -- Special-case functions for TCO if fn.val_type = mal_fn then new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO end if; apply_func(fn, call_args, result, err); return; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure set_argv(e: inout env_ptr; program_file: inout line) is variable argv_var_name: string(1 to 6) := "*ARGV*"; variable argv_sym, argv_list: mal_val_ptr; file f: text; variable status: file_open_status; variable one_line: line; variable seq: mal_seq_ptr; variable element: mal_val_ptr; begin program_file := null; seq := new mal_seq(0 to -1); file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); if status = open_ok then if not endfile(f) then readline(f, program_file); while not endfile(f) loop readline(f, one_line); new_string(one_line.all, element); seq := new mal_seq'(seq.all & element); end loop; end if; file_close(f); end if; new_seq_obj(mal_list, seq, argv_list); new_symbol(argv_var_name, argv_sym); env_set(e, argv_sym, argv_list); end procedure set_argv; procedure repl is variable is_eof: boolean; variable program_file, input_line, result: line; variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; variable outer: env_ptr; variable eval_func_name: string(1 to 4) := "eval"; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); new_symbol(eval_func_name, eval_sym); new_nativefn(eval_func_name, eval_fn); env_set(repl_env, eval_sym, eval_fn); set_argv(repl_env, program_file); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); if program_file /= null then REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); return; end if; loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step7_quote.vhdl ================================================ entity step7_quote is end entity step7_quote; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step7_quote is shared variable repl_env: env_ptr; procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; procedure starts_with(lst : inout mal_val_ptr; sym : in string; res : out boolean) is begin 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; -- 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 if sw then starts_with(elt, "splice-unquote", sw); end if; if sw then new_symbol("concat", seq(0)); seq(1) := elt.seq_val(1); else 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 procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); end procedure fn_eval; procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable atom: mal_val_ptr := args.seq_val(0); variable fn: mal_val_ptr := args.seq_val(1); variable call_args_seq: mal_seq_ptr; variable call_args, eval_res, sub_err: mal_val_ptr; begin call_args_seq := new mal_seq(0 to args.seq_val'length - 2); call_args_seq(0) := atom.seq_val(0); call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, eval_res, sub_err); if sub_err /= null then err := sub_err; return; end if; atom.seq_val(0) := eval_res; result := eval_res; end procedure fn_swap; procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin if func_sym.string_val.all = "eval" then fn_eval(args, result, err); elsif func_sym.string_val.all = "swap!" then fn_swap(args, result, err); else eval_native_func(func_sym, args, result, err); end if; end procedure apply_native_func; procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn_env: env_ptr; begin case fn.val_type is when mal_nativefn => apply_native_func(fn, args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); return; end case; end procedure apply_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "quote" then result := ast.seq_val(1); return; elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); -- Special-case functions for TCO if fn.val_type = mal_fn then new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO end if; apply_func(fn, call_args, result, err); return; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure set_argv(e: inout env_ptr; program_file: inout line) is variable argv_var_name: string(1 to 6) := "*ARGV*"; variable argv_sym, argv_list: mal_val_ptr; file f: text; variable status: file_open_status; variable one_line: line; variable seq: mal_seq_ptr; variable element: mal_val_ptr; begin program_file := null; seq := new mal_seq(0 to -1); file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); if status = open_ok then if not endfile(f) then readline(f, program_file); while not endfile(f) loop readline(f, one_line); new_string(one_line.all, element); seq := new mal_seq'(seq.all & element); end loop; end if; file_close(f); end if; new_seq_obj(mal_list, seq, argv_list); new_symbol(argv_var_name, argv_sym); env_set(e, argv_sym, argv_list); end procedure set_argv; procedure repl is variable is_eof: boolean; variable program_file, input_line, result: line; variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; variable outer: env_ptr; variable eval_func_name: string(1 to 4) := "eval"; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); new_symbol(eval_func_name, eval_sym); new_nativefn(eval_func_name, eval_fn); env_set(repl_env, eval_sym, eval_fn); set_argv(repl_env, program_file); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); if program_file /= null then REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); return; end if; loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step8_macros.vhdl ================================================ entity step8_macros is end entity step8_macros; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step8_macros is shared variable repl_env: env_ptr; procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; procedure starts_with(lst : inout mal_val_ptr; sym : in string; res : out boolean) is begin 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; -- 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 if sw then starts_with(elt, "splice-unquote", sw); end if; if sw then new_symbol("concat", seq(0)); seq(1) := elt.seq_val(1); else 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 procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); end procedure fn_eval; procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable atom: mal_val_ptr := args.seq_val(0); variable fn: mal_val_ptr := args.seq_val(1); variable call_args_seq: mal_seq_ptr; variable call_args, eval_res, sub_err: mal_val_ptr; begin call_args_seq := new mal_seq(0 to args.seq_val'length - 2); call_args_seq(0) := atom.seq_val(0); call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, eval_res, sub_err); if sub_err /= null then err := sub_err; return; end if; atom.seq_val(0) := eval_res; result := eval_res; end procedure fn_swap; procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin if func_sym.string_val.all = "eval" then fn_eval(args, result, err); elsif func_sym.string_val.all = "swap!" then fn_swap(args, result, err); else eval_native_func(func_sym, args, result, err); end if; end procedure apply_native_func; procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn_env: env_ptr; begin case fn.val_type is when mal_nativefn => apply_native_func(fn, args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); return; end case; end procedure apply_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "quote" then result := ast.seq_val(1); return; elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO elsif a0.string_val.all = "defmacro!" then EVAL(ast.seq_val(2), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); val.func_val.f_is_macro := true; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Special-case macros if fn.val_type = mal_fn and fn.func_val.f_is_macro then seq_drop_prefix(ast, 1, call_args); apply_func(fn, call_args, ast, sub_err); if sub_err /= null then err := sub_err; return; end if; next; -- TCO end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); -- Special-case functions for TCO if fn.val_type = mal_fn then new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO end if; apply_func(fn, call_args, result, err); return; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure set_argv(e: inout env_ptr; program_file: inout line) is variable argv_var_name: string(1 to 6) := "*ARGV*"; variable argv_sym, argv_list: mal_val_ptr; file f: text; variable status: file_open_status; variable one_line: line; variable seq: mal_seq_ptr; variable element: mal_val_ptr; begin program_file := null; seq := new mal_seq(0 to -1); file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); if status = open_ok then if not endfile(f) then readline(f, program_file); while not endfile(f) loop readline(f, one_line); new_string(one_line.all, element); seq := new mal_seq'(seq.all & element); end loop; end if; file_close(f); end if; new_seq_obj(mal_list, seq, argv_list); new_symbol(argv_var_name, argv_sym); env_set(e, argv_sym, argv_list); end procedure set_argv; procedure repl is variable is_eof: boolean; variable program_file, input_line, result: line; variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; variable outer: env_ptr; variable eval_func_name: string(1 to 4) := "eval"; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); new_symbol(eval_func_name, eval_sym); new_nativefn(eval_func_name, eval_fn); env_set(repl_env, eval_sym, eval_fn); set_argv(repl_env, program_file); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); if program_file /= null then REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); return; end if; loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/step9_try.vhdl ================================================ entity step9_try is end entity step9_try; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of step9_try is shared variable repl_env: env_ptr; procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; procedure starts_with(lst : inout mal_val_ptr; sym : in string; res : out boolean) is begin 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; -- 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 if sw then starts_with(elt, "splice-unquote", sw); end if; if sw then new_symbol("concat", seq(0)); seq(1) := elt.seq_val(1); else 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 procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); end procedure fn_eval; procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable atom: mal_val_ptr := args.seq_val(0); variable fn: mal_val_ptr := args.seq_val(1); variable call_args_seq: mal_seq_ptr; variable call_args, eval_res, sub_err: mal_val_ptr; begin call_args_seq := new mal_seq(0 to args.seq_val'length - 2); call_args_seq(0) := atom.seq_val(0); call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, eval_res, sub_err); if sub_err /= null then err := sub_err; return; end if; atom.seq_val(0) := eval_res; result := eval_res; end procedure fn_swap; procedure fn_apply(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn: mal_val_ptr := args.seq_val(0); variable rest: mal_val_ptr; variable mid_args_count, rest_args_count: integer; variable call_args: mal_val_ptr; variable call_args_seq: mal_seq_ptr; begin rest := args.seq_val(args.seq_val'high); mid_args_count := args.seq_val'length - 2; rest_args_count := rest.seq_val'length; call_args_seq := new mal_seq(0 to mid_args_count + rest_args_count - 1); call_args_seq(0 to mid_args_count - 1) := args.seq_val(1 to args.seq_val'length - 2); call_args_seq(mid_args_count to call_args_seq'high) := rest.seq_val(rest.seq_val'range); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, result, err); end procedure fn_apply; procedure fn_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn: mal_val_ptr := args.seq_val(0); variable lst: mal_val_ptr := args.seq_val(1); variable call_args, sub_err: mal_val_ptr; variable new_seq: mal_seq_ptr; variable i: integer; begin new_seq := new mal_seq(lst.seq_val'range); -- (0 to lst.seq_val.length - 1); for i in new_seq'range loop new_one_element_list(lst.seq_val(i), call_args); apply_func(fn, call_args, new_seq(i), sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; new_seq_obj(mal_list, new_seq, result); end procedure fn_map; procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin if func_sym.string_val.all = "eval" then fn_eval(args, result, err); elsif func_sym.string_val.all = "swap!" then fn_swap(args, result, err); elsif func_sym.string_val.all = "apply" then fn_apply(args, result, err); elsif func_sym.string_val.all = "map" then fn_map(args, result, err); else eval_native_func(func_sym, args, result, err); end if; end procedure apply_native_func; procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn_env: env_ptr; begin case fn.val_type is when mal_nativefn => apply_native_func(fn, args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); return; end case; end procedure apply_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, catch_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "quote" then result := ast.seq_val(1); return; elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO elsif a0.string_val.all = "defmacro!" then EVAL(ast.seq_val(2), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); val.func_val.f_is_macro := true; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "try*" then EVAL(ast.seq_val(1), env, result, sub_err); if sub_err /= null then if ast.seq_val'length > 2 and ast.seq_val(2).val_type = mal_list and ast.seq_val(2).seq_val(0).val_type = mal_symbol and ast.seq_val(2).seq_val(0).string_val.all = "catch*" then new_one_element_list(ast.seq_val(2).seq_val(1), vars); new_one_element_list(sub_err, call_args); new_env(catch_env, env, vars, call_args); EVAL(ast.seq_val(2).seq_val(2), catch_env, result, err); else err := sub_err; return; end if; end if; return; elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Special-case macros if fn.val_type = mal_fn and fn.func_val.f_is_macro then seq_drop_prefix(ast, 1, call_args); apply_func(fn, call_args, ast, sub_err); if sub_err /= null then err := sub_err; return; end if; next; -- TCO end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); -- Special-case functions for TCO if fn.val_type = mal_fn then new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO end if; apply_func(fn, call_args, result, err); return; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure set_argv(e: inout env_ptr; program_file: inout line) is variable argv_var_name: string(1 to 6) := "*ARGV*"; variable argv_sym, argv_list: mal_val_ptr; file f: text; variable status: file_open_status; variable one_line: line; variable seq: mal_seq_ptr; variable element: mal_val_ptr; begin program_file := null; seq := new mal_seq(0 to -1); file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); if status = open_ok then if not endfile(f) then readline(f, program_file); while not endfile(f) loop readline(f, one_line); new_string(one_line.all, element); seq := new mal_seq'(seq.all & element); end loop; end if; file_close(f); end if; new_seq_obj(mal_list, seq, argv_list); new_symbol(argv_var_name, argv_sym); env_set(e, argv_sym, argv_list); end procedure set_argv; procedure repl is variable is_eof: boolean; variable program_file, input_line, result: line; variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; variable outer: env_ptr; variable eval_func_name: string(1 to 4) := "eval"; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); new_symbol(eval_func_name, eval_sym); new_nativefn(eval_func_name, eval_fn); env_set(repl_env, eval_sym, eval_fn); set_argv(repl_env, program_file); -- core.mal: defined using the language itself RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); if program_file /= null then REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); return; end if; loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/stepA_mal.vhdl ================================================ entity stepA_mal is end entity stepA_mal; library STD; use STD.textio.all; library WORK; use WORK.pkg_readline.all; use WORK.types.all; use WORK.printer.all; use WORK.reader.all; use WORK.env.all; use WORK.core.all; architecture test of stepA_mal is shared variable repl_env: env_ptr; procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is begin read_str(str, ast, err); end procedure mal_READ; procedure starts_with(lst : inout mal_val_ptr; sym : in string; res : out boolean) is begin 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; -- 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 if sw then starts_with(elt, "splice-unquote", sw); end if; if sw then new_symbol("concat", seq(0)); seq(1) := elt.seq_val(1); else 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 procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); end procedure fn_eval; procedure fn_swap(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable atom: mal_val_ptr := args.seq_val(0); variable fn: mal_val_ptr := args.seq_val(1); variable call_args_seq: mal_seq_ptr; variable call_args, eval_res, sub_err: mal_val_ptr; begin call_args_seq := new mal_seq(0 to args.seq_val'length - 2); call_args_seq(0) := atom.seq_val(0); call_args_seq(1 to call_args_seq'length - 1) := args.seq_val(2 to args.seq_val'length - 1); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, eval_res, sub_err); if sub_err /= null then err := sub_err; return; end if; atom.seq_val(0) := eval_res; result := eval_res; end procedure fn_swap; procedure fn_apply(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn: mal_val_ptr := args.seq_val(0); variable rest: mal_val_ptr; variable mid_args_count, rest_args_count: integer; variable call_args: mal_val_ptr; variable call_args_seq: mal_seq_ptr; begin rest := args.seq_val(args.seq_val'high); mid_args_count := args.seq_val'length - 2; rest_args_count := rest.seq_val'length; call_args_seq := new mal_seq(0 to mid_args_count + rest_args_count - 1); call_args_seq(0 to mid_args_count - 1) := args.seq_val(1 to args.seq_val'length - 2); call_args_seq(mid_args_count to call_args_seq'high) := rest.seq_val(rest.seq_val'range); new_seq_obj(mal_list, call_args_seq, call_args); apply_func(fn, call_args, result, err); end procedure fn_apply; procedure fn_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn: mal_val_ptr := args.seq_val(0); variable lst: mal_val_ptr := args.seq_val(1); variable call_args, sub_err: mal_val_ptr; variable new_seq: mal_seq_ptr; variable i: integer; begin new_seq := new mal_seq(lst.seq_val'range); -- (0 to lst.seq_val.length - 1); for i in new_seq'range loop new_one_element_list(lst.seq_val(i), call_args); apply_func(fn, call_args, new_seq(i), sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; new_seq_obj(mal_list, new_seq, result); end procedure fn_map; procedure apply_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin if func_sym.string_val.all = "eval" then fn_eval(args, result, err); elsif func_sym.string_val.all = "swap!" then fn_swap(args, result, err); elsif func_sym.string_val.all = "apply" then fn_apply(args, result, err); elsif func_sym.string_val.all = "map" then fn_map(args, result, err); else eval_native_func(func_sym, args, result, err); end if; end procedure apply_native_func; procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable fn_env: env_ptr; begin case fn.val_type is when mal_nativefn => apply_native_func(fn, args, result, err); when mal_fn => new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, args); EVAL(fn.func_val.f_body, fn_env, result, err); when others => new_string("not a function", err); return; end case; end procedure apply_func; procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; skip : in natural; env : inout env_ptr; result : inout mal_seq_ptr; err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; end if; end loop; end procedure eval_ast_seq; procedure EVAL(in_ast : inout mal_val_ptr; in_env : inout env_ptr; result : out mal_val_ptr; err : out mal_val_ptr) is variable val, eval_err, a0, call_args, vars, fn, sub_err: mal_val_ptr; variable ast : mal_val_ptr := in_ast; variable env : env_ptr := in_env; variable let_env, catch_env, fn_env : env_ptr; variable s: line; variable new_seq: mal_seq_ptr; variable i: integer; begin loop new_symbol("DEBUG-EVAL", a0); env_get(env, a0, val); if val /= null and val.val_type /= mal_nil and val.val_type /= mal_false then mal_printstr("EVAL: "); pr_str(ast, true, s); mal_printline(s.all); end if; case ast.val_type is when mal_symbol => env_get(env, ast, val); if val = null then new_string("'" & ast.string_val.all & "' not found", err); return; end if; result := val; return; when mal_list => null; when mal_vector | mal_hashmap => eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; end if; new_seq_obj(ast.val_type, new_seq, result); return; when others => result := ast; return; end case; if ast.seq_val'length = 0 then result := ast; return; end if; a0 := ast.seq_val(0); if a0.val_type = mal_symbol then if a0.string_val.all = "def!" then EVAL(ast.seq_val(2), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "let*" then vars := ast.seq_val(1); new_env(let_env, env); i := 0; while i < vars.seq_val'length loop EVAL(vars.seq_val(i + 1), let_env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; env_set(let_env, vars.seq_val(i), val); i := i + 2; end loop; env := let_env; ast := ast.seq_val(2); next; -- TCO elsif a0.string_val.all = "quote" then result := ast.seq_val(1); return; elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO elsif a0.string_val.all = "defmacro!" then EVAL(ast.seq_val(2), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; new_fn(fn.func_val.f_body, fn.func_val.f_args, fn.func_val.f_env, val); val.func_val.f_is_macro := true; env_set(env, ast.seq_val(1), val); result := val; return; elsif a0.string_val.all = "try*" then EVAL(ast.seq_val(1), env, result, sub_err); if sub_err /= null then if ast.seq_val'length > 2 and ast.seq_val(2).val_type = mal_list and ast.seq_val(2).seq_val(0).val_type = mal_symbol and ast.seq_val(2).seq_val(0).string_val.all = "catch*" then new_one_element_list(ast.seq_val(2).seq_val(1), vars); new_one_element_list(sub_err, call_args); new_env(catch_env, env, vars, call_args); EVAL(ast.seq_val(2).seq_val(2), catch_env, result, err); else err := sub_err; return; end if; end if; return; elsif a0.string_val.all = "do" then for i in 1 to ast.seq_val'high - 1 loop EVAL(ast.seq_val(i), env, result, sub_err); if sub_err /= null then err := sub_err; return; end if; end loop; ast := ast.seq_val(ast.seq_val'high); next; -- TCO elsif a0.string_val.all = "if" then EVAL(ast.seq_val(1), env, val, sub_err); if sub_err /= null then err := sub_err; return; end if; if val.val_type = mal_nil or val.val_type = mal_false then if ast.seq_val'length > 3 then ast := ast.seq_val(3); else new_nil(result); return; end if; else ast := ast.seq_val(2); end if; next; -- TCO elsif a0.string_val.all = "fn*" then new_fn(ast.seq_val(2), ast.seq_val(1), env, result); return; end if; end if; EVAL (a0, env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; -- Special-case macros if fn.val_type = mal_fn and fn.func_val.f_is_macro then seq_drop_prefix(ast, 1, call_args); apply_func(fn, call_args, ast, sub_err); if sub_err /= null then err := sub_err; return; end if; next; -- TCO end if; -- Evaluate arguments eval_ast_seq(ast.seq_val, 1, env, new_seq, sub_err); if sub_err /= null then err := sub_err; return; end if; new_seq_obj(mal_list, new_seq, call_args); -- Special-case functions for TCO if fn.val_type = mal_fn then new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; next; -- TCO end if; apply_func(fn, call_args, result, err); return; end loop; end procedure EVAL; procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is begin pr_str(exp, true, result); end procedure mal_PRINT; procedure RE(str: in string; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable ast, read_err: mal_val_ptr; begin mal_READ(str, ast, read_err); if read_err /= null then err := read_err; result := null; return; end if; if ast = null then result := null; return; end if; EVAL(ast, env, result, err); end procedure RE; procedure REP(str: in string; env: inout env_ptr; result: out line; err: out mal_val_ptr) is variable eval_res, eval_err: mal_val_ptr; begin RE(str, env, eval_res, eval_err); if eval_err /= null then err := eval_err; result := null; return; end if; mal_PRINT(eval_res, result); end procedure REP; procedure set_argv(e: inout env_ptr; program_file: inout line) is variable argv_var_name: string(1 to 6) := "*ARGV*"; variable argv_sym, argv_list: mal_val_ptr; file f: text; variable status: file_open_status; variable one_line: line; variable seq: mal_seq_ptr; variable element: mal_val_ptr; begin program_file := null; seq := new mal_seq(0 to -1); file_open(status, f, external_name => "vhdl_argv.tmp", open_kind => read_mode); if status = open_ok then if not endfile(f) then readline(f, program_file); while not endfile(f) loop readline(f, one_line); new_string(one_line.all, element); seq := new mal_seq'(seq.all & element); end loop; end if; file_close(f); end if; new_seq_obj(mal_list, seq, argv_list); new_symbol(argv_var_name, argv_sym); env_set(e, argv_sym, argv_list); end procedure set_argv; procedure repl is variable is_eof: boolean; variable program_file, input_line, result: line; variable eval_sym, eval_fn, dummy_val, err: mal_val_ptr; variable outer: env_ptr; variable eval_func_name: string(1 to 4) := "eval"; begin outer := null; new_env(repl_env, outer); -- core.EXT: defined using VHDL (see core.vhdl) define_core_functions(repl_env); new_symbol(eval_func_name, eval_sym); new_nativefn(eval_func_name, eval_fn); env_set(repl_env, eval_sym, eval_fn); set_argv(repl_env, program_file); -- core.mal: defined using the language itself RE("(def! *host-language* " & '"' & "vhdl" & '"' & ")", repl_env, dummy_val, err); RE("(def! not (fn* (a) (if a false true)))", repl_env, dummy_val, err); RE("(def! load-file (fn* (f) (eval (read-string (str " & '"' & "(do " & '"' & " (slurp f) " & '"' & "\nnil)" & '"' & ")))))", repl_env, dummy_val, err); RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw " & '"' & "odd number of forms to cond" & '"' & ")) (cons 'cond (rest (rest xs)))))))", repl_env, dummy_val, err); if program_file /= null then REP("(load-file " & '"' & program_file.all & '"' & ")", repl_env, result, err); return; end if; RE("(println (str " & '"' & "Mal [" & '"' & " *host-language* " & '"' & "]" & '"' & "))", repl_env, dummy_val, err); loop mal_readline("user> ", is_eof, input_line); exit when is_eof; next when input_line'length = 0; REP(input_line.all, repl_env, result, err); if err /= null then pr_str(err, false, result); result := new string'("Error: " & result.all); end if; if result /= null then mal_printline(result.all); end if; deallocate(result); deallocate(err); end loop; mal_printline(""); end procedure repl; begin repl; end architecture test; ================================================ FILE: impls/vhdl/types.vhdl ================================================ library STD; use STD.textio.all; package types is procedure debugline(l: inout line); procedure debug(str: in string); procedure debug(ch: in character); procedure debug(i: in integer); type mal_type_tag is (mal_nil, mal_true, mal_false, mal_number, mal_symbol, mal_string, mal_keyword, mal_list, mal_vector, mal_hashmap, mal_atom, mal_nativefn, mal_fn); -- Forward declarations type mal_val; type mal_seq; type mal_func; type env_record; type mal_val_ptr is access mal_val; type mal_seq_ptr is access mal_seq; type mal_func_ptr is access mal_func; type env_ptr is access env_record; type mal_val is record val_type: mal_type_tag; number_val: integer; -- For types: number string_val: line; -- For types: symbol, string, keyword, nativefn seq_val: mal_seq_ptr; -- For types: list, vector, hashmap, atom func_val: mal_func_ptr; -- For fn meta_val: mal_val_ptr; end record mal_val; type mal_seq is array (natural range <>) of mal_val_ptr; type mal_func is record f_body: mal_val_ptr; f_args: mal_val_ptr; f_env: env_ptr; f_is_macro: boolean; end record mal_func; type env_record is record outer: env_ptr; data: mal_val_ptr; end record env_record; procedure new_nil(obj: out mal_val_ptr); procedure new_true(obj: out mal_val_ptr); procedure new_false(obj: out mal_val_ptr); procedure new_boolean(b: in boolean; obj: out mal_val_ptr); procedure new_number(v: in integer; obj: out mal_val_ptr); procedure new_symbol(name: in string; obj: out mal_val_ptr); procedure new_symbol(name: inout line; obj: out mal_val_ptr); procedure new_string(name: in string; obj: out mal_val_ptr); procedure new_string(name: inout line; obj: out mal_val_ptr); procedure new_keyword(name: in string; obj: out mal_val_ptr); procedure new_keyword(name: inout line; obj: out mal_val_ptr); procedure new_nativefn(name: in string; obj: out mal_val_ptr); procedure new_fn(body_ast: inout mal_val_ptr; args: inout mal_val_ptr; env: inout env_ptr; obj: out mal_val_ptr); procedure new_seq_obj(seq_type: in mal_type_tag; seq: inout mal_seq_ptr; obj: out mal_val_ptr); procedure new_one_element_list(val: inout mal_val_ptr; obj: out mal_val_ptr); procedure new_empty_hashmap(obj: out mal_val_ptr); procedure new_atom(val: inout mal_val_ptr; obj: out mal_val_ptr); procedure hashmap_copy(hashmap: inout mal_val_ptr; obj: out mal_val_ptr); procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr); procedure hashmap_contains(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; ok: out boolean); procedure hashmap_put(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr); procedure hashmap_delete(hashmap: inout mal_val_ptr; key: inout mal_val_ptr); procedure seq_drop_prefix(src: inout mal_val_ptr; prefix_length: in integer; result: out mal_val_ptr); function is_sequential_type(t: in mal_type_tag) return boolean; procedure equal_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean); end package types; package body types is procedure debugline(l: inout line) is variable l2: line; begin l2 := new string(1 to 7 + l'length); l2(1 to l2'length) := "DEBUG: " & l.all; writeline(output, l2); end procedure debugline; procedure debug(str: in string) is variable d: line; begin write(d, str); debugline(d); end procedure debug; procedure debug(ch: in character) is variable d: line; begin write(d, ch); debugline(d); end procedure debug; procedure debug(i: in integer) is variable d: line; begin write(d, i); debugline(d); end procedure debug; procedure new_nil(obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_nil, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); end procedure new_nil; procedure new_true(obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_true, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); end procedure new_true; procedure new_false(obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_false, number_val => 0, string_val => null, seq_val => null, func_val => null, meta_val => null); end procedure new_false; procedure new_boolean(b: in boolean; obj: out mal_val_ptr) is begin if b then new_true(obj); else new_false(obj); end if; end procedure new_boolean; procedure new_number(v: in integer; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_number, number_val => v, string_val => null, seq_val => null, func_val => null, meta_val => null); end procedure new_number; procedure new_symbol(name: in string; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_symbol, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); end procedure new_symbol; procedure new_symbol(name: inout line; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_symbol, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); end procedure new_symbol; procedure new_string(name: in string; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_string, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); end procedure new_string; procedure new_string(name: inout line; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_string, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); end procedure new_string; procedure new_keyword(name: in string; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_keyword, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); end procedure new_keyword; procedure new_keyword(name: inout line; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_keyword, number_val => 0, string_val => name, seq_val => null, func_val => null, meta_val => null); end procedure new_keyword; procedure new_nativefn(name: in string; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => mal_nativefn, number_val => 0, string_val => new string'(name), seq_val => null, func_val => null, meta_val => null); end procedure new_nativefn; procedure new_fn(body_ast: inout mal_val_ptr; args: inout mal_val_ptr; env: inout env_ptr; obj: out mal_val_ptr) is variable f: mal_func_ptr; begin f := new mal_func'(f_body => body_ast, f_args => args, f_env => env, f_is_macro => false); obj := new mal_val'(val_type => mal_fn, number_val => 0, string_val => null, seq_val => null, func_val => f, meta_val => null); end procedure new_fn; procedure new_seq_obj(seq_type: in mal_type_tag; seq: inout mal_seq_ptr; obj: out mal_val_ptr) is begin obj := new mal_val'(val_type => seq_type, number_val => 0, string_val => null, seq_val => seq, func_val => null, meta_val => null); end procedure new_seq_obj; procedure new_one_element_list(val: inout mal_val_ptr; obj: out mal_val_ptr) is variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to 0); seq(0) := val; new_seq_obj(mal_list, seq, obj); end procedure new_one_element_list; procedure new_empty_hashmap(obj: out mal_val_ptr) is variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to -1); new_seq_obj(mal_hashmap, seq, obj); end procedure new_empty_hashmap; procedure new_atom(val: inout mal_val_ptr; obj: out mal_val_ptr) is variable atom_seq: mal_seq_ptr; begin atom_seq := new mal_seq(0 to 0); atom_seq(0) := val; new_seq_obj(mal_atom, atom_seq, obj); end procedure new_atom; procedure hashmap_copy(hashmap: inout mal_val_ptr; obj: out mal_val_ptr) is variable new_seq: mal_seq_ptr; begin new_seq := new mal_seq(hashmap.seq_val'range); new_seq(new_seq'range) := hashmap.seq_val(hashmap.seq_val'range); new_seq_obj(mal_hashmap, new_seq, obj); end procedure hashmap_copy; procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr) is variable i: natural; variable curr_key: mal_val_ptr; begin i := 0; while i < hashmap.seq_val'length loop curr_key := hashmap.seq_val(i); if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then val := hashmap.seq_val(i + 1); return; end if; i := i + 2; end loop; val := null; end procedure hashmap_get; procedure hashmap_contains(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; ok: out boolean) is variable val: mal_val_ptr; begin hashmap_get(hashmap, key, val); if val = null then ok := false; else ok := true; end if; end procedure hashmap_contains; procedure hashmap_put(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr) is variable i: natural; variable curr_key: mal_val_ptr; variable new_seq: mal_seq_ptr; begin i := 0; while i < hashmap.seq_val'length loop curr_key := hashmap.seq_val(i); if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then hashmap.seq_val(i + 1) := val; return; end if; i := i + 2; end loop; -- Not found so far, need to extend the seq new_seq := new mal_seq(0 to hashmap.seq_val'length + 1); for i in hashmap.seq_val'range loop new_seq(i) := hashmap.seq_val(i); end loop; new_seq(new_seq'length - 2) := key; new_seq(new_seq'length - 1) := val; deallocate(hashmap.seq_val); hashmap.seq_val := new_seq; end procedure hashmap_put; procedure hashmap_delete(hashmap: inout mal_val_ptr; key: inout mal_val_ptr) is variable i, dst_i: natural; variable curr_key: mal_val_ptr; variable new_seq: mal_seq_ptr; variable found: boolean; begin hashmap_contains(hashmap, key, found); if not found then return; end if; i := 0; dst_i := 0; new_seq := new mal_seq(0 to hashmap.seq_val'high - 2); while i < hashmap.seq_val'length loop curr_key := hashmap.seq_val(i); if key.val_type = curr_key.val_type and key.string_val.all = curr_key.string_val.all then i := i + 2; else new_seq(dst_i to dst_i + 1) := hashmap.seq_val(i to i + 1); dst_i := dst_i + 2; i := i + 2; end if; end loop; deallocate(hashmap.seq_val); hashmap.seq_val := new_seq; end procedure hashmap_delete; procedure seq_drop_prefix(src: inout mal_val_ptr; prefix_length: in integer; result: out mal_val_ptr) is variable seq: mal_seq_ptr; begin seq := new mal_seq(0 to src.seq_val'length - 1 - prefix_length); for i in seq'range loop seq(i) := src.seq_val(i + prefix_length); end loop; new_seq_obj(src.val_type, seq, result); end procedure seq_drop_prefix; function is_sequential_type(t: in mal_type_tag) return boolean is begin return t = mal_list or t = mal_vector; end function is_sequential_type; procedure equal_seq_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is variable i: integer; variable is_element_equal: boolean; begin if a.seq_val'length = b.seq_val'length then for i in a.seq_val'range loop equal_q(a.seq_val(i), b.seq_val(i), is_element_equal); if not is_element_equal then result := false; return; end if; end loop; result := true; else result := false; end if; end procedure equal_seq_q; procedure equal_hashmap_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is variable i: integer; variable is_value_equal: boolean; variable b_val: mal_val_ptr; begin if a.seq_val'length = b.seq_val'length then i := 0; while i < a.seq_val'length loop hashmap_get(b, a.seq_val(i), b_val); if b_val = null then result := false; return; else equal_q(a.seq_val(i + 1), b_val, is_value_equal); if not is_value_equal then result := false; return; end if; end if; i := i + 2; end loop; result := true; else result := false; end if; end procedure equal_hashmap_q; procedure equal_q(a: inout mal_val_ptr; b: inout mal_val_ptr; result: out boolean) is begin if is_sequential_type(a.val_type) and is_sequential_type(b.val_type) then equal_seq_q(a, b, result); elsif a.val_type = b.val_type then case a.val_type is when mal_nil | mal_true | mal_false => result := true; when mal_number => result := a.number_val = b.number_val; when mal_symbol | mal_string | mal_keyword => result := a.string_val.all = b.string_val.all; when mal_hashmap => equal_hashmap_q(a, b, result); when mal_atom => equal_q(a.seq_val(0), b.seq_val(0), result); when others => result := false; end case; else result := false; end if; end procedure equal_q; end package body types; ================================================ FILE: impls/vimscript/.gitignore ================================================ /*.o /*.so ================================================ FILE: impls/vimscript/Dockerfile ================================================ FROM ubuntu:20.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # To build the readline plugin RUN apt-get -y install gcc libreadline-dev RUN apt-get -y install vim ENV HOME /mal ================================================ FILE: impls/vimscript/Makefile ================================================ SOURCES_BASE = readline.vim types.vim reader.vim printer.vim SOURCES_LISP = env.vim core.vim stepA_mal.vim SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) all: libvimextras.so dist: mal.vim mal mal.vim: $(SOURCES) cat $+ | grep -v "^source " > $@ mal: mal.vim echo "#!/bin/sh" > $@ echo "\":\" ; rundir=\`dirname \$$0\`" >> $@ echo "\":\" ; export LD_LIBRARY_PATH=\`readlink -f \$$rundir\`" >> $@ echo "\":\" ; exec vim -i NONE -V1 -nNesS \"\$$0\" -- \"\$$@\" 2>/dev/null" >> $@ cat $< >> $@ chmod +x $@ libvimextras.so: vimextras.o $(CC) -g -shared -o $@ $< -lreadline vimextras.o: vimextras.c $(CC) -g -fPIC -c $< -o $@ clean: rm -f vimextras.o libvimextras.so mal.vim mal .PHONY: clean ================================================ FILE: impls/vimscript/core.vim ================================================ " core module function MalAssoc(args) let hash = copy(a:args[0].val) let new_elements = HashBuild(a:args[1:]) call extend(hash, new_elements.val) return HashNew(hash) endfunction function MalDissoc(args) let hash = copy(a:args[0].val) for keyobj in a:args[1:] let key = HashMakeKey(keyobj) if has_key(hash, key) call remove(hash, key) endif endfor return HashNew(hash) endfunction function MalGet(args) if !HashQ(a:args[0]) return g:MalNil endif let hash = a:args[0].val let key = HashMakeKey(a:args[1]) return get(hash, key, g:MalNil) endfunction function MalContainsQ(args) if !HashQ(a:args[0]) return FalseNew() endif let hash = a:args[0].val let key = HashMakeKey(a:args[1]) return BoolNew(has_key(hash, key)) endfunction function MalKeys(args) let listobjs = [] for keyname in keys(a:args[0].val) let keyobj = HashParseKey(keyname) call add(listobjs, keyobj) endfor return ListNew(listobjs) endfunction function MalReadLine(args) let [eof, line] = Readline(a:args[0].val) return eof ? g:MalNil : StringNew(line) endfunction function MalCons(args) let items = copy(a:args[1].val) call insert(items, a:args[0]) return ListNew(items) endfunction function MalConcat(args) let res = [] for list in a:args let res = res + list.val endfor return ListNew(res) endfunction function MalApply(args) let funcobj = a:args[0] let rest = a:args[1:] if len(rest) == 0 let funcargs = [] elseif len(rest) == 1 let funcargs = rest[-1].val else let funcargs = rest[:-2] + rest[-1].val endif if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, ListNew(funcargs)) elseif FunctionQ(funcobj) || MacroQ(funcobj) return FuncInvoke(funcobj, ListNew(funcargs)) else throw "Not a function" endif endfunction function MalMap(args) let funcobj = a:args[0] let res = [] for item in a:args[1].val unlet! mappeditem if NativeFunctionQ(funcobj) let mappeditem = NativeFuncInvoke(funcobj, ListNew([item])) elseif FunctionQ(funcobj) let mappeditem = FuncInvoke(funcobj, ListNew([item])) else throw "Not a function" endif call add(res, mappeditem) endfor return ListNew(res) endfunction function MalThrow(args) unlet! g:MalExceptionObj let g:MalExceptionObj = a:args[0] throw "__MalException__" endfunction function ConjList(list, elements) let newlist = a:list for e in a:elements let newlist = MalCons([e, newlist]) endfor return newlist endfunction function ConjVector(vector, elements) let items = copy(a:vector.val) for e in a:elements call add(items, e) endfor return VectorNew(items) endfunction function MalConj(args) if ListQ(a:args[0]) return ConjList(a:args[0], a:args[1:]) elseif VectorQ(a:args[0]) return ConjVector(a:args[0], a:args[1:]) endif endfunction function MalSeq(args) let obj = a:args[0] if EmptyQ(obj) return g:MalNil elseif ListQ(obj) return obj elseif VectorQ(obj) return ListNew(obj.val) elseif StringQ(obj) return ListNew(map(split(obj.val, '\zs'), {_, c -> StringNew(c)})) endif throw "seq requires string or list or vector or nil" endfunction function VimToMal(e) if type(a:e) == type(0) return IntegerNew(a:e) elseif type(a:e) == type(0.0) return FloatNew(a:e) elseif type(a:e) == type("") return StringNew(a:e) elseif type(a:e) == type([]) let res = [] for v in a:e call add(res, VimToMal(v)) endfor return ListNew(res) elseif type(a:e) == type({}) let res = {} for [k,v] in items(a:e) let keystring = HashMakeKey(StringNew(k)) let res[keystring] = VimToMal(v) endfor return HashNew(res) else return g:MalNil endif endfunction let CoreNs = { \ "=": NewNativeFnLambda({a -> BoolNew(EqualQ(a[0], a[1]))}), \ "<": NewNativeFnLambda({a -> BoolNew(a[0].val < a[1].val)}), \ "<=": NewNativeFnLambda({a -> BoolNew(a[0].val <= a[1].val)}), \ ">": NewNativeFnLambda({a -> BoolNew(a[0].val > a[1].val)}), \ ">=": NewNativeFnLambda({a -> BoolNew(a[0].val >= a[1].val)}), \ "+": NewNativeFnLambda({a -> IntegerNew(a[0].val + a[1].val)}), \ "-": NewNativeFnLambda({a -> IntegerNew(a[0].val - a[1].val)}), \ "*": NewNativeFnLambda({a -> IntegerNew(a[0].val * a[1].val)}), \ "/": NewNativeFnLambda({a -> IntegerNew(a[0].val / a[1].val)}), \ "time-ms": NewNativeFnLambda({a -> IntegerNew(libcallnr("libvimextras.so", "vimtimems", 0))}), \ "nil?": NewNativeFnLambda({a -> BoolNew(NilQ(a[0]))}), \ "true?": NewNativeFnLambda({a -> BoolNew(TrueQ(a[0]))}), \ "false?": NewNativeFnLambda({a -> BoolNew(FalseQ(a[0]))}), \ "symbol": NewNativeFnLambda({a -> SymbolNew(a[0].val)}), \ "symbol?": NewNativeFnLambda({a -> BoolNew(SymbolQ(a[0]))}), \ "string?": NewNativeFnLambda({a -> BoolNew(StringQ(a[0]))}), \ "keyword": NewNativeFnLambda({a -> KeywordNew(a[0].val)}), \ "keyword?": NewNativeFnLambda({a -> BoolNew(KeywordQ(a[0]))}), \ "number?": NewNativeFnLambda({a -> BoolNew(IntegerQ(a[0]))}), \ "fn?": NewNativeFnLambda({a -> BoolNew(NativeFunctionQ(a[0]) || FunctionQ(a[0]))}), \ "macro?": NewNativeFnLambda({a -> BoolNew(MacroQ(a[0]))}), \ "list": NewNativeFnLambda({a -> ListNew(a)}), \ "list?": NewNativeFnLambda({a -> BoolNew(ListQ(a[0]))}), \ "vector": NewNativeFnLambda({a -> VectorNew(a)}), \ "vector?": NewNativeFnLambda({a -> BoolNew(VectorQ(a[0]))}), \ "sequential?": NewNativeFnLambda({a -> BoolNew(SequentialQ(a[0]))}), \ "hash-map": NewNativeFnLambda({a -> HashBuild(a)}), \ "map?": NewNativeFnLambda({a -> BoolNew(HashQ(a[0]))}), \ "empty?": NewNativeFnLambda({a -> BoolNew(EmptyQ(a[0]))}), \ "count": NewNativeFnLambda({a -> IntegerNew(ListCount(a[0]))}), \ "assoc": NewNativeFn("MalAssoc"), \ "dissoc": NewNativeFn("MalDissoc"), \ "get": NewNativeFn("MalGet"), \ "contains?": NewNativeFn("MalContainsQ"), \ "keys": NewNativeFn("MalKeys"), \ "vals": NewNativeFnLambda({a -> ListNew(values(a[0].val))}), \ "pr-str": NewNativeFnLambda({a -> StringNew(join(map(copy(a), {_, e -> PrStr(e, 1)}), " "))}), \ "str": NewNativeFnLambda({a -> StringNew(join(map(copy(a), {_, e -> PrStr(e, 0)}), ""))}), \ "prn": NewNativeFnLambda({a -> [PrintLn(join(map(copy(a), {_, e -> PrStr(e, 1)}), " ")), g:MalNil][1]}), \ "println": NewNativeFnLambda({a -> [PrintLn(join(map(copy(a), {_, e -> PrStr(e, 0)}), " ")), g:MalNil][1]}), \ "read-string": NewNativeFnLambda({a -> ReadStr(a[0].val)}), \ "readline": NewNativeFn("MalReadLine"), \ "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])}), \ "apply": NewNativeFn("MalApply"), \ "map": NewNativeFn("MalMap"), \ "throw": NewNativeFn("MalThrow"), \ "conj": NewNativeFn("MalConj"), \ "seq": NewNativeFn("MalSeq"), \ "meta": NewNativeFnLambda({a -> ObjMeta(a[0])}), \ "with-meta": NewNativeFnLambda({a -> ObjNewWithMeta(a[0].type, copy(a[0].val), a[1])}), \ "atom": NewNativeFnLambda({a -> AtomNew(a[0])}), \ "atom?": NewNativeFnLambda({a -> BoolNew(AtomQ(a[0]))}), \ "deref": NewNativeFnLambda({a -> a[0].val}), \ "reset!": NewNativeFnLambda({a -> ObjSetValue(a[0], a[1])}), \ "swap!": NewNativeFnLambda({a -> ObjSetValue(a[0], MalApply([a[1], ListNew([a[0].val] + a[2:])]))}), \ "vim*": NewNativeFnLambda({a -> VimToMal(eval(a[0].val))}) \ } ================================================ FILE: impls/vimscript/env.vim ================================================ " env module let Env = {} function NewEnv(outer) let e = copy(g:Env) let e.data = {} let e.outer = a:outer return e endfunction function NewEnvWithBinds(outer, binds, exprs) let env = NewEnv(a:outer) let i = 0 while i < ListCount(a:binds) let varname = ListNth(a:binds, i).val if varname == "&" let restvarname = ListNth(a:binds, i + 1).val let restvarvalues = ListDrop(a:exprs, i) call env.set(restvarname, restvarvalues) break else unlet! varvalue let varvalue = ListNth(a:exprs, i) call env.set(varname, varvalue) endif let i = i + 1 endwhile return env endfunction function Env.set(key, value) dict let self.data[a:key] = a:value return a:value endfunction function Env.get(key) dict let curr = self while !has_key(curr.data, a:key) let curr = curr.outer if empty(curr) return "" endif endwhile return curr.data[a:key] endfunction function Env.root() dict let curr = self while !empty(curr.outer) let curr = curr.outer endwhile return curr endfunction ================================================ FILE: impls/vimscript/printer.vim ================================================ " printer module function PrStr(ast, readable) let obj = a:ast let r = a:readable if ListQ(obj) let ret = [] for e in obj.val call add(ret, PrStr(e, r)) endfor return "(" . join(ret, " ") . ")" elseif VectorQ(obj) let ret = [] for e in obj.val call add(ret, PrStr(e, r)) endfor return "[" . join(ret, " ") . "]" elseif HashQ(obj) let ret = [] for [k, v] in items(obj.val) let keyobj = HashParseKey(k) call add(ret, PrStr(keyobj, r)) call add(ret, PrStr(v, r)) endfor return "{" . join(ret, " ") . "}" elseif MacroQ(obj) let numargs = ListCount(obj.val.params) return "" elseif FunctionQ(obj) let numargs = ListCount(obj.val.params) return "" elseif NativeFunctionQ(obj) let funcname = obj.val.name return "" elseif AtomQ(obj) return "(atom " . PrStr(obj.val, 1) . ")" elseif KeywordQ(obj) return ':' . obj.val elseif StringQ(obj) if r let str = obj.val let str = substitute(str, '\\', '\\\\', "g") let str = substitute(str, '"', '\\"', "g") let str = substitute(str, "\n", '\\n', "g") return '"' . str . '"' else return obj.val endif elseif NilQ(obj) return "nil" elseif TrueQ(obj) return "true" elseif FalseQ(obj) return "false" elseif IntegerQ(obj) || FloatQ(obj) return string(obj.val) else return obj.val end endfunction ================================================ FILE: impls/vimscript/reader.vim ================================================ " reader module let Reader = {} function NewReader(tokens) let r = copy(g:Reader) let r.tokens = a:tokens let r.pos = 0 return r endfunction function Reader.peek() dict return self.tokens[self.pos] endfunction function Reader.nexttoken() dict let self.pos = self.pos + 1 return self.tokens[self.pos - 1] endfunction function Tokenize(str) let tokenize_pat = "[[:blank:]\\n,]*" . \ "\\(" . \ "\\~@\\|" . \ "[\\[\\]{}()'`~^@]\\|" . \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\"\\|" . \ "\"\\%(\\\\.\\|[^\\\\\"]\\)*\\|" . \ ";[^\\n]*\\|" . \ "[^[:blank:]\\n\\[\\]{}('\"`,;)]*" . \ "\\)" let tokens = [] let pos = 0 while 1 let mat = matchlist(a:str, tokenize_pat, pos) if len(mat) == 0 || mat[0] == "" break endif if mat[1] != "" && mat[1][0] != ";" call add(tokens, mat[1]) endif let pos = matchend(a:str, tokenize_pat, pos) endwhile return tokens endfunction function UnescapeChar(seq) if a:seq == '\"' return '"' elseif a:seq == '\n' return "\n" elseif a:seq == '\\' return '\' else return a:seq endif endfunction function ParseString(token) return substitute(a:token[1:-2], '\\.', '\=UnescapeChar(submatch(0))', "g") endfunction function ReadAtom(rdr) let token = a:rdr.nexttoken() if token =~ "^-\\?[0-9]\\+$" return IntegerNew(str2nr(token)) elseif token =~ "^-\\?[0-9][0-9.]*$" return FloatNew(str2float(token)) elseif token =~ "^\"\\%(\\\\.\\|[^\\\\\"]\\)*\"$" return StringNew(ParseString(token)) elseif token =~ "^\".*$" throw "expected '\"', got EOF" elseif token =~ "^:" return KeywordNew(token[1:-1]) elseif token == "nil" return g:MalNil elseif token == "true" return TrueNew() elseif token == "false" return FalseNew() else return SymbolNew(token) endif endfunction function ReadTokensList(rdr, start, last) let elements = [] let token = a:rdr.nexttoken() if token != a:start throw "expected '" . a:start . "'" endif let token = a:rdr.peek() while token != a:last call add(elements, ReadForm(a:rdr)) try let token = a:rdr.peek() catch throw "expected '" . a:last . "', got EOF" endtry endwhile call a:rdr.nexttoken() return elements endfunction function ReadList(rdr) let elements = ReadTokensList(a:rdr, "(", ")") return ListNew(elements) endfunction function ReadVector(rdr) let elements = ReadTokensList(a:rdr, "[", "]") return VectorNew(elements) endfunction function ReadHash(rdr) let elements = ReadTokensList(a:rdr, "{", "}") return HashBuild(elements) endfunction function ReadForm(rdr) let token = a:rdr.peek() if token == ";" return "" elseif token == "'" call a:rdr.nexttoken() return ListNew([SymbolNew("quote"), ReadForm(a:rdr)]) elseif token == "`" call a:rdr.nexttoken() return ListNew([SymbolNew("quasiquote"), ReadForm(a:rdr)]) elseif token == "~" call a:rdr.nexttoken() return ListNew([SymbolNew("unquote"), ReadForm(a:rdr)]) elseif token == "~@" call a:rdr.nexttoken() return ListNew([SymbolNew("splice-unquote"), ReadForm(a:rdr)]) elseif token == "^" call a:rdr.nexttoken() let meta = ReadForm(a:rdr) return ListNew([SymbolNew("with-meta"), ReadForm(a:rdr), meta]) elseif token == "@" call a:rdr.nexttoken() return ListNew([SymbolNew("deref"), ReadForm(a:rdr)]) elseif token == "(" return ReadList(a:rdr)") elseif token == ")" throw "unexpected ')'" elseif token == "[" return ReadVector(a:rdr) elseif token == "]" throw "unexpected ']'" elseif token == "{" return ReadHash(a:rdr) elseif token == "}" throw "unexpected '}'" else return ReadAtom(a:rdr) endif endfunction function ReadStr(str) let tokens = Tokenize(a:str) if empty(tokens) return "" endif return ReadForm(NewReader(tokens)) endfunction ================================================ FILE: impls/vimscript/readline.vim ================================================ function PrintLn(str) let lines = split(a:str, "\n", 1) call writefile(lines, "/dev/stdout", "a") endfunction function s:buildlibvimreadline() if !filereadable("libvimextras.so") call system("make libvimextras.so") endif endfunction " Returns [is_eof, line_string] function Readline(prompt) " Use the vimreadline() function defined in vimextras.c and compiled " into libvimextras.so call s:buildlibvimreadline() let res = libcall("libvimextras.so", "vimreadline", a:prompt) if res[0] == "E" return [1, ""] else return [0, res[1:]] endif endfunction ================================================ FILE: impls/vimscript/run ================================================ #!/usr/bin/env bash cd $(dirname $0) exec ./run_vimscript.sh ./${STEP:-stepA_mal}.vim "${@}" ================================================ FILE: impls/vimscript/run_vimscript.sh ================================================ #!/bin/sh # Run Vim in ex mode (-e) and run the given script ($1) on startup. Our scripts # end with 'qall!' which causes actual Vim UI to never start up. # # Set environment variable DEBUG=1 to allow more verbose error output from Vim. # # See: http://vim.wikia.com/wiki/Vim_as_a_system_interpreter_for_vimscript rundir=`dirname $0` export LD_LIBRARY_PATH=`readlink -f $rundir` vimscriptfile="$1" shift if [ x$DEBUG = x ] ; then exec 2> /dev/null fi exec vim -i NONE -V1 -nNesS $vimscriptfile -- "$@" | cat ================================================ FILE: impls/vimscript/step0_repl.vim ================================================ source readline.vim function READ(str) return a:str endfunction function EVAL(ast, env) return a:ast endfunction function PRINT(exp) return a:exp endfunction function REP(str) return PRINT(EVAL(READ(a:str), {})) endfunction while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif call PrintLn(REP(line)) endwhile qall! ================================================ FILE: impls/vimscript/step1_read_print.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) return a:ast endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function REP(str) return PRINT(EVAL(READ(a:str), {})) endfunction while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step2_eval.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) " call PrintLn("EVAL: " . PrStr(a:ast, 1)) if SymbolQ(a:ast) let varname = a:ast.val if !has_key(a:env, varname) throw "'" . varname . "' not found" end return a:env[varname] elseif VectorQ(a:ast) return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) elseif HashQ(a:ast) let ret = {} for [k,v] in items(a:ast.val) let newval = EVAL(v, a:env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(a:ast) return a:ast end if EmptyQ(a:ast) return a:ast endif " apply list let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) let Fn = el.val[0] return Fn(el.val[1:-1]) endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction let repl_env = {} let repl_env["+"] = {a -> IntegerNew(a[0].val + a[1].val)} let repl_env["-"] = {a -> IntegerNew(a[0].val - a[1].val)} let repl_env["*"] = {a -> IntegerNew(a[0].val * a[1].val)} let repl_env["/"] = {a -> IntegerNew(a[0].val / a[1].val)} while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("ERROR: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step3_env.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) let dbgeval = a:env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(a:ast, 1)) endif if SymbolQ(a:ast) let varname = a:ast.val let Val = a:env.get(varname) if empty(Val) throw "'" . varname . "' not found" endif return Val elseif VectorQ(a:ast) return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) elseif HashQ(a:ast) let ret = {} for [k,v] in items(a:ast.val) let newval = EVAL(v, a:env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(a:ast) return a:ast end if EmptyQ(a:ast) return a:ast endif let first_symbol = a:ast.val[0].val if first_symbol == "def!" let a1 = a:ast.val[1] let a2 = a:ast.val[2] return a:env.set(a1.val, EVAL(a2, a:env)) elseif first_symbol == "let*" let a1 = a:ast.val[1] let a2 = a:ast.val[2] let let_env = NewEnv(a:env) let let_binds = a1.val let i = 0 while i < len(let_binds) call let_env.set(let_binds[i].val, EVAL(let_binds[i+1], let_env)) let i = i + 2 endwhile return EVAL(a2, let_env) else " apply list let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) let Fn = el.val[0] return Fn(el.val[1:-1]) endif endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction let repl_env = NewEnv("") call repl_env.set("+", {a -> IntegerNew(a[0].val + a[1].val)}) call repl_env.set("-", {a -> IntegerNew(a[0].val - a[1].val)}) call repl_env.set("*", {a -> IntegerNew(a[0].val * a[1].val)}) call repl_env.set("/", {a -> IntegerNew(a[0].val / a[1].val)}) while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step4_if_fn_do.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) let dbgeval = a:env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(a:ast, 1)) endif if SymbolQ(a:ast) let varname = a:ast.val let val = a:env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(a:ast) return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) elseif HashQ(a:ast) let ret = {} for [k,v] in items(a:ast.val) let newval = EVAL(v, a:env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(a:ast) return a:ast end if EmptyQ(a:ast) return a:ast endif let first = ListFirst(a:ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = a:ast.val[1] let a2 = a:ast.val[2] let ret = a:env.set(a1.val, EVAL(a2, a:env)) return ret elseif first_symbol == "let*" let a1 = a:ast.val[1] let a2 = a:ast.val[2] let let_env = NewEnv(a:env) let let_binds = a1.val let i = 0 while i < len(let_binds) call let_env.set(let_binds[i].val, EVAL(let_binds[i+1], let_env)) let i = i + 2 endwhile return EVAL(a2, let_env) elseif first_symbol == "if" let condvalue = EVAL(a:ast.val[1], a:env) if FalseQ(condvalue) || NilQ(condvalue) if len(a:ast.val) < 4 return g:MalNil else return EVAL(a:ast.val[3], a:env) endif else return EVAL(a:ast.val[2], a:env) endif elseif first_symbol == "do" let astlist = a:ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, a:env) endfor return EVAL(astlist[-1], a:env) elseif first_symbol == "fn*" let fn = NewFn(ListNth(a:ast, 2), a:env, ListNth(a:ast, 1)) return fn else " apply list let el = ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) return FuncInvoke(funcobj, args) else throw "Not a function" endif endif endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction let repl_env = NewEnv("") for [k, Fn] in items(CoreNs) call repl_env.set(k, Fn) endfor call REP("(def! not (fn* (a) (if a false true)))", repl_env) while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step5_tco.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] let ret = env.set(a1.val, EVAL(a2, env)) return ret elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn else " apply list let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call REP("(def! not (fn* (a) (if a false true)))", repl_env) while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step6_file.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim function READ(str) return ReadStr(a:str) endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] let ret = env.set(a1.val, EVAL(a2, env)) return ret elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn elseif first_symbol == "eval" let ast = EVAL(ListNth(ast, 1), env) let env = env.root() " TCO else " apply list let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function RE(str, env) return EVAL(READ(a:str), a:env) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction function GetArgvList() return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call repl_env.set("*ARGV*", GetArgvList()) call RE("(def! not (fn* (a) (if a false true)))", repl_env) call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if !empty(argv()) call RE('(load-file "' . argv(0) . '")', repl_env) qall! endif while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step7_quote.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim function READ(str) return ReadStr(a:str) endfunction 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 VectorQ(a:ast) return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) elseif !ListQ(a:ast) return a:ast elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) else return QuasiquoteLoop(a:ast.val) endif endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] let ret = env.set(a1.val, EVAL(a2, env)) return ret elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "quote" return ListNth(ast, 1) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn elseif first_symbol == "eval" let ast = EVAL(ListNth(ast, 1), env) let env = env.root() " TCO else " apply list let el = ListNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) let funcobj = ListFirst(el) let args = ListRest(el) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function RE(str, env) return EVAL(READ(a:str), a:env) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction function GetArgvList() return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call repl_env.set("*ARGV*", GetArgvList()) call RE("(def! not (fn* (a) (if a false true)))", repl_env) call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) if !empty(argv()) call RE('(load-file "' . argv(0) . '")', repl_env) qall! endif while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step8_macros.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim function READ(str) return ReadStr(a:str) endfunction 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 VectorQ(a:ast) return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) elseif !ListQ(a:ast) return a:ast elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) else return QuasiquoteLoop(a:ast.val) endif endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] return env.set(a1.val, EVAL(a2, env)) elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "quote" return ListNth(ast, 1) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO elseif first_symbol == "defmacro!" let a1 = ListNth(ast, 1) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn elseif first_symbol == "eval" let ast = EVAL(ListNth(ast, 1), env) let env = env.root() " TCO else " apply list let funcobj = EVAL(first, env) let args = ListRest(ast) if MacroQ(funcobj) let ast = FuncInvoke(funcobj, args) continue " TCO endif let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function RE(str, env) return EVAL(READ(a:str), a:env) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction function GetArgvList() return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call repl_env.set("*ARGV*", GetArgvList()) call RE("(def! not (fn* (a) (if a false true)))", repl_env) call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) if !empty(argv()) call RE('(load-file "' . argv(0) . '")', repl_env) qall! endif while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch call PrintLn("Error: " . v:exception) endtry endwhile qall! ================================================ FILE: impls/vimscript/step9_try.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim let MalExceptionObj = "" function READ(str) return ReadStr(a:str) endfunction 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 VectorQ(a:ast) return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) elseif !ListQ(a:ast) return a:ast elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) else return QuasiquoteLoop(a:ast.val) endif endfunction function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" end let catch_clause = ListNth(a:ast, 2) if ListFirst(catch_clause) == SymbolNew("catch*") return catch_clause else return "" end endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] return env.set(a1.val, EVAL(a2, env)) elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "quote" return ListNth(ast, 1) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO elseif first_symbol == "defmacro!" let a1 = ListNth(ast, 1) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "try*" try return EVAL(ListNth(ast, 1), env) catch let catch_clause = GetCatchClause(ast) if empty(catch_clause) throw v:exception endif let exc_var = ListNth(catch_clause, 1).val if v:exception == "__MalException__" let exc_value = g:MalExceptionObj else let exc_value = StringNew(v:exception) endif let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value])) return EVAL(ListNth(catch_clause, 2), catch_env) endtry elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn elseif first_symbol == "eval" let ast = EVAL(ListNth(ast, 1), env) let env = env.root() " TCO else " apply list let funcobj = EVAL(first, env) let args = ListRest(ast) if MacroQ(funcobj) let ast = FuncInvoke(funcobj, args) continue " TCO endif let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function RE(str, env) return EVAL(READ(a:str), a:env) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction function GetArgvList() return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call repl_env.set("*ARGV*", GetArgvList()) call RE("(def! not (fn* (a) (if a false true)))", repl_env) call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) if !empty(argv()) try call RE('(load-file "' . argv(0) . '")', repl_env) catch call PrintLn("Error: " . v:exception) endtry qall! endif while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch if v:exception == "__MalException__" call PrintLn("Error: " . PrStr(g:MalExceptionObj, 1)) else call PrintLn("Error: " . v:exception) end endtry endwhile qall! ================================================ FILE: impls/vimscript/stepA_mal.vim ================================================ source readline.vim source types.vim source reader.vim source printer.vim source env.vim source core.vim let MalExceptionObj = "" function READ(str) return ReadStr(a:str) endfunction 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 VectorQ(a:ast) return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) elseif !ListQ(a:ast) return a:ast elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) else return QuasiquoteLoop(a:ast.val) endif endfunction function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" end let catch_clause = ListNth(a:ast, 2) if ListFirst(catch_clause) == SymbolNew("catch*") return catch_clause else return "" end endfunction function EVAL(ast, env) let ast = a:ast let env = a:env while 1 let dbgeval = env.get("DEBUG-EVAL") if !(empty(dbgeval) || FalseQ(dbgeval) || NilQ(dbgeval)) call PrintLn("EVAL: " . PrStr(ast, 1)) endif if SymbolQ(ast) let varname = ast.val let val = env.get(varname) if empty(val) throw "'" . varname . "' not found" endif return val elseif VectorQ(ast) return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) elseif HashQ(ast) let ret = {} for [k,v] in items(ast.val) let newval = EVAL(v, env) let ret[k] = newval endfor return HashNew(ret) endif if !ListQ(ast) return ast end if EmptyQ(ast) return ast endif let first = ListFirst(ast) let first_symbol = SymbolQ(first) ? first.val : "" if first_symbol == "def!" let a1 = ast.val[1] let a2 = ast.val[2] return env.set(a1.val, EVAL(a2, env)) elseif first_symbol == "let*" let a1 = ast.val[1] let a2 = ast.val[2] let env = NewEnv(env) let let_binds = a1.val let i = 0 while i < len(let_binds) call env.set(let_binds[i].val, EVAL(let_binds[i+1], env)) let i = i + 2 endwhile let ast = a2 " TCO elseif first_symbol == "quote" return ListNth(ast, 1) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO elseif first_symbol == "defmacro!" let a1 = ListNth(ast, 1) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) if len(ast.val) < 4 return g:MalNil else let ast = ast.val[3] endif else let ast = ast.val[2] endif " TCO elseif first_symbol == "try*" try return EVAL(ListNth(ast, 1), env) catch let catch_clause = GetCatchClause(ast) if empty(catch_clause) throw v:exception endif let exc_var = ListNth(catch_clause, 1).val if v:exception == "__MalException__" let exc_value = g:MalExceptionObj else let exc_value = StringNew(v:exception) endif let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value])) return EVAL(ListNth(catch_clause, 2), catch_env) endtry elseif first_symbol == "do" let astlist = ast.val for elt in astlist[1:-2] let ignored = EVAL(elt, env) endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1)) return fn elseif first_symbol == "eval" let ast = EVAL(ListNth(ast, 1), env) let env = env.root() " TCO else " apply list let funcobj = EVAL(first, env) let args = ListRest(ast) if MacroQ(funcobj) let ast = FuncInvoke(funcobj, args) continue " TCO endif let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) let fn = funcobj.val let ast = fn.ast let env = NewEnvWithBinds(fn.env, fn.params, args) " TCO else throw "Not a function" endif endif endwhile endfunction function PRINT(exp) return PrStr(a:exp, 1) endfunction function RE(str, env) return EVAL(READ(a:str), a:env) endfunction function REP(str, env) return PRINT(EVAL(READ(a:str), a:env)) endfunction function GetArgvList() return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)})) endfunction set maxfuncdepth=10000 let repl_env = NewEnv("") for [k, v] in items(CoreNs) call repl_env.set(k, v) endfor call repl_env.set("*ARGV*", GetArgvList()) call RE("(def! *host-language* \"vimscript\")", repl_env) call RE("(def! not (fn* (a) (if a false true)))", repl_env) call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env) call RE("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env) if !empty(argv()) try call RE('(load-file "' . argv(0) . '")', repl_env) catch call PrintLn("Error: " . v:exception) endtry qall! endif call REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env) while 1 let [eof, line] = Readline("user> ") if eof break endif if line == "" continue endif try call PrintLn(REP(line, repl_env)) catch if v:exception == "__MalException__" call PrintLn("Error: " . PrStr(g:MalExceptionObj, 1)) else call PrintLn("Error: " . v:exception) end endtry endwhile qall! ================================================ FILE: impls/vimscript/tests/step5_tco.mal ================================================ ;; Test recursive non-tail call function (def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1)))))) (sum-to 10) ;=>55 ;;; no try* yet, so test completion of side-effects (def! res1 nil) ;=>nil ;;; For implementations without their own TCO this should fail and ;;; leave res1 unchanged (def! res1 (sum-to 10000)) res1 ;=>nil ================================================ FILE: impls/vimscript/tests/stepA_mal.mal ================================================ ;; Testing basic Vim interop with (vim* "...") ;; (vim* "7") ;=>7 (vim* "'7'") ;=>"7" (vim* "[7,8,9]") ;=>(7 8 9) (vim* "{\"abc\": 789}") ;=>{"abc" 789} ;; ;; Test Vim eval() expression support ;; (vim* "3 + 7 * 8") ;=>59 (vim* "join(['a','b','c'], '_')") ;=>"a_b_c" (vim* "split('d@@@@e@f@@g', '@\+')") ;=>("d" "e" "f" "g") (vim* "add([1,2,3], 4)") ;=>(1 2 3 4) ;; ;; Test access to Vim predefined variables ;; ;;; (vim* "v:progname") ;;; ;=>"vim" ;; v:version is 800 for Vim 8.0 (>= (vim* "v:version") 800) ;=>true ================================================ FILE: impls/vimscript/types.vim ================================================ " types module function ObjNewWithMeta(obj_type, obj_val, obj_meta) return {"type": a:obj_type, "val": a:obj_val, "meta": a:obj_meta} endfunction function ObjNew(obj_type, obj_val) return {"type": a:obj_type, "val": a:obj_val} endfunction function ObjHasMeta(obj) return has_key(a:obj, "meta") endfunction function ObjMeta(obj) return ObjHasMeta(a:obj) ? a:obj["meta"] : g:MalNil endfunction function ObjSetValue(obj, newval) let a:obj["val"] = a:newval return a:newval endfunction function ObjSetMeta(obj, newmeta) let a:obj["meta"] = a:newmeta return a:newmeta endfunction function SymbolQ(obj) return a:obj.type == "symbol" endfunction function StringQ(obj) return a:obj.type == "string" endfunction function KeywordQ(obj) return a:obj.type == "keyword" endfunction function AtomQ(obj) return a:obj.type == "atom" endfunction function NilQ(obj) return a:obj.type == "nil" endfunction function TrueQ(obj) return a:obj.type == "true" endfunction function FalseQ(obj) return a:obj.type == "false" endfunction function IntegerQ(obj) return a:obj.type == "integer" endfunction function FloatQ(obj) return a:obj.type == "float" endfunction function ListQ(obj) return a:obj.type == "list" endfunction function VectorQ(obj) return a:obj.type == "vector" endfunction function SequentialQ(obj) return ListQ(a:obj) || VectorQ(a:obj) endfunction function HashQ(obj) return a:obj.type == "hash" endfunction function FunctionQ(obj) return a:obj.type == "function" && !a:obj.val.is_macro endfunction function MacroQ(obj) return a:obj.type == "function" && a:obj.val.is_macro endfunction function NativeFunctionQ(obj) return a:obj.type == "nativefunction" endfunction function NilNew() return ObjNew("nil", "") endfunction function TrueNew() return ObjNew("true", "") endfunction function FalseNew() return ObjNew("false", "") endfunction function BoolNew(bool) return a:bool ? g:MalTrue : g:MalFalse endfunction function KeywordNew(val) return ObjNew("keyword", a:val) endfunction function AtomNew(val) return ObjNewWithMeta("atom", a:val, g:MalNil) endfunction function SymbolNew(val) return ObjNew("symbol", a:val) endfunction function StringNew(val) return ObjNew("string", a:val) endfunction function IntegerNew(val) return ObjNew("integer", a:val) endfunction function FloatNew(val) return ObjNew("float", a:val) endfunction function ListNew(val) return ObjNewWithMeta("list", a:val, g:MalNil) endfunction function VectorNew(val) return ObjNewWithMeta("vector", a:val, g:MalNil) endfunction function HashNew(val) return ObjNewWithMeta("hash", a:val, g:MalNil) endfunction function HashMakeKey(obj) if !StringQ(a:obj) && !KeywordQ(a:obj) throw "expected hash-map key string, got: " . a:obj.type); endif return a:obj.type . "#" . a:obj.val endfunction function HashParseKey(str) if a:str =~ "^string#" return StringNew(a:str[7:]) elseif a:str =~ "^keyword#" return KeywordNew(a:str[8:]) endif endfunction function HashBuild(elements) if (len(a:elements) % 2) != 0 throw "Odd number of hash-map arguments" endif let i = 0 let hash = {} while i < len(a:elements) let key = a:elements[i] let val = a:elements[i + 1] let keystring = HashMakeKey(key) let hash[keystring] = val let i = i + 2 endwhile return HashNew(hash) endfunction function HashEqualQ(x, y) if len(a:x.val) != len(a:y.val) return 0 endif for k in keys(a:x.val) let vx = a:x.val[k] let vy = a:y.val[k] if empty(vy) || !EqualQ(vx, vy) return 0 endif endfor return 1 endfunction function SequentialEqualQ(x, y) if len(a:x.val) != len(a:y.val) return 0 endif let i = 0 while i < len(a:x.val) let ex = a:x.val[i] let ey = a:y.val[i] if !EqualQ(ex, ey) return 0 endif let i = i +1 endwhile return 1 endfunction function EqualQ(x, y) if SequentialQ(a:x) && SequentialQ(a:y) return SequentialEqualQ(a:x, a:y) elseif HashQ(a:x) && HashQ(a:y) return HashEqualQ(a:x, a:y) elseif a:x.type != a:y.type return 0 else return a:x.val == a:y.val endif endfunction function EmptyQ(list) return empty(a:list.val) endfunction function ListCount(list) return len(a:list.val) endfunction function ListNth(list, index) if a:index >= len(a:list.val) throw "nth: index out of range" endif return a:list.val[a:index] endfunction function ListFirst(list) return get(a:list.val, 0, g:MalNil) endfunction function ListDrop(list, drop_elements) return ListNew(a:list.val[a:drop_elements :]) endfunction function ListRest(list) return ListDrop(a:list, 1) endfunction function FuncInvoke(funcobj, args) let fn = a:funcobj.val let funcenv = NewEnvWithBinds(fn.env, fn.params, a:args) return EVAL(fn.ast, funcenv) endfunction function NativeFuncInvoke(funcobj, argslist) let fn = a:funcobj.val return fn.Func(a:argslist.val) endfunction function MarkAsMacro(funcobj) let fn = a:funcobj.val let mac = {"ast": fn.ast, "env": fn.env, "params": fn.params, "is_macro": 1} return ObjNewWithMeta("function", mac, g:MalNil) endfunction function NewFn(ast, env, params) let fn = {"ast": a:ast, "env": a:env, "params": a:params, "is_macro": 0} return ObjNewWithMeta("function", fn, g:MalNil) endfunction function NewNativeFn(funcname) let fn = {"Func": function(a:funcname), "name": a:funcname} return ObjNewWithMeta("nativefunction", fn, g:MalNil) endfunction function NewNativeFnLambda(lambdaexpr) let fn = {"Func": a:lambdaexpr, "name": "inline"} return ObjNewWithMeta("nativefunction", fn, g:MalNil) endfunction let g:MalNil = NilNew() let g:MalTrue = TrueNew() let g:MalFalse = FalseNew() ================================================ FILE: impls/vimscript/vimextras.c ================================================ #include #include #include #include #include /* * Vim interface for the readline(3) function. * * Prints 'prompt' and reads a line from the input. If EOF is encountered, * returns the string "E"; otherwise, returns the string "S" where * is the line read from input. * * This function is not thread-safe. */ char* vimreadline(char* prompt) { static char buf[1024]; char* res = readline(prompt); if (res) { buf[0] = 'S'; strncpy(buf + 1, res, sizeof(buf) - 1); free(res); } else { buf[0] = 'E'; buf[1] = '\0'; } return buf; } #define UNIXTIME_BASE 1451606400 /* = Unix time of 2016-01-01 */ /* * Returns the number of milliseconds since 2016-01-01 00:00:00 UTC. * * This date is chosen (instead of the standard 1970 epoch) so the number of * milliseconds will not exceed a 32-bit integer, which is the limit for Vim * number variables. */ int vimtimems(int dummy) { struct timeval tv; (void) dummy; /* unused */ gettimeofday(&tv, NULL); return (tv.tv_sec - UNIXTIME_BASE) * 1000 + (tv.tv_usec / 1000); } ================================================ FILE: impls/wasm/Dockerfile ================================================ FROM ubuntu:20.04 as base MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## # # node # # For building node modules RUN apt-get -y install g++ # Add nodesource apt repo config for 16.x stable RUN apt-get -y install gnupg RUN curl -sL https://deb.nodesource.com/setup_16.x | bash - # Install nodejs RUN apt-get -y install nodejs ENV NPM_CONFIG_CACHE /mal/.npm # # wace build and runtime libs # RUN dpkg --add-architecture i386 && \ apt-get -y update && \ DEBIAN_FRONTEND=noninteractive apt-get -y install \ lib32gcc-9-dev lib32gcc-8-dev lib32gcc-7-dev \ libsdl2-dev:i386 libsdl2-image-dev:i386 \ libedit-dev:i386 freeglut3-dev:i386 \ libreadline-dev:i386 # # binaryen # RUN apt-get -y install git-core cmake RUN apt-get -y install binaryen ########################################################################### FROM base as build_tools ########################################################################### # # clang/LLVM and rust (for building wasmtime) # #RUN apt-get -y install llvm-3.9-dev libclang-3.9-dev clang-3.9 #RUN apt-get -y install curl && \ # curl https://sh.rustup.rs -sSf > /tmp/rustup.sh && \ # sh /tmp/rustup.sh -y #ENV PATH $PATH:/root/.cargo/bin # # pypy / rpython (for building warpy) # ## rpython deps #ENV DEBIAN_FRONTEND=noninteractive #RUN apt-get -y install libffi-dev pkg-config libz-dev \ # libbz2-dev libsqlite3-dev libncurses-dev libexpat1-dev \ # libssl-dev libgdbm-dev tcl-dev # ## install pypy, build and install pypy/rpython, remove prior pypy #RUN apt-get -y install software-properties-common && \ # add-apt-repository ppa:pypy && \ # apt-get -y update && \ # apt-get -y install pypy && \ # mkdir -p /opt/pypy && \ # curl -L https://github.com/pypy/pypy/archive/refs/tags/release-pypy2.7-v6.0.0.tar.gz \ # | tar -xzf - -C /opt/pypy/ --strip-components=1 && \ # cd /opt/pypy && make && \ # chmod -R ugo+rw /opt/pypy/rpython/_cache && \ # ln -sf /opt/pypy/rpython/bin/rpython /usr/local/bin/rpython && \ # ln -sf /opt/pypy/pypy-c /usr/local/bin/pypy && \ # rm -rf /tmp/usession* && \ # ln -sf /opt/pypy/pypy/goal/pypy-c /usr/local/bin/pypy && \ # apt-get -y autoremove pypy # # wasi-sdk (C/C++ -> wasm+wasi) # RUN curl -LO https://github.com/CraneStation/wasi-sdk/releases/download/wasi-sdk-5/wasi-sdk_5.0_amd64.deb && \ dpkg -i wasi-sdk_5.0_amd64.deb && \ rm wasi-sdk_5.0_amd64.deb ## ## Rust wasm support ## #RUN rustup default nightly #RUN rustup target add wasm32-unknown-wasi --toolchain nightly ##RUN cargo +nightly build --target wasm32-unknown-wasi # ## TODO: Do this when we install rust instead #RUN mv /root/.cargo /opt/cargo && mv /root/.rustup /opt/rustup #RUN chmod -R a+r /opt/cargo && chmod -R a+rw /opt/rustup #ENV CARGO_HOME /opt/cargo #ENV RUSTUP_HOME /opt/rustup #ENV PATH $PATH:/opt/cargo/bin ########################################################################### FROM build_tools as runtimes ########################################################################### # # warpy # #RUN git clone https://github.com/kanaka/warpy/ && \ # cd warpy && \ # make warpy-nojit && \ # cp warpy-nojit /usr/bin/warpy # # wac/wace # #RUN git clone https://github.com/kanaka/wac/ && \ # cd wac && \ # make USE_SDL= wac wax wace && \ # cp wac wax wace /usr/bin # # wasmer # #RUN curl https://get.wasmer.io -sSfL | sh RUN sh -c "$(curl https://get.wasmer.io -sSfL)" -- 2.0.0 && \ cp /root/.wasmer/bin/wasmer /usr/bin/wasmer && \ cp /root/.wasmer/bin/wapm /usr/bin/wapm #RUN git clone --recursive https://github.com/wasmerio/wasmer && \ # cd wasmer && \ # cargo build --release && \ # cp target/release/wasmer /usr/bin/ # # wasmtime # RUN curl -L https://github.com/bytecodealliance/wasmtime/releases/download/v3.0.0/wasmtime-v3.0.0-x86_64-linux.tar.xz | tar xvJf - && \ cp wasmtime-v3.0.0-x86_64-linux/wasmtime /usr/bin/wasmtime #RUN git clone --recursive https://github.com/CraneStation/wasmtime && \ # cd wasmtime && \ # sed -i 's/c3994bf57b5d2f1f973b0e4e37bc385695aa4ed2/8ea7a983d8b1364e5f62d2adf0e74b3b8db1c9b3/' Cargo.toml && \ # cargo build --release && \ # cp target/release/wasmtime /usr/bin/ && \ # cp target/release/wasm2obj /usr/bin/ ########################################################################### FROM base as wasm ########################################################################### #COPY --from=runtimes /usr/bin/wac /usr/bin/wac #COPY --from=runtimes /usr/bin/wax /usr/bin/wax #COPY --from=runtimes /usr/bin/wace /usr/bin/wace #COPY --from=runtimes /usr/bin/warpy /usr/bin/warpy COPY --from=runtimes /usr/bin/wasmtime /usr/bin/wasmtime COPY --from=runtimes /usr/bin/wasmer /usr/bin/wasmer COPY --from=runtimes /usr/bin/wapm /usr/bin/wapm ENV HOME /mal ================================================ FILE: impls/wasm/Makefile ================================================ MODE ?= $(strip \ $(if $(filter wace_libc,$(wasm_MODE)),\ libc,\ $(if $(filter direct node js wace_fooboot warpy,$(wasm_MODE)),\ direct,\ wasi))) EXT = .wasm WASM_AS ?= wasm-as WAMP ?= node_modules/.bin/wamp STEP0_DEPS = $(WAMP) platform_$(MODE).wam string.wam printf.wam STEP1_DEPS = $(STEP0_DEPS) types.wam mem.wam debug.wam reader.wam printer.wam STEP3_DEPS = $(STEP1_DEPS) env.wam STEP4_DEPS = $(STEP3_DEPS) core.wam STEPS = step0_repl step1_read_print step2_eval step3_env \ step4_if_fn_do step5_tco step6_file step7_quote \ step8_macros step9_try stepA_mal all: $(STEPS:=$(EXT)) $(WAMP): npm install %.wat: %.wam $(WAMP) $(filter %.wam,$^) > $*.wat %.wasm: %.wat $(WASM_AS) $< -o $@ step0_repl.wat: $(STEP0_DEPS) step1_read_print.wat step2_eval.wat: $(STEP1_DEPS) step3_env.wat: $(STEP3_DEPS) step4_if_fn_do.wat step5_tco.wat step6_file.wat: $(STEP4_DEPS) step7_quote.wat step8_macros.wat step9_try.wat stepA_mal.wat: $(STEP4_DEPS) .PHONY: clean clean: rm -f *.wat *.wasm ================================================ FILE: impls/wasm/core.wam ================================================ (module $core ;; it would be nice to have this in types.wam but it uses ;; ENV_NEW_BINDS which is not available until step3 but types is ;; used in step1 (func $APPLY (param $f i32) (param $args i32) (result i32) (local $res i32 $env i32 $ftype i32 $a i32) (local.set $f ($DEREF_META $f)) (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then ;; Must be kept in sync with EVAL's FUNCTION_T evaluation (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f)))))) (else (if (OR (i32.eq $ftype (global.get $MALFUNC_T)) (i32.eq $ftype (global.get $MACRO_T))) (then ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; claim the AST before releasing the list containing it (local.set $a ($MEM_VAL0_ptr $f)) (drop ($INC_REF $a)) (local.set $res ($EVAL $a $env)) ($RELEASE $env) ($RELEASE $a)) (else ($THROW_STR_1 "APPLY of non-function type: %d\n" $ftype) (local.set $res 0))))) $res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; core functions (type $fnT (func (param i32) (result i32))) (func $equal_Q (param $args i32) (result i32) ($TRUE_FALSE ($EQUAL_Q ($MEM_VAL1_ptr $args) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))) (func $throw (param $args i32) (result i32) (global.set $error_type 2) (global.set $error_val ($INC_REF ($MEM_VAL1_ptr $args))) 0 ) (func $nil_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $NIL_T)))) (func $true_Q (param $args i32) (result i32) (LET $ast ($MEM_VAL1_ptr $args)) ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $BOOLEAN_T)) (i32.eq ($VAL0 $ast) 1))) ) (func $false_Q (param $args i32) (result i32) (LET $ast ($MEM_VAL1_ptr $args)) ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $BOOLEAN_T)) (i32.eq ($VAL0 $ast) 0))) ) (func $number_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $INTEGER_T)))) (func $string_Q (param $args i32) (result i32) (LET $mv ($MEM_VAL1_ptr $args)) ($TRUE_FALSE (AND (i32.eq ($TYPE $mv) (global.get $STRING_T)) (i32.ne (i32.load8_u ($to_String $mv)) (CHR "\x7f")))) ) (func $keyword (param $args i32) (result i32) (LET $str ($to_String ($MEM_VAL1_ptr $args))) (if (result i32) (i32.eq (i32.load8_u $str) (CHR "\x7f")) (then ($INC_REF ($MEM_VAL1_ptr $args))) (else (drop ($sprintf_1 (global.get $printf_buf) "\x7f%s" $str)) ($STRING (global.get $STRING_T) (global.get $printf_buf)))) ) (func $keyword_Q (param $args i32) (result i32) (LET $ast ($MEM_VAL1_ptr $args)) ($TRUE_FALSE (AND (i32.eq ($TYPE $ast) (global.get $STRING_T)) (i32.eq (i32.load8_u ($to_String $ast)) (CHR "\x7f")))) ) (func $fn_Q (param $args i32) (result i32) (LET $type ($TYPE ($MEM_VAL1_ptr $args))) ($TRUE_FALSE (OR (i32.eq $type (global.get $FUNCTION_T)) (i32.eq $type (global.get $MALFUNC_T))))) (func $macro_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $MACRO_T)))) (func $symbol (param $args i32) (result i32) ($STRING (global.get $SYMBOL_T) ($to_String ($MEM_VAL1_ptr $args)))) (func $symbol_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $SYMBOL_T)))) (func $core_pr_str (param $args i32) (result i32) ($pr_str_seq $args 1 " ")) (func $str (param $args i32) (result i32) ($pr_str_seq $args 0 "")) (func $prn (param $args i32) (result i32) (LET $res ($pr_str_seq $args 1 " ")) ($printf_1 "%s\n" ($to_String $res)) ($RELEASE $res) ($INC_REF (global.get $NIL)) ) (func $println (param $args i32) (result i32) (LET $res ($pr_str_seq $args 0 " ")) ($printf_1 "%s\n" ($to_String $res)) ($RELEASE $res) ($INC_REF (global.get $NIL)) ) (func $core_readline (param $args i32) (result i32) (LET $line (STATIC_ARRAY 201) $mv 0) (if (i32.eqz ($readline ($to_String ($MEM_VAL1_ptr $args)) $line)) (return ($INC_REF (global.get $NIL)))) (local.set $mv ($STRING (global.get $STRING_T) $line)) $mv ) (func $read_string (param $args i32) (result i32) ($read_str ($to_String ($MEM_VAL1_ptr $args)))) (func $slurp (param $args i32) (result i32) (LET $mv ($STRING_INIT (global.get $STRING_T)) $size ($read_file ($to_String ($MEM_VAL1_ptr $args)) ($to_String $mv))) (if (i32.eqz $size) (then ($THROW_STR_1 "failed to read file '%s'" ($to_String ($MEM_VAL1_ptr $args))) (return ($INC_REF (global.get $NIL))))) (local.set $mv ($STRING_FINALIZE $mv $size)) $mv ) (func $lt (param $args i32) (result i32) ($TRUE_FALSE (i32.lt_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $lte (param $args i32) (result i32) ($TRUE_FALSE (i32.le_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $gt (param $args i32) (result i32) ($TRUE_FALSE (i32.gt_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $gte (param $args i32) (result i32) ($TRUE_FALSE (i32.ge_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $add (param $args i32) (result i32) ($INTEGER (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $subtract (param $args i32) (result i32) ($INTEGER (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $multiply (param $args i32) (result i32) ($INTEGER (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $divide (param $args i32) (result i32) ($INTEGER (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $time_ms (param $args i32) (result i32) ($INTEGER ($get_time_ms))) ;;; (func $list (param $args i32) (result i32) ($INC_REF $args)) (func $list_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) (global.get $LIST_T)))) (func $vector (param $args i32) (result i32) ($FORCE_SEQ_TYPE (global.get $VECTOR_T) $args)) (func $vector_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) (global.get $VECTOR_T)))) (func $hash_map (param $args i32) (result i32) (LET $type (global.get $HASHMAP_T) $res ($MAP_LOOP_START $type) $val2 0 $val3 0 $c 0 ;; push MAP_LOOP stack $ret $res $current $res $empty $res) ;; READ_SEQ_LOOP (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $args))) (local.set $val2 ($INC_REF ($MEM_VAL1_ptr $args))) (local.set $val3 ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))) ;; skip two (local.set $args ($MEM_VAL0_ptr ($MEM_VAL0_ptr $args))) ;; update the return sequence structure ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (br $loop) ) ) ;; MAP_LOOP_DONE $ret ) (func $hash_map_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($DEREF_META ($MEM_VAL1_ptr $args))) (global.get $HASHMAP_T)))) (func $assoc (param $args i32) (result i32) (LET $hm ($MEM_VAL1_ptr $args) $key 0) (local.set $args ($MEM_VAL0_ptr $args)) (drop ($INC_REF $hm)) (block $done (loop $loop (br_if $done (OR (i32.eqz ($VAL0 $args)) (i32.eqz ($VAL0 ($MEM_VAL0_ptr $args))))) (local.set $hm ($ASSOC1 $hm ($MEM_VAL1_ptr $args) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))) (local.set $args ($MEM_VAL0_ptr ($MEM_VAL0_ptr $args))) (br $loop) ) ) $hm ) (func $get (param $args i32) (result i32) (LET $hm ($MEM_VAL1_ptr $args) $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) (if (result i32) (i32.eq $hm (global.get $NIL)) (then ($INC_REF (global.get $NIL))) (else ($INC_REF (i32.wrap_i64 ($HASHMAP_GET $hm $key))))) ) (func $contains_Q (param $args i32) (result i32) (LET $hm ($MEM_VAL1_ptr $args) $key ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) ($TRUE_FALSE (if (result i32) (i32.eq $hm (global.get $NIL)) (then 0) (else (i32.wrap_i64 (i64.shr_u ($HASHMAP_GET $hm $key) (i64.const 32)))))) ) (func $keys_or_vals (param $hm i32 $keys i32) (result i32) (LET $res ($MAP_LOOP_START (global.get $LIST_T)) $val2 0 ;; MAP_LOOP stack $ret $res $current $res $empty $res) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $hm))) (if $keys (then (local.set $val2 ($INC_REF ($MEM_VAL1_ptr $hm)))) (else (local.set $val2 ($INC_REF ($MEM_VAL2_ptr $hm))))) ;; next element (local.set $hm ($MEM_VAL0_ptr $hm)) ;; update the return sequence structure ;; do not release val2 since we are pulling it from the ;; arguments and not creating it here ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (br $loop) ) ) ;; MAP_LOOP_DONE $ret ) (func $keys (param $args i32) (result i32) ($keys_or_vals ($MEM_VAL1_ptr $args) 1)) (func $vals (param $args i32) (result i32) ($keys_or_vals ($MEM_VAL1_ptr $args) 0)) (func $sequential_Q (param $args i32) (result i32) ($TRUE_FALSE (OR (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $LIST_T)) (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $VECTOR_T))))) (func $seq (param $args i32) (result i32) (LET $mv ($MEM_VAL1_ptr $args) $type ($TYPE $mv) $res 0 $ret 0 $empty 0 $current 0 $i 0 $char 0) (if (i32.eq $type (global.get $NIL_T)) (then (return (global.get $NIL)))) (if (AND (i32.ne $type (global.get $LIST_T)) (i32.ne $type (global.get $VECTOR_T)) (i32.ne $type (global.get $STRING_T))) (then (return (global.get $NIL)))) (if (i32.eqz ($VAL0 $mv)) (then (return (global.get $NIL)))) (if (i32.eq $type (global.get $LIST_T)) (then (return ($FORCE_SEQ_TYPE (global.get $LIST_T) $mv)))) (if (i32.eq $type (global.get $VECTOR_T)) (then (return ($FORCE_SEQ_TYPE (global.get $LIST_T) $mv)))) (if (i32.eq $type (global.get $STRING_T)) (then (local.set $mv ($to_String $mv)) (if (i32.eqz ($strlen $mv)) (then (return (global.get $NIL)))) (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) (local.set $empty $res) (local.set $current $res) (local.set $ret $res) (local.set $i 0) (block $done (loop $loop (local.set $char (i32.load8_u (i32.add $mv $i))) (br_if $done (i32.eq $char 0)) (i32.store8 (global.get $token_buf) $char) (i32.store8 (i32.add (global.get $token_buf) 1) 0) (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current ($STRING (global.get $STRING_T) (global.get $token_buf)) 0)) (if (i32.le_u $current (global.get $EMPTY_LIST)) ;; if first element, set return to new element (local.set $ret $res)) (local.set $i (i32.add $i 1)) (local.set $current $res) (br $loop) ) ) (return $ret) ) ) (global.get $NIL) ) (func $cons (param $args i32) (result i32) ($LIST ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)) ($MEM_VAL1_ptr $args))) (func $concat (param $args i32) (result i32) (local $last_sl i64) (LET $res ($INC_REF (global.get $EMPTY_LIST)) $current $res $sl 0 $last 0 $arg 0) (block $done (loop $loop (br_if $done (i32.le_u $args (global.get $EMPTY_HASHMAP))) (local.set $arg ($MEM_VAL1_ptr $args)) ;; skip empty elements (if (i32.le_s $arg (global.get $EMPTY_HASHMAP)) (then (local.set $args ($MEM_VAL0_ptr $args)) (br $loop))) (local.set $last_sl ($SLICE $arg 0 -1)) (local.set $sl (i32.wrap_i64 $last_sl)) (local.set $last (i32.wrap_i64 (i64.shr_u $last_sl (i64.const 32)))) (if (i32.eq $res (global.get $EMPTY_LIST)) (then ;; if this is the first element, set the return to the slice (local.set $res $sl)) (else ;; otherwise attach current to sliced (i32.store ($VAL0_ptr $current) ($IDX $sl)))) ;; update current to end of sliced list (local.set $current $last) ;; release empty since no longer part of the slice ($RELEASE (global.get $EMPTY_LIST)) (local.set $args ($MEM_VAL0_ptr $args)) (br $loop) ) ) $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))) $i 0) (block $done (loop $loop (br_if $done (OR (i32.ge_s $i $idx) (i32.eqz ($VAL0 $a)))) (local.set $i (i32.add $i 1)) (local.set $a ($MEM_VAL0_ptr $a)) (br $loop) ) ) (if (i32.eq ($VAL0 $a) 0) (then ($THROW_STR_0 "nth: index out of range") (return 0))) ($INC_REF ($MEM_VAL1_ptr $a)) ) (func $first (param $args i32) (result i32) (LET $res (global.get $NIL) $a ($MEM_VAL1_ptr $args)) (if (AND (i32.ne $a (global.get $NIL)) (i32.ne ($VAL0 $a) 0)) (local.set $res ($MEM_VAL1_ptr $a))) ($INC_REF $res) ) (func $rest (param $args i32) (result i32) (LET $a ($MEM_VAL1_ptr $args)) (if (i32.eq $a (global.get $NIL)) (return ($INC_REF (global.get $EMPTY_LIST)))) (if (i32.ne ($VAL0 $a) 0) (local.set $a ($MEM_VAL0_ptr $a))) ($FORCE_SEQ_TYPE (global.get $LIST_T) $a) ) ;;; (func $empty_Q (param $args i32) (result i32) ($TRUE_FALSE ($EMPTY_Q ($MEM_VAL1_ptr $args)))) (func $count (param $args i32) (result i32) ($INTEGER ($COUNT ($MEM_VAL1_ptr $args)))) (func $apply (param $args i32) (result i32) (local $last_sl i64) (LET $f ($MEM_VAL1_ptr $args) $f_args 0 $rest_args ($MEM_VAL0_ptr $args) $rest_count ($COUNT $rest_args) $last 0 $res 0) (if (i32.le_s $rest_count 1) (then ;; no intermediate args (if (i32.ne ($TYPE ($MEM_VAL1_ptr $rest_args)) (global.get $LIST_T)) (then ;; not a list, so convert it first (local.set $f_args ($FORCE_SEQ_TYPE (global.get $LIST_T) ($MEM_VAL1_ptr $rest_args)))) (else ;; inc ref since we will release after APPLY (local.set $f_args ($INC_REF ($MEM_VAL1_ptr $rest_args)))))) (else ;; 1 or more intermediate args (local.set $last_sl ($SLICE $rest_args 0 (i32.sub $rest_count 1))) (local.set $f_args (i32.wrap_i64 $last_sl)) (local.set $last (i32.wrap_i64 (i64.shr_u $last_sl (i64.const 32)))) ;; release the terminator of the new list (we skip over it) ;; we already checked for an empty list above, so $last is ;; a real non-empty list ($RELEASE ($MEM_VAL0_ptr $last)) ;; attach end of slice to final args element (i32.store ($VAL0_ptr $last) ($IDX ($LAST $rest_args))) )) (local.set $res ($APPLY $f $f_args)) ;; release new args ($RELEASE $f_args) $res ) (func $map (param $args i32) (result i32) (LET $f ($MEM_VAL1_ptr $args) $rest_args ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)) $f_args 0 $res ($MAP_LOOP_START (global.get $LIST_T)) ;; push MAP_LOOP stack $ret $res $current $res $empty $res) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $rest_args))) ;; create argument list for apply (local.set $f_args ($ALLOC (global.get $LIST_T) (global.get $EMPTY_LIST) ($MEM_VAL1_ptr $rest_args) 0)) (local.set $res ($APPLY $f $f_args)) ($RELEASE $f_args) ;; go to the next element (local.set $rest_args ($MEM_VAL0_ptr $rest_args)) (if (global.get $error_type) (then ;; if error, release the unattached element ($RELEASE $res) (br $done))) ;; update the return sequence structure ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $res 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (br $loop) ) ) ;; MAP_LOOP_DONE $ret ) ;;; (func $with_meta (param $args i32) (result i32) (LET $mv ($MEM_VAL1_ptr $args) $meta ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) ;; remove existing metadata first ($ALLOC (global.get $METADATA_T) ($DEREF_META $mv) $meta 0) ) (func $meta (param $args i32) (result i32) (if (result i32) (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $METADATA_T)) (then ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL1_ptr $args)))) (else ($INC_REF (global.get $NIL))))) (func $atom (param $args i32) (result i32) ($ALLOC_SCALAR (global.get $ATOM_T) ($VAL1 $args))) (func $atom_Q (param $args i32) (result i32) ($TRUE_FALSE (i32.eq ($TYPE ($MEM_VAL1_ptr $args)) (global.get $ATOM_T)))) (func $deref (param $args i32) (result i32) ($INC_REF ($MEM_VAL0_ptr ($MEM_VAL1_ptr $args)))) (func $_reset_BANG (param $atom i32 $val i32) (result i32) ;; release current value since we are about to overwrite it ($RELEASE ($MEM_VAL0_ptr $atom)) ;; inc ref by 2 for atom ownership and since we are returning it (drop ($INC_REF ($INC_REF $val))) ;; update the value (i32.store ($VAL0_ptr $atom) ($IDX $val)) $val ) (func $reset_BANG (param $args i32) (result i32) (LET $atom ($MEM_VAL1_ptr $args) $val ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) ($_reset_BANG $atom $val) ) (func $swap_BANG (param $args i32) (result i32) (LET $atom ($MEM_VAL1_ptr $args) $f_args ($MEM_VAL0_ptr $args) $rest_args ($MEM_VAL0_ptr $f_args) ;; add atom value to front of the args list $s_args ($LIST $rest_args ($MEM_VAL0_ptr $atom)) ;; cons $f ($MEM_VAL1_ptr $f_args) $res ($APPLY $f $s_args)) ;; release args ($RELEASE $s_args) ;; use reset to update the value (drop ($_reset_BANG $atom $res)) ;; but decrease the ref cnt of return by 1 (not sure why) ($RELEASE $res) $res ) ;;; (func $pr_memory_summary (param $args i32) (result i32) ($PR_MEMORY_SUMMARY_SMALL) ($INC_REF (global.get $NIL)) ) (func $nop (param $args i32) (result i32) ($INC_REF (global.get $NIL))) (table funcref (elem $nop ;; placeholder for eval which will use 0 $equal_Q $throw $nil_Q $true_Q $false_Q $number_Q $string_Q $symbol $symbol_Q $keyword $keyword_Q $fn_Q $macro_Q ;; 14 $core_pr_str $str $prn $println $core_readline $read_string $slurp $lt $lte $gt $gte $add $subtract $multiply $divide $time_ms ;; 30 $list $list_Q $vector $vector_Q $hash_map $hash_map_Q $assoc $nop ;; $dissoc $get $contains_Q $keys $vals ;; 42 $sequential_Q $cons $concat $nth $first $rest $empty_Q $count $apply $map $nop ;; $conj $seq ;; 54 $with_meta $meta $atom $atom_Q $deref $reset_BANG $swap_BANG $pr_memory_summary $vec ) ) (func $add_core_ns (param $env i32) ;;(drop ($ENV_SET_S $env "eval" ($FUNCTION 0))) (drop ($ENV_SET_S $env "=" ($FUNCTION 1))) (drop ($ENV_SET_S $env "throw" ($FUNCTION 2))) (drop ($ENV_SET_S $env "nil?" ($FUNCTION 3))) (drop ($ENV_SET_S $env "true?" ($FUNCTION 4))) (drop ($ENV_SET_S $env "false?" ($FUNCTION 5))) (drop ($ENV_SET_S $env "number?" ($FUNCTION 6))) (drop ($ENV_SET_S $env "string?" ($FUNCTION 7))) (drop ($ENV_SET_S $env "symbol" ($FUNCTION 8))) (drop ($ENV_SET_S $env "symbol?" ($FUNCTION 9))) (drop ($ENV_SET_S $env "keyword" ($FUNCTION 10))) (drop ($ENV_SET_S $env "keyword?" ($FUNCTION 11))) (drop ($ENV_SET_S $env "fn?" ($FUNCTION 12))) (drop ($ENV_SET_S $env "macro?" ($FUNCTION 13))) (drop ($ENV_SET_S $env "pr-str" ($FUNCTION 14))) (drop ($ENV_SET_S $env "str" ($FUNCTION 15))) (drop ($ENV_SET_S $env "prn" ($FUNCTION 16))) (drop ($ENV_SET_S $env "println" ($FUNCTION 17))) (drop ($ENV_SET_S $env "readline" ($FUNCTION 18))) (drop ($ENV_SET_S $env "read-string" ($FUNCTION 19))) (drop ($ENV_SET_S $env "slurp" ($FUNCTION 20))) (drop ($ENV_SET_S $env "<" ($FUNCTION 21))) (drop ($ENV_SET_S $env "<=" ($FUNCTION 22))) (drop ($ENV_SET_S $env ">" ($FUNCTION 23))) (drop ($ENV_SET_S $env ">=" ($FUNCTION 24))) (drop ($ENV_SET_S $env "+" ($FUNCTION 25))) (drop ($ENV_SET_S $env "-" ($FUNCTION 26))) (drop ($ENV_SET_S $env "*" ($FUNCTION 27))) (drop ($ENV_SET_S $env "/" ($FUNCTION 28))) (drop ($ENV_SET_S $env "time-ms" ($FUNCTION 29))) (drop ($ENV_SET_S $env "list" ($FUNCTION 30))) (drop ($ENV_SET_S $env "list?" ($FUNCTION 31))) (drop ($ENV_SET_S $env "vector" ($FUNCTION 32))) (drop ($ENV_SET_S $env "vector?" ($FUNCTION 33))) (drop ($ENV_SET_S $env "hash-map" ($FUNCTION 34))) (drop ($ENV_SET_S $env "map?" ($FUNCTION 35))) (drop ($ENV_SET_S $env "assoc" ($FUNCTION 36))) (drop ($ENV_SET_S $env "dissoc" ($FUNCTION 37))) (drop ($ENV_SET_S $env "get" ($FUNCTION 38))) (drop ($ENV_SET_S $env "contains?" ($FUNCTION 39))) (drop ($ENV_SET_S $env "keys" ($FUNCTION 40))) (drop ($ENV_SET_S $env "vals" ($FUNCTION 41))) (drop ($ENV_SET_S $env "sequential?" ($FUNCTION 42))) (drop ($ENV_SET_S $env "cons" ($FUNCTION 43))) (drop ($ENV_SET_S $env "concat" ($FUNCTION 44))) (drop ($ENV_SET_S $env "nth" ($FUNCTION 45))) (drop ($ENV_SET_S $env "first" ($FUNCTION 46))) (drop ($ENV_SET_S $env "rest" ($FUNCTION 47))) (drop ($ENV_SET_S $env "empty?" ($FUNCTION 48))) (drop ($ENV_SET_S $env "count" ($FUNCTION 49))) (drop ($ENV_SET_S $env "apply" ($FUNCTION 50))) (drop ($ENV_SET_S $env "map" ($FUNCTION 51))) (drop ($ENV_SET_S $env "conj" ($FUNCTION 52))) (drop ($ENV_SET_S $env "seq" ($FUNCTION 53))) (drop ($ENV_SET_S $env "with-meta" ($FUNCTION 54))) (drop ($ENV_SET_S $env "meta" ($FUNCTION 55))) (drop ($ENV_SET_S $env "atom" ($FUNCTION 56))) (drop ($ENV_SET_S $env "atom?" ($FUNCTION 57))) (drop ($ENV_SET_S $env "deref" ($FUNCTION 58))) (drop ($ENV_SET_S $env "reset!" ($FUNCTION 59))) (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))) ) ) ================================================ FILE: impls/wasm/debug.wam ================================================ (module $debug (func $checkpoint_user_memory (global.set $mem_user_start (global.get $mem_unused_start)) (global.set $string_mem_user_start (global.get $string_mem_next)) ) (func $CHECK_FREE_LIST (result i32) (LET $first (i32.add (global.get $mem) (i32.mul (global.get $mem_free_list) 4)) $count 0) (block $done (loop $loop (br_if $done (i32.ge_s $first (i32.add (global.get $mem) (i32.mul (global.get $mem_unused_start) 4)))) (local.set $count (i32.add $count ($MalVal_size $first))) (local.set $first (i32.add (global.get $mem) (i32.mul 4 ($VAL0 $first)))) (br $loop) ) ) $count ) (func $PR_MEMORY_SUMMARY_SMALL (LET $free (i32.sub (global.get $MEM_SIZE) (i32.mul (global.get $mem_unused_start) 4)) $free_list_count ($CHECK_FREE_LIST) $mv (global.get $NIL) $mem_ref_count 0) (block $done (loop $loop (br_if $done (i32.ge_s $mv (i32.add (global.get $mem) (i32.mul (global.get $mem_unused_start) 4)))) (if (i32.ne ($TYPE $mv) (global.get $FREE_T)) (local.set $mem_ref_count (i32.add $mem_ref_count (i32.shr_u (i32.load $mv) 5)))) (local.set $mv (i32.add $mv (i32.mul 4 ($MalVal_size $mv)))) (br $loop) ) ) ($printf_3 "Free: %d, Values: %d (refs: %d), Emptys: " $free (i32.sub (i32.sub (global.get $mem_unused_start) 1) $free_list_count) $mem_ref_count) (local.set $mv (global.get $NIL)) (block $done (loop $loop (br_if $done (i32.gt_s $mv (global.get $TRUE))) ($printf_1 "%d," (i32.div_s (i32.load $mv) 32)) (local.set $mv (i32.add $mv 8)) (br $loop) ) ) (local.set $mv (global.get $EMPTY_LIST)) (block $done (loop $loop (br_if $done (i32.gt_s $mv (global.get $EMPTY_HASHMAP))) ($printf_1 "%d," (i32.div_s (i32.load $mv) 32)) (local.set $mv (i32.add $mv 12)) (br $loop) ) ) ($print "\n") ) (func $PR_VALUE (param $fmt i32 $mv i32) (LET $temp ($pr_str $mv 1)) ($printf_1 $fmt ($to_String $temp)) ($RELEASE $temp) ) (func $PR_MEMORY_VALUE (param $idx i32) (result i32) ;;; mv = mem + idx (LET $mv ($MalVal_ptr $idx) $type ($TYPE $mv) $size ($MalVal_size $mv) $val0 ($MalVal_val $idx 0)) ($printf_2 "%4d: type %2d" $idx $type) (if (i32.eq $type 15) (then ($printf_1 ", size %2d" $size)) (else ($printf_1 ", refs %2d" ($REFS $mv)))) (if (OR (i32.eq $type (global.get $STRING_T)) (i32.eq $type (global.get $SYMBOL_T))) ;; for strings/symbolx pointers, print hex values (then ($printf_2 " [%4d|%3ds" ($MalVal_refcnt_type $idx) $val0)) (else ($printf_2 " [%4d|%4d" ($MalVal_refcnt_type $idx) $val0))) (if (i32.eq $size 2) (then ($print "|----|----]")) (else ($printf_1 "|%4d" ($MalVal_val $idx 1)) (if (i32.eq $size 3) (then ($print "|----]")) (else ($printf_1 "|%4d]" ($MalVal_val $idx 2)))))) ;;; printf(" >> ") ($print " >> ") (block $done (block $unknown (block (block (block (block (block (block (block (block (block (block (block (block (block (block (block (block (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 $unknown $type)) ;; 0: nil ($print "nil") (br $done)) ;; 1: boolean (if (i32.eq $val0 0) ;; true ($print "false") ;; false ($print "true")) (br $done)) ;; 2: integer ($printf_1 "%d" $val0) (br $done)) ;; 3: float/ERROR ($print " *** GOT FLOAT *** ") (br $done)) ;; 4: string/kw ($printf_1 "'%s'" ($to_String $mv)) (br $done)) ;; 5: symbol ($print ($to_String $mv)) (br $done)) ;; 6: list (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) (then ($print "()")) (else ;;; printf("(... %d ...), next: %d\n", mv->val[1], mv->val[0]) ($printf_2 "(... %d ...), next: %d" ($MalVal_val $idx 1) ($MalVal_val $idx 0)))) (br $done)) ;; 7: vector (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) (then ($print "[]")) (else ;;; printf("[... %d ...], next: %d\n", mv->val[1], mv->val[0])val ($printf_2 "[... %d ...], next: %d" ($MalVal_val $idx 1) ($MalVal_val $idx 0)))) (br $done)) ;; 8: hashmap (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) (then ($print "{}")) (else ;;; printf("{... '%s'(%d) : %d ...}\n", ;; to_String(mem + mv->val[1]), mv->val[1], mv->val[2]) ($printf_3 "{... '%s'(%d) : %d ...}" ($to_String ($MalVal_ptr ($MalVal_val $idx 1))) ($MalVal_val $idx 1) ($MalVal_val $idx 2)))) (br $done)) ;; 9: function ($print "function") (br $done)) ;; 10: mal function ($print "mal function") (br $done)) ;; 11: macro fn ($print "macro fn") (br $done)) ;; 12: atom ($print "atom") (br $done)) ;; 13: environment ($print "environment") (br $done)) ;; 14: metadata ($print "metadata") (br $done)) ;; 15: FREE ($printf_1 "FREE next: 0x%x" $val0) (if (i32.eq $idx (global.get $mem_free_list)) ($print " (free start)")) (if (i32.eq $val0 (global.get $mem_unused_start)) ($print " (free end)")) (br $done)) ;; 16: unknown ($print "unknown") ) ($print "\n") (i32.add $size $idx) ) (func $PR_STRINGS (param $start i32) (LET $ms 0 $idx 0) ($printf_2 "String - showing %d -> %d:\n" $start (i32.sub (global.get $string_mem_next) (global.get $string_mem))) (if (i32.le_s (i32.sub (global.get $string_mem_next) (global.get $string_mem)) $start) (then ($print " ---\n")) (else (local.set $ms (global.get $string_mem)) (block $done (loop $loop (br_if $done (i32.ge_u $ms (global.get $string_mem_next))) (local.set $idx (i32.sub $ms (global.get $string_mem))) (if (i32.ge_s $idx $start) ($printf_4 "%4d: refs %2d, size %2d >> '%s'\n" $idx (i32.load16_u $ms) (i32.load16_u (i32.add $ms 2)) (i32.add $ms 4))) (local.set $ms (i32.add $ms (i32.load16_u (i32.add $ms 2)))) (br $loop) ) ))) ) (func $PR_MEMORY (param $start i32 $end i32) (LET $string_start 0 $idx 0) (if (i32.lt_s $start 0) (then (local.set $start (global.get $mem_user_start)) (local.set $string_start (i32.sub (global.get $string_mem_user_start) (global.get $string_mem))))) (if (i32.lt_s $end 0) (local.set $end (global.get $mem_unused_start))) ;;; printf("Values - (mem) showing %d -> %d", start, end) ;;; printf(" (unused start: %d, free list: %d):\n", ;;; mem_unused_start, mem_free_list) ($printf_4 "Values - (mem) showing 0x%x -> 0x%x (unused start: 0x%x, free list: 0x%x):\n" $start $end (global.get $mem_unused_start) (global.get $mem_free_list)) (if (i32.le_s $end $start) (then ($print " ---\n") (local.set $end (global.get $mem_unused_start))) (else (local.set $idx $start) ;;; while (idx < end) (block $loopvals_exit (loop $loopvals (br_if $loopvals_exit (i32.ge_s $idx $end)) (local.set $idx ($PR_MEMORY_VALUE $idx)) (br $loopvals) ) ))) ($PR_STRINGS $string_start) ($PR_MEMORY_SUMMARY_SMALL) ) (func $PR_MEMORY_RAW (param $start i32 $end i32) (block $loop_exit (loop $loop (br_if $loop_exit (i32.ge_u $start $end)) ($printf_2 "0x%x 0x%x\n" $start (i32.load $start)) (local.set $start (i32.add 4 $start)) (br $loop) ) ) ) ) ================================================ FILE: impls/wasm/env.wam ================================================ (module $env (func $ENV_NEW (param $outer i32) (result i32) (LET $data ($HASHMAP) ;; allocate the data hashmap $env ($ALLOC (global.get $ENVIRONMENT_T) $data $outer 0)) ;; environment takes ownership ($RELEASE $data) $env ) (func $ENV_NEW_BINDS (param $outer i32 $binds i32 $exprs i32) (result i32) (LET $env ($ENV_NEW $outer) $key 0) ;; process bindings (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $binds))) ;; get/deref the key from binds (local.set $key ($MEM_VAL1_ptr $binds)) (if (i32.eqz ($strcmp "&" ($to_String $key))) (then ;; ENV_NEW_BIND_VARGS ;; get/deref the key from the next element of binds (local.set $binds ($MEM_VAL0_ptr $binds)) (local.set $key ($MEM_VAL1_ptr $binds)) ;; the value is the remaining list in exprs (local.set $exprs ($FORCE_SEQ_TYPE (global.get $LIST_T) $exprs)) ;; set the binding in the environment data (drop ($ENV_SET $env $key $exprs)) ;; list is owned by the environment ($RELEASE $exprs) (br $done)) (else ;; ENV_NEW_BIND_1x1 ;; set the binding in the environment data (drop ($ENV_SET $env $key ($MEM_VAL1_ptr $exprs))) ;; go to next element of binds and exprs (local.set $binds ($MEM_VAL0_ptr $binds)) (local.set $exprs ($MEM_VAL0_ptr $exprs)))) (br $loop) ) ) $env ) (func $ENV_SET (param $env i32 $key i32 $value i32) (result i32) (LET $data ($MEM_VAL0_ptr $env)) (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1 $data $key $value))) $value ) (func $ENV_SET_S (param $env i32 $key i32 $value i32) (result i32) (LET $data ($MEM_VAL0_ptr $env)) (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1_S $data $key $value))) $value ) (func $ENV_GET (param $env i32 $key i32) (result i32) ;; Return 0 when the key is not found, but do not set THROW_STR. (local $found_res i64) (LET $res 0 $data 0) (loop $loop (local.set $data ($MEM_VAL0_ptr $env)) (local.set $found_res ($HASHMAP_GET $data $key)) ;;; if (found) (if (i32.wrap_i64 (i64.shr_u $found_res (i64.const 32))) (then (local.set $res (i32.wrap_i64 $found_res)) (return ($INC_REF $res)))) (local.set $env ($MEM_VAL1_ptr $env)) (if (i32.eq $env (global.get $NIL)) (then (return 0))) (br $loop) ) ) ) ================================================ FILE: impls/wasm/mem.wam ================================================ (module $mem (global $MEM_SIZE i32 1048576) (global $STRING_MEM_SIZE i32 1048576) (global $heap_start (mut i32) 0) (global $heap_end (mut i32) 0) (global $mem (mut i32) 0) (global $mem_unused_start (mut i32) 0) (global $mem_free_list (mut i32) 0) (global $mem_user_start (mut i32) 0) (global $string_mem (mut i32) 0) (global $string_mem_next (mut i32) 0) (global $string_mem_user_start (mut i32) 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; General type storage/pointer functions (func $VAL0_ptr (param $mv i32) (result i32) (i32.add $mv 4)) (func $VAL1_ptr (param $mv i32) (result i32) (i32.add $mv 8)) (func $VAL0 (param $mv i32) (result i32) (i32.load (i32.add $mv 4))) (func $VAL1 (param $mv i32) (result i32) (i32.load (i32.add $mv 8))) (func $MEM_VAL0_ptr (param $mv i32) (result i32) (i32.add (global.get $mem) (i32.mul (i32.load (i32.add $mv 4)) 4))) (func $MEM_VAL1_ptr (param $mv i32) (result i32) (i32.add (global.get $mem) (i32.mul (i32.load (i32.add $mv 8)) 4))) (func $MEM_VAL2_ptr (param $mv i32) (result i32) (i32.add (global.get $mem) (i32.mul (i32.load (i32.add $mv 12)) 4))) ;; Returns the memory index mem of mv ;; Will usually be used with a load or store by the caller (func $IDX (param $mv i32) (result i32) ;; MalVal memory 64 bit (2 * i32) aligned (i32.div_u (i32.sub $mv (global.get $mem)) 4)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Returns the address of 'mem[mv_idx]' (func $MalVal_ptr (param $mv_idx i32) (result i32) ;; MalVal memory 64 bit (2 * i32) aligned ;;; mem[mv_idx].refcnt_type (i32.add (global.get $mem) (i32.mul $mv_idx 4))) ;; Returns the address of 'mem[mv_idx].refcnt_type' (func $MalVal_refcnt_type (param $mv_idx i32) (result i32) (i32.load ($MalVal_ptr $mv_idx))) (func $TYPE (param $mv i32) (result i32) ;;; type = mv->refcnt_type & 31 (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31 (func $SET_TYPE (param $mv i32 $type i32) ;;; type = mv->refcnt_type & 31 ;;; mv->refcnt_type += - (mv->refcnt_type & 31) + type (i32.store $mv (i32.or (i32.and $type 0x1f) ;; 0x1f == 31 (i32.and (i32.load $mv) 0xffffffe1))) ) (func $REFS (param $mv i32) (result i32) ;;; type = mv->refcnt_type & 31 (i32.shr_u (i32.load $mv) 5)) ;; / 32 ;; Returns the address of 'mem[mv_idx].val[val]' ;; Will usually be used with a load or store by the caller (func $MalVal_val_ptr (param $mv_idx i32 $val i32) (result i32) (i32.add (i32.add ($MalVal_ptr $mv_idx) 4) (i32.mul $val 4))) ;; Returns the value of 'mem[mv_idx].val[val]' (func $MalVal_val (param $mv_idx i32 $val i32) (result i32) (i32.load ($MalVal_val_ptr $mv_idx $val))) (func $MalType_size (param $type i32) (result i32) ;;; if (type <= 5 || type == 9 || type == 12) (if (result i32) (OR (i32.le_u $type 5) (i32.eq $type 9) (i32.eq $type 12)) (then 2) (else ;;; else if (type == 8 || type == 10 || type == 11) (if (result i32) (OR (i32.eq $type 8) (i32.eq $type 10) (i32.eq $type 11)) (then 4) (else 3))))) (func $MalVal_size (param $mv i32) (result i32) (LET $type ($TYPE $mv)) ;; if (type == FREE_T) (if (result i32) (i32.eq $type (global.get $FREE_T)) (then ;;; return (mv->refcnt_type & 0xffe0)>>5 (i32.shr_u (i32.and (i32.load $mv) 0xffe0) 5)) ;;; / 32 (else ;;; return MalType_size(type) ($MalType_size $type)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; init_memory (func $init_memory (LET $heap_size 0) ;; ($print ">>> init_memory\n") ($init_printf_mem) ;; error_str string buffer (global.set $error_str (STATIC_ARRAY 100)) ;; reader token string buffer (global.set $token_buf (STATIC_ARRAY 256)) ;; printer string buffer (global.set $printer_buf (STATIC_ARRAY 4096)) (local.set $heap_size (i32.add (global.get $MEM_SIZE) (global.get $STRING_MEM_SIZE))) (global.set $heap_start (i32.add (global.get $memoryBase) (global.get $S_STRING_END))) (global.set $heap_end (i32.add (global.get $heap_start) $heap_size)) (global.set $mem (global.get $heap_start)) (global.set $mem_unused_start 0) (global.set $mem_free_list 0) (global.set $string_mem (i32.add (global.get $heap_start) (global.get $MEM_SIZE))) (global.set $string_mem_next (global.get $string_mem)) (global.set $mem_user_start (global.get $mem_unused_start)) (global.set $string_mem_user_start (global.get $string_mem_next)) ;; Empty values (global.set $NIL ($ALLOC_SCALAR (global.get $NIL_T) 0)) (global.set $FALSE ($ALLOC_SCALAR (global.get $BOOLEAN_T) 0)) (global.set $TRUE ($ALLOC_SCALAR (global.get $BOOLEAN_T) 1)) (global.set $EMPTY_LIST ($ALLOC (global.get $LIST_T) (global.get $NIL) (global.get $NIL) (global.get $NIL))) (global.set $EMPTY_VECTOR ($ALLOC (global.get $VECTOR_T) (global.get $NIL) (global.get $NIL) (global.get $NIL))) (global.set $EMPTY_HASHMAP ($ALLOC (global.get $HASHMAP_T) (global.get $NIL) (global.get $NIL) (global.get $NIL))) ;; ($print "<<< init_memory\n") ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; memory management (func $ALLOC_INTERNAL (param $type i32 $val1 i32 $val2 i32 $val3 i32) (result i32) (LET $prev (global.get $mem_free_list) $res (global.get $mem_free_list) $size ($MalType_size $type)) (block $loop_done (loop $loop ;; res == mem_unused_start (if (i32.eq $res (global.get $mem_unused_start)) (then ;; ALLOC_UNUSED ;;; if (res + size > MEM_SIZE) (if (i32.gt_u (i32.add $res $size) (global.get $MEM_SIZE)) ;; Out of memory, exit ($fatal 7 "Out of mal memory!\n")) ;;; if (mem_unused_start += size) (global.set $mem_unused_start (i32.add (global.get $mem_unused_start) $size)) ;;; if (prev == res) (if (i32.eq $prev $res) (then (global.set $mem_free_list (global.get $mem_unused_start))) (else ;;; mem[prev].val[0] = mem_unused_start (i32.store ($MalVal_val_ptr $prev 0) (global.get $mem_unused_start)))) (br $loop_done))) ;; if (MalVal_size(mem+res) == size) (if (i32.eq ($MalVal_size ($MalVal_ptr $res)) $size) (then ;; ALLOC_MIDDLE ;;; if (res == mem_free_list) (if (i32.eq $res (global.get $mem_free_list)) ;; set free pointer (mem_free_list) to next free ;;; mem_free_list = mem[res].val[0]; (global.set $mem_free_list ($MalVal_val $res 0))) ;; if (res != mem_free_list) (if (i32.ne $res (global.get $mem_free_list)) ;; set previous free to next free ;;; mem[prev].val[0] = mem[res].val[0] (i32.store ($MalVal_val_ptr $prev 0) ($MalVal_val $res 0))) (br $loop_done))) ;;; prev = res (local.set $prev $res) ;;; res = mem[res].val[0] (local.set $res ($MalVal_val $res 0)) (br $loop) ) ) ;; ALLOC_DONE ;;; mem[res].refcnt_type = type + 32 (i32.store ($MalVal_ptr $res) (i32.add $type 32)) ;; set val to default val1 ;;; mem[res].val[0] = val1 (i32.store ($MalVal_val_ptr $res 0) $val1) ;;; if (type > 5 && type != 9) (if (AND (i32.gt_u $type 5) (i32.ne $type 9)) (then ;; inc refcnt of referenced value ;;; mem[val1].refcnt_type += 32 (i32.store ($MalVal_ptr $val1) (i32.add ($MalVal_refcnt_type $val1) 32)))) ;;; if (size > 2) (if (i32.gt_u $size 2) (then ;; inc refcnt of referenced value ;;; mem[val2].refcnt_type += 32 (i32.store ($MalVal_ptr $val2) (i32.add ($MalVal_refcnt_type $val2) 32)) ;;; mem[res].val[1] = val2 (i32.store ($MalVal_val_ptr $res 1) $val2))) ;;; if (size > 3) (if (i32.gt_u $size 3) (then ;; inc refcnt of referenced value ;;; mem[val3].refcnt_type += 32 (i32.store ($MalVal_ptr $val3) (i32.add ($MalVal_refcnt_type $val3) 32)) ;;; mem[res].val[2] = val3 (i32.store ($MalVal_val_ptr $res 2) $val3))) ;;; return mem + res ($MalVal_ptr $res) ) (func $ALLOC_SCALAR (param $type i32 $val1 i32) (result i32) ($ALLOC_INTERNAL $type $val1 0 0) ) (func $ALLOC (param $type i32 $val1 i32 $val2 i32 $val3 i32) (result i32) ($ALLOC_INTERNAL $type ($IDX $val1) ($IDX $val2) ($IDX $val3)) ) (func $RELEASE (param $mv i32) (LET $idx 0 $type 0 $size 0) ;; Ignore NULLs ;;; if (mv == NULL) { return; } (if (i32.eqz $mv) (return)) ;;; idx = mv - mem (local.set $idx ($IDX $mv)) ;;; type = mv->refcnt_type & 31 (local.set $type (i32.and (i32.load $mv) 0x1f)) ;; 0x1f == 31 ;;; size = MalType_size(type) (local.set $size ($MalType_size $type)) ;; DEBUG ;;; printf(">>> RELEASE idx: %d, type: %d, size: %d\n", idx, type, size) (if (i32.eq 0 $mv) ($fatal 7 "RELEASE of NULL!\n")) (if (i32.eq (global.get $FREE_T) $type) (then ($printf_2 "RELEASE of already free mv: 0x%x, idx: 0x%x\n" $mv $idx) ($fatal 1 ""))) (if (i32.lt_u ($MalVal_refcnt_type $idx) 15) (then ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx) ($fatal 1 ""))) ;; decrease reference count by one (i32.store ($MalVal_ptr $idx) (i32.sub ($MalVal_refcnt_type $idx) 32)) ;; nil, false, true, empty sequences (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) (then (if (i32.lt_u ($MalVal_refcnt_type $idx) 32) (then ($printf_2 "RELEASE of unowned mv: 0x%x, idx: 0x%x\n" $mv $idx) ($fatal 1 ""))) (return))) ;; our reference count is not 0, so don't release (if (i32.ge_u ($MalVal_refcnt_type $idx) 32) (return)) (block $done (block (block (block (block (block (block (block (block (block (br_table 0 0 0 0 1 1 2 2 3 0 4 4 5 6 7 8 8 $type)) ;; nil, boolean, integer, float (br $done)) ;; string, kw, symbol ;; release string, then FREE reference ($RELEASE_STRING (i32.add (global.get $string_mem) ($VAL0 $mv))) (br $done)) ;; list, vector (if (i32.ne ($MalVal_val $idx 0) 0) (then ;; release next element and value ($RELEASE ($MEM_VAL0_ptr $mv)) ($RELEASE ($MEM_VAL1_ptr $mv)))) (br $done)) ;; hashmap (if (i32.ne ($MalVal_val $idx 0) 0) (then ;; release next element, value, and key ($RELEASE ($MEM_VAL0_ptr $mv)) ($RELEASE ($MEM_VAL2_ptr $mv)) ($RELEASE ($MEM_VAL1_ptr $mv)))) (br $done)) ;; mal / macro function ;; release ast, params, and environment ($RELEASE ($MEM_VAL2_ptr $mv)) ($RELEASE ($MEM_VAL1_ptr $mv)) ($RELEASE ($MEM_VAL0_ptr $mv)) (br $done)) ;; atom ;; release contained/referred value ($RELEASE ($MEM_VAL0_ptr $mv)) (br $done)) ;; env ;; if outer is set then release outer (if (i32.ne ($MalVal_val $idx 1) 0) ($RELEASE ($MEM_VAL1_ptr $mv))) ;; release the env data (hashmap) ($RELEASE ($MEM_VAL0_ptr $mv)) (br $done)) ;; metadata ;; release object and metdata object ($RELEASE ($MEM_VAL0_ptr $mv)) ($RELEASE ($MEM_VAL1_ptr $mv)) (br $done)) ;; default/unknown ) ;; FREE, free the current element ;; set type(FREE/15) and size ;;; mv->refcnt_type = size*32 + FREE_T (i32.store $mv (i32.add (i32.mul $size 32) (global.get $FREE_T))) (i32.store ($MalVal_val_ptr $idx 0) (global.get $mem_free_list)) (global.set $mem_free_list $idx) (if (i32.ge_u $size 3) (i32.store ($MalVal_val_ptr $idx 1) 0)) (if (i32.eq $size 4) (i32.store ($MalVal_val_ptr $idx 2) 0)) ) ;; find string in string memory or 0 if not found (func $FIND_STRING (param $str i32) (result i32) (LET $ms (global.get $string_mem)) (block $done (loop $loop (br_if $done (i32.ge_s $ms (global.get $string_mem_next))) (if (i32.eqz ($strcmp $str (i32.add $ms 4))) (return $ms)) (local.set $ms (i32.add $ms (i32.load16_u (i32.add $ms 2)))) (br $loop) ) ) 0 ) ;; str is a NULL terminated string ;; size is number of characters in the string not including the ;; trailing NULL (func $ALLOC_STRING (param $str i32 $size i32 $intern i32) (result i32) (LET $ms 0) ;; search for matching string in string_mem (if $intern (then (local.set $ms ($FIND_STRING $str)) (if $ms (then ;;; ms->refcnt += 1 (i32.store16 $ms (i32.add (i32.load16_u $ms) 1)) (return $ms))))) ;; no existing matching string so create a new one (local.set $ms (global.get $string_mem_next)) (i32.store16 $ms 1) ;;; ms->size = sizeof(MalString)+size+1 (i32.store16 offset=2 $ms (i32.add (i32.add 4 $size) 1)) ($memmove (i32.add $ms 4) $str (i32.add $size 1)) ;;; string_mem_next = (void *)ms + ms->size (global.set $string_mem_next ;;(i32.add $ms (i32.load16_u (i32.add $ms 2)))) (i32.add $ms (i32.load16_u offset=2 $ms))) ;;($printf_2 "ALLOC_STRING 6 ms 0x%x, refs: %d\n" $ms (i32.load16_u $ms)) $ms ) (func $RELEASE_STRING (param $ms i32) (LET $size 0 $next 0 $ms_idx 0 $idx 0 $type 0 $mv 0) (if (i32.le_s (i32.load16_u $ms) 0) (then ($printf_2 "Release of already free string: %d (0x%x)\n" (i32.sub $ms (global.get $string_mem)) $ms) ($fatal 1 ""))) ;;; size = ms->size (local.set $size (i32.load16_u (i32.add $ms 2))) ;;; *next = (void *)ms + size (local.set $next (i32.add $ms $size)) ;;; ms->refcnt -= 1 (i32.store16 $ms (i32.sub (i32.load16_u $ms) 1)) (if (i32.eqz (i32.load16_u $ms)) (then (if (i32.gt_s (global.get $string_mem_next) $next) (then ;; If no more references to this string then free it up by ;; shifting up every string afterwards to fill the gap ;; (splice). ($memmove $ms $next (i32.sub (global.get $string_mem_next) $next)) ;; Scan the mem values for string types after the freed ;; string and shift their indexes by size (local.set $ms_idx (i32.sub $ms (global.get $string_mem))) (local.set $idx ($IDX (global.get $EMPTY_HASHMAP))) (loop $loop (local.set $mv ($MalVal_ptr $idx)) (local.set $type ($TYPE $mv)) (if (AND (i32.gt_s ($VAL0 $mv) $ms_idx) (OR (i32.eq $type (global.get $STRING_T)) (i32.eq $type (global.get $SYMBOL_T)))) (i32.store ($VAL0_ptr $mv) (i32.sub ($VAL0 $mv) $size))) (local.set $idx (i32.add $idx ($MalVal_size $mv))) (br_if $loop (i32.lt_s $idx (global.get $mem_unused_start))) ))) (global.set $string_mem_next (i32.sub (global.get $string_mem_next) $size)))) ) ) ================================================ FILE: impls/wasm/node_readline.js ================================================ // IMPORTANT: choose one var RL_LIB = "libreadline"; // NOTE: libreadline is GPL //var RL_LIB = "libedit"; var HISTORY_FILE = require('path').join(process.env.HOME, '.mal-history'); var rlwrap = {}; // namespace for this module in web context var ffi = require('ffi-napi'), fs = require('fs'); var rllib = ffi.Library(RL_LIB, { 'readline': [ 'string', [ 'string' ] ], 'add_history': [ 'int', [ 'string' ] ]}); var rl_history_loaded = false; exports.readline = rlwrap.readline = function(prompt) { prompt = typeof prompt !== 'undefined' ? prompt : "user> "; if (!rl_history_loaded) { rl_history_loaded = true; var lines = []; if (fs.existsSync(HISTORY_FILE)) { lines = fs.readFileSync(HISTORY_FILE).toString().split("\n"); } // Max of 2000 lines lines = lines.slice(Math.max(lines.length - 2000, 0)); for (var i=0; i n 0) (+ n (abcdefg (- n 1))) 0))) (if (i32.eq (CHR "\n") (i32.load8_u (i32.add $buf (i32.sub (i32.load $nread_ptr) 1)) 0)) (i32.store8 (i32.add $buf (i32.sub (i32.load $nread_ptr) 1)) 0)) 1 ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (func $read_file (param $path i32 $buf i32) (result i32) (LET $orig_path $path $ret 0 $prestat_ptr (STATIC_ARRAY 8 4) $pr_type 0 $pr_name_len 0 $prepath (STATIC_ARRAY 1024) $dirfd -1 $fd 3 $fd_ptr (STATIC_ARRAY 4 4) $nread_ptr (STATIC_ARRAY 4 4) $iovec (STATIC_ARRAY 8 8)) ;; Find the pre-opened dir fd with the same prefix as the our path ;; following the algorithm at: ;; https://github.com/CraneStation/wasi-sysroot/blob/1cc98f27f5ab8afdc033e16eac8799ee606eb769/libc-bottom-half/crt/crt1.c#L71 ;; The matching dir fd is then used to open and read the path. (block $loop_done (loop $loop ;; prestat the fd from 3 onward until EBADF is returned (local.set $ret ($fd_prestat_get $fd $prestat_ptr)) (if (i32.eq (global.get $WASI_EBADF) $ret) (br $loop_done)) (if (i32.ne (global.get $WASI_ESUCCESS) $ret) (then (local.set $fd (i32.add 1 $fd)) (br $loop))) ;;(br $loop_done)) (local.set $pr_type (i32.load $prestat_ptr)) (local.set $pr_name_len (i32.load offset=4 $prestat_ptr)) ;; Read the pre-opened path name (local.set $ret ($fd_prestat_dir_name $fd $prepath $pr_name_len)) (if (i32.ne (global.get $WASI_ESUCCESS) $ret) (br $loop_done)) ;; if pr_name_len includes a null, exclude it from the compare ;;($printf_2 "here1 pr_name_len: %d, char is %d\n" $pr_name_len (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1)))) (if (i32.eqz (i32.load8_u (i32.add $prepath (i32.sub $pr_name_len 1)))) (then (local.set $pr_name_len (i32.sub $pr_name_len 1)))) ;; if it is a dir and the path prefix matches, use it ;;($printf_5 "fd: %d, ret: %d, pr_type: %d, pr_name_len: %d, prepath: %s\n" ;; $fd $ret $pr_type $pr_name_len $prepath) (if (AND (i32.eq $pr_type (global.get $WASI_PREOPENTYPE_DIR)) (i32.eqz ($strncmp $prepath $path $pr_name_len))) (then (local.set $path (i32.add $pr_name_len $path)) (local.set $dirfd $fd) (br $loop_done))) (local.set $fd (i32.add 1 $fd)) (br $loop) ) ) ;;($printf_3 "final dirfd: %d, adjusted path: %s (%d)\n" $dirfd $path ($strlen $path)) (if (i32.eq $dirfd -1) (then ($printf_1 "ERROR: could not find permission for '%s'\n" $orig_path) (return 0))) (local.set $ret ($path_open $dirfd 1 ;; dirflags (symlink follow) $path ($strlen $path) 0 ;; o_flags (global.get $WASI_RIGHT_FD_READ) (global.get $WASI_RIGHT_FD_READ) 0 ;; fs_flags $fd_ptr)) (if (i32.ne (global.get $WASI_ESUCCESS) $ret) (then ($printf_2 "ERROR: failed to open '%s', error %d\n" $orig_path $ret) (return 0))) (i32.store $iovec $buf) ;; TODO: use stat result instead of not hardcoded length (i32.store offset=4 $iovec 16384) (local.set $ret ($fd_read (i32.load $fd_ptr) $iovec 1 $nread_ptr)) (if (i32.ne (global.get $WASI_ESUCCESS) $ret) (then ($printf_2 "ERROR: failed to read '%s', error %d\n" $orig_path $ret) (return 0))) ;; Add null to string (i32.store8 (i32.add $buf (i32.load $nread_ptr)) 0) (i32.add 1 (i32.load $nread_ptr)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (func $get_time_ms (result i32) (LET $tv (STATIC_ARRAY 8 8)) (drop (call $clock_time_get 0 (i64.const 0) $tv)) (i32.wrap_i64 ;; convert nanoseconds to milliseconds (i64.div_u (i64.load $tv) (i64.const 1000000))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Returns an i64 with argc in high 32 and argv in low 32. ;; String memory is: argv + (argc * 4) (func $get_argc_argv (result i64) (LET $argc_ptr (STATIC_ARRAY 4 4) $argv_size_ptr (STATIC_ARRAY 4 4) $argc 0 $argv (STATIC_ARRAY 1024 4)) (drop ($args_sizes_get $argc_ptr $argv_size_ptr)) (local.set $argc (i32.load $argc_ptr)) (if (i32.gt_u (i32.add (i32.mul 4 $argc) (i32.load $argv_size_ptr)) 1024) ($fatal 2 "Command line arguments memory exceeds 1024 bytes")) (drop ($args_get $argv (i32.add $argv (i32.mul 4 $argc)))) (i64.or (i64.shl (i64.extend_i32_u $argc) (i64.const 32)) (i64.extend_i32_u $argv)) ) (func $entry (local $argc_argv i64) ($init_memory) (local.set $argc_argv ($get_argc_argv)) ($proc_exit ($main (i32.wrap_i64 (i64.shr_u $argc_argv (i64.const 32))) (i32.wrap_i64 $argc_argv))) ) ;;(start $entry) (export "_start" (func $entry)) ) ================================================ FILE: impls/wasm/printer.wam ================================================ (module $printer (global $printer_buf (mut i32) 0) (func $pr_str_val (param $res i32 $mv i32 $print_readably i32) (result i32) (LET $type ($TYPE $mv) $val0 ($VAL0 $mv) $sval 0) ;;; switch(type) (block $done (block $default (block (block (block (block (block (block (block (block (block (block (block (block (block (block (block (block (br_table 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 $type)) ;; 0: nil ($memmove $res "nil" 4) (local.set $res (i32.add 3 $res)) (br $done)) ;; 1: boolean (if (i32.eq $val0 0) (then ;; false ($memmove $res "false" 6) (local.set $res (i32.add 5 $res))) (else ;; true ($memmove $res "true" 5) (local.set $res (i32.add 4 $res)))) (br $done)) ;; 2: integer (local.set $res ($sprintf_1 $res "%d" $val0)) (br $done)) ;; 3: float/ERROR (local.set $res ($sprintf_1 $res "%d" " *** GOT FLOAT *** ")) (br $done)) ;; 4: string/kw (local.set $sval ($to_String $mv)) (if (i32.eq (i32.load8_u $sval) (CHR "\x7f")) (then (local.set $res ($sprintf_1 $res ":%s" (i32.add $sval 1)))) (else (if $print_readably (then ;; escape backslashes, quotes, and newlines (local.set $res ($sprintf_1 $res "\"" 0)) (local.set $res (i32.add $res ($REPLACE3 $res ($to_String $mv) "\\" "\\\\" "\"" "\\\"" "\n" "\\n"))) (local.set $res ($sprintf_1 $res "\"" 0))) (else (local.set $res ($sprintf_1 $res "%s" $sval)))))) (br $done)) ;; 5: symbol (local.set $res ($sprintf_1 $res "%s" ($to_String $mv))) (br $done)) ;; 6: list, fallthrouogh ) ;; 7: vector, fallthrough ) ;; 8: hashmap (local.set $res ($sprintf_1 $res "%c" (if (result i32) (i32.eq $type (global.get $LIST_T)) (then (CHR "(")) (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) (then (CHR "[")) (else (CHR "{"))))))) ;; PR_SEQ_LOOP ;;; while (VAL0(mv) != 0) (block $done_seq (loop $seq_loop (br_if $done_seq (i32.eq ($VAL0 $mv) 0)) ;;; res = pr_str_val(res, MEM_VAL1(mv), print_readably) (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably)) ;; if this is a hash-map, print the next element (if (i32.eq $type (global.get $HASHMAP_T)) (then ;;; res += snprintf(res, 2, " ") (local.set $res ($sprintf_1 $res " " 0)) (local.set $res ($pr_str_val $res ($MEM_VAL2_ptr $mv) $print_readably)))) ;;; mv = MEM_VAL0(mv) (local.set $mv ($MEM_VAL0_ptr $mv)) ;;; if (VAL0(mv) != 0) (if (i32.ne ($VAL0 $mv) 0) ;;; res += snprintf(res, 2, " ") (local.set $res ($sprintf_1 $res " " 0))) (br $seq_loop) ) ) (local.set $res ($sprintf_1 $res "%c" (if (result i32) (i32.eq $type (global.get $LIST_T)) (then (CHR ")")) (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) (then (CHR "]")) (else (CHR "}"))))))) (br $done)) ;; 9: function ($memmove $res "#" 10) (local.set $res (i32.add 9 $res)) (br $done)) ;; 10: mal function ($memmove $res "(fn* " 6) (local.set $res (i32.add 5 $res)) (local.set $res ($pr_str_val $res ($MEM_VAL1_ptr $mv) $print_readably)) ($memmove $res " " 2) (local.set $res (i32.add 1 $res)) (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) ($memmove $res ")" 2) (local.set $res (i32.add 1 $res)) (br $done)) ;; 11: macro fn ($memmove $res "#" 13) (local.set $res (i32.add 12 $res)) (br $done)) ;; 12: atom ($memmove $res "(atom " 7) (local.set $res (i32.add 6 $res)) (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) ($memmove $res ")" 2) (local.set $res (i32.add 1 $res)) (br $done)) ;; 13: environment ($memmove $res "#" 11) (local.set $res (i32.add 10 $res)) (br $done)) ;; 14: metadata ;; recur on object itself (local.set $res ($pr_str_val $res ($MEM_VAL0_ptr $mv) $print_readably)) (br $done)) ;; 15: FREE ($memmove $res "#" 12) (local.set $res (i32.add 11 $res)) (br $done)) ;; 16: default ($memmove $res "#" 11) (local.set $res (i32.add 10 $res)) ) $res ) (func $pr_str_internal (param $seq i32) (param $mv i32) (param $print_readably i32) (param $sep i32) (result i32) (LET $res ($STRING_INIT (global.get $STRING_T)) $res_str ($to_String $res)) (if $seq (then (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $mv))) (local.set $res_str ($pr_str_val $res_str ($MEM_VAL1_ptr $mv) $print_readably)) (local.set $mv ($MEM_VAL0_ptr $mv)) (if (i32.ne ($VAL0 $mv) 0) (local.set $res_str ($sprintf_1 $res_str "%s" $sep))) (br $loop) ) )) (else (local.set $res_str ($pr_str_val $res_str $mv $print_readably)))) (local.set $res ($STRING_FINALIZE $res (i32.sub $res_str ($to_String $res)))) $res ) (func $pr_str (param $mv i32 $print_readably i32) (result i32) ($pr_str_internal 0 $mv $print_readably "") ) (func $pr_str_seq (param $mv i32 $print_readably i32 $sep i32) (result i32) ($pr_str_internal 1 $mv $print_readably $sep) ) (export "pr_str" (func $pr_str)) ) ================================================ FILE: impls/wasm/printf.wam ================================================ (module $printf (global $printf_buf (mut i32) 0) (func $init_printf_mem ;; sprintf static buffer (global.set $printf_buf (STATIC_ARRAY 256)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (func $printf_1 (param $fmt i32) (param $v0 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 0 0 0 0 0)) ($print (global.get $printf_buf)) ) (func $printf_2 (param $fmt i32 $v0 i32 $v1 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 0 0 0 0)) ($print (global.get $printf_buf)) ) (func $printf_3 (param $fmt i32) (param $v0 i32) (param $v1 i32) (param $v2 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 0 0 0)) ($print (global.get $printf_buf)) ) (func $printf_4 (param $fmt i32) (param $v0 i32) (param $v1 i32) (param $v2 i32) (param $v3 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 0 0)) ($print (global.get $printf_buf)) ) (func $printf_5 (param $fmt i32) (param $v0 i32) (param $v1 i32) (param $v2 i32) (param $v3 i32) (param $v4 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 0)) ($print (global.get $printf_buf)) ) (func $printf_6 (param $fmt i32) (param $v0 i32) (param $v1 i32) (param $v2 i32) (param $v3 i32) (param $v4 i32) (param $v5 i32) (drop ($sprintf_6 (global.get $printf_buf) $fmt $v0 $v1 $v2 $v3 $v4 $v5)) ($print (global.get $printf_buf)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (func $_sprintdigit (param $str i32) (param $num i32) (param $base i32) (LET $n (i32.rem_u $num $base) $ch (if (result i32) (i32.lt_u $n 10) 48 55)) (i32.store8 $str (i32.add $n $ch)) ) ;; TODO: add max buf length (i.e. snprintnum) (func $_sprintnum (param $buf i32) (param $val i32) (param $radix i32) (param $pad_cnt i32) (param $pad_char i32) (result i32) (LET $pbuf $buf $neg 0 $i 0 $j 0 $k 0 $len 0 $digit 0) (if (AND (i32.lt_s $val 0) (i32.eq $radix 10)) (then (local.set $neg 1) (local.set $val (i32.sub 0 $val)))) ;; Calculate smallest to most significant digit (loop $loop (local.set $digit (i32.rem_u $val $radix)) (i32.store8 $pbuf (if (result i32) (i32.lt_u $digit 10) (i32.add (CHR "0") $digit) (i32.sub (i32.add (CHR "A") $digit) 10))) (local.set $pbuf (i32.add $pbuf 1)) (local.set $val (i32.div_u $val $radix)) (br_if $loop (i32.gt_u $val 0)) ) (local.set $i (i32.sub $pbuf $buf)) (block $done (loop $loop (br_if $done (i32.ge_u $i $pad_cnt)) (i32.store8 $pbuf $pad_char) (local.set $pbuf (i32.add $pbuf 1)) (local.set $i (i32.add $i 1)) (br $loop) ) ) (if $neg (then (i32.store8 $pbuf (CHR "-")) (local.set $pbuf (i32.add $pbuf 1)))) (i32.store8 $pbuf (CHR "\x00")) ;; now reverse it (local.set $len (i32.sub $pbuf $buf)) (local.set $i 0) (block $done (loop $loop (br_if $done (i32.ge_u $i (i32.div_u $len 2))) (local.set $j (i32.load8_u (i32.add $buf $i))) (local.set $k (i32.add $buf (i32.sub (i32.sub $len $i) 1))) (i32.store8 (i32.add $buf $i) (i32.load8_u $k)) (i32.store8 $k $j) (local.set $i (i32.add $i 1)) (br $loop) ) ) (i32.add $buf $len) ) ;; TODO: switch to snprint* (add buffer len) (func $sprintf_1 (param $str i32) (param $fmt i32) (param $v0 i32) (result i32) ($sprintf_6 $str $fmt $v0 0 0 0 0 0) ) (func $sprintf_6 (param $str i32) (param $fmt i32) (param $v0 i32) (param $v1 i32) (param $v2 i32) (param $v3 i32) (param $v4 i32) (param $v5 i32) (result i32) (LET $pstr $str $vidx 0 $ch 0 $v 0 $len 0 $pad_cnt 0 $pad_char 0) (block $done (loop $loop (block $after_v ;; set $v to the current parameter (block (block (block (block (block (block (br_table 0 1 2 3 4 5 0 $vidx)) (; 0 ;) (local.set $v $v0) (br $after_v)) (; 1 ;) (local.set $v $v1) (br $after_v)) (; 2 ;) (local.set $v $v2) (br $after_v)) (; 3 ;) (local.set $v $v3) (br $after_v)) (; 4 ;) (local.set $v $v4) (br $after_v)) (; 5 ;) (local.set $v $v5) (br $after_v) ) ;;; while ((ch=*(fmt++))) (local.set $ch (i32.load8_u $fmt)) (local.set $fmt (i32.add 1 $fmt)) (br_if $done (i32.eqz $ch)) ;; TODO: check buffer length (if (i32.ne $ch (CHR "%")) (then ;; TODO: check buffer length (i32.store8 $pstr $ch) (local.set $pstr (i32.add 1 $pstr)) (br $loop))) ;;; ch=*(fmt++) (local.set $ch (i32.load8_u $fmt)) (local.set $fmt (i32.add 1 $fmt)) (br_if $done (i32.eqz $ch)) (local.set $pad_cnt 0) (local.set $pad_char (CHR " ")) (if (AND (i32.ge_s $ch (CHR "0")) (i32.le_s $ch (CHR "9"))) (then ;; padding requested (if (i32.eq $ch (CHR "0")) (then ;; zero padding requested (local.set $pad_char (CHR "0")) ;;; ch=*(fmt++) (local.set $ch (i32.load8_u $fmt)) (local.set $fmt (i32.add 1 $fmt)) (br_if $done (i32.eqz $ch)))) (loop $loop (local.set $pad_cnt (i32.mul $pad_cnt 10)) (local.set $pad_cnt (i32.add $pad_cnt (i32.sub $ch (CHR "0")))) (local.set $ch (i32.load8_u $fmt)) (local.set $fmt (i32.add 1 $fmt)) (br_if $loop (AND (i32.ge_s $ch (CHR "0")) (i32.le_s $ch (CHR "9")))) ))) (if (i32.eq (CHR "d") $ch) (then (local.set $pstr ($_sprintnum $pstr $v 10 $pad_cnt $pad_char))) (else (if (i32.eq (CHR "x") $ch) (then (local.set $pstr ($_sprintnum $pstr $v 16 $pad_cnt $pad_char))) (else (if (i32.eq (CHR "s") $ch) (then (local.set $len ($strlen $v)) (block $done (loop $loop (br_if $done (i32.le_s $pad_cnt $len)) (i32.store8 $pstr (CHR " ")) (local.set $pstr (i32.add $pstr 1)) (local.set $pad_cnt (i32.sub $pad_cnt 1)) (br $loop) ) ) ($memmove $pstr $v $len) (local.set $pstr (i32.add $pstr $len))) (else (if (i32.eq (CHR "c") $ch) (then (i32.store8 $pstr $v) (local.set $pstr (i32.add $pstr 1))) (else (if (i32.eq (CHR "%") $ch) (then (i32.store8 $pstr (CHR "%")) (local.set $pstr (i32.add $pstr 1)) (br $loop)) ;; don't increase vidx (else ($printf_1 "Illegal format character: '%c'\n" $ch) ($fatal 3 ""))))))))))) (local.set $vidx (i32.add 1 $vidx)) (br $loop) ) ) (i32.store8 $pstr (CHR "\x00")) $pstr ) ) ================================================ FILE: impls/wasm/reader.wam ================================================ (module $reader ;; TODO: global warning (global $token_buf (mut i32) 0) (global $read_index (mut i32) 0) (func $skip_spaces (param $str i32) (result i32) (LET $found 0 $c (i32.load8_u (i32.add $str (global.get $read_index)))) (block $done (loop $loop ;;; while (c == ' ' || c == ',' || c == '\n') (br_if $done (AND (i32.ne $c (CHR " ")) (i32.ne $c (CHR ",")) (i32.ne $c (CHR "\n")))) (local.set $found 1) ;;; c=str[++(*index)] (global.set $read_index (i32.add (global.get $read_index) 1)) (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) (br $loop) ) ) ;; ($debug ">>> skip_spaces:" $found) $found ) (func $skip_to_eol (param $str i32) (result i32) (LET $found 0 $c (i32.load8_u (i32.add $str (global.get $read_index)))) (if (i32.eq $c (CHR ";")) (then (local.set $found 1) (block $done (loop $loop ;;; c=str[++(*index)] (global.set $read_index (i32.add (global.get $read_index) 1)) (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) ;;; while (c != '\0' && c != '\n') (br_if $loop (AND (i32.ne $c (CHR "\x00")) (i32.ne $c (CHR "\n")))) ) ))) ;; ($debug ">>> skip_to_eol:" $found) $found ) (func $skip_spaces_comments (param $str i32) (loop $loop ;; skip spaces (br_if $loop ($skip_spaces $str)) ;; skip comments (br_if $loop ($skip_to_eol $str)) ) ) (func $read_token (param $str i32) (result i32) (LET $token_index 0 $isstring 0 $instring 0 $escaped 0 $c 0) ($skip_spaces_comments $str) ;; read first character ;;; c=str[++(*index)] (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) (global.set $read_index (i32.add (global.get $read_index) 1)) ;; read first character ;;; token[token_index++] = c (i32.store8 (i32.add (global.get $token_buf) $token_index) $c) (local.set $token_index (i32.add $token_index 1)) ;; single/double character token (if (OR (i32.eq $c (CHR "(")) (i32.eq $c (CHR ")")) (i32.eq $c (CHR "[")) (i32.eq $c (CHR "]")) (i32.eq $c (CHR "{")) (i32.eq $c (CHR "}")) (i32.eq $c (CHR "'")) (i32.eq $c (CHR "`")) (i32.eq $c (CHR "@")) (AND (i32.eq $c (CHR "~")) (i32.ne (i32.load8_u (i32.add $str (global.get $read_index))) (CHR "@")))) (then ;; continue (nop)) (else ;;; if (c == '"') isstring = true (local.set $isstring (i32.eq $c (CHR "\""))) (local.set $instring $isstring) (block $done (loop $loop ;; peek at next character ;;; c = str[*index] (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) ;;; if (c == '\0') break (br_if $done (i32.eq $c 0)) ;;; if (!isstring) (if (i32.eqz $isstring) (then ;; next character is token delimiter (br_if $done (OR (i32.eq $c (CHR "(")) (i32.eq $c (CHR ")")) (i32.eq $c (CHR "[")) (i32.eq $c (CHR "]")) (i32.eq $c (CHR "{")) (i32.eq $c (CHR "}")) (i32.eq $c (CHR " ")) (i32.eq $c (CHR ",")) (i32.eq $c (CHR "\n")))))) ;; read next character ;;; token[token_index++] = str[(*index)++] (i32.store8 (i32.add (global.get $token_buf) $token_index) (i32.load8_u (i32.add $str (global.get $read_index)))) (local.set $token_index (i32.add $token_index 1)) (global.set $read_index (i32.add (global.get $read_index) 1)) ;;; if (token[0] == '~' && token[1] == '@') break (br_if $done (AND (i32.eq (i32.load8_u (i32.add (global.get $token_buf) 0)) (CHR "~")) (i32.eq (i32.load8_u (i32.add (global.get $token_buf) 1)) (CHR "@")))) ;;; if ((!isstring) || escaped) (if (OR (i32.eqz $isstring) $escaped) (then (local.set $escaped 0) (br $loop))) (if (i32.eq $c (CHR "\\")) (local.set $escaped 1)) (if (i32.eq $c (CHR "\"")) (then (local.set $instring 0) (br $done))) (br $loop) ) ) (if (AND $isstring $instring) (then ($THROW_STR_0 "expected '\"', got EOF") (return 0))))) ;;; token[token_index] = '\0' (i32.store8 (i32.add (global.get $token_buf) $token_index) 0) (global.get $token_buf) ) (func $read_seq (param $str i32 $type i32 $end i32) (result i32) (LET $res ($MAP_LOOP_START $type) $val2 0 $val3 0 $c 0 ;; MAP_LOOP stack $ret $res $empty $res $current $res) ;; READ_SEQ_LOOP (block $done (loop $loop ($skip_spaces_comments $str) ;; peek at next character ;;; c = str[*index] (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) (if (i32.eq $c (CHR "\x00")) (then ($THROW_STR_0 "unexpected EOF") (br $done))) (if (i32.eq $c $end) (then ;; read next character ;;; c = str[(*index)++] (local.set $c (i32.load8_u (i32.add $str (global.get $read_index)))) (global.set $read_index (i32.add (global.get $read_index) 1)) (br $done))) ;; value (or key for hash-maps) (local.set $val2 ($read_form $str)) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $val2) (br $done))) ;; if this is a hash-map, READ_FORM again (if (i32.eq $type (global.get $HASHMAP_T)) (local.set $val3 ($read_form $str))) ;; update the return sequence structure ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (br $loop) ) ) ;; MAP_LOOP_DONE $ret ) (func $read_macro (param $str i32 $sym i32 $with_meta i32) (result i32) (LET $first ($STRING (global.get $SYMBOL_T) $sym) $second ($read_form $str) $third 0 $res $second) (if (global.get $error_type) (return $res)) (if (i32.eqz $with_meta) (then (local.set $res ($LIST2 $first $second))) (else (local.set $third ($read_form $str)) (local.set $res ($LIST3 $first $third $second)) ;; release values, list has ownership ($RELEASE $third))) ;; release values, list has ownership ($RELEASE $second) ($RELEASE $first) $res ) (func $read_form (param $str i32) (result i32) (LET $tok 0 $c0 0 $c1 0 $res 0 $slen 0) (if (global.get $error_type) (return 0)) (local.set $tok ($read_token $str)) (if (global.get $error_type) (return 0)) ;;($printf_1 ">>> read_form 1: %s\n" $tok) ;;; c0 = token[0] (local.set $c0 (i32.load8_u $tok)) (local.set $c1 (i32.load8_u (i32.add $tok 1))) (if (i32.eq $c0 0) (then (return ($INC_REF (global.get $NIL)))) (else (if (OR (AND (i32.ge_u $c0 (CHR "0")) (i32.le_u $c0 (CHR "9"))) (AND (i32.eq $c0 (CHR "-")) (i32.ge_u $c1 (CHR "0")) (i32.le_u $c1 (CHR "9")))) (then (return ($INTEGER ($atoi $tok)))) (else (if (i32.eq $c0 (CHR ":")) (then (i32.store8 $tok (CHR "\x7f")) (return ($STRING (global.get $STRING_T) $tok))) (else (if (i32.eq $c0 (CHR "\"")) (then (local.set $slen ($strlen (i32.add $tok 1))) (if (i32.ne (i32.load8_u (i32.add $tok $slen)) (CHR "\"")) (then ($THROW_STR_0 "expected '\"', got EOF") (return 0)) (else ;; unescape backslashes, quotes, and newlines ;; remove the trailing quote (i32.store8 (i32.add $tok $slen) (CHR "\x00")) (local.set $tok (i32.add $tok 1)) (drop ($REPLACE3 0 $tok "\\\"" "\"" "\\n" "\n" "\\\\" "\\")) (return ($STRING (global.get $STRING_T) $tok))))) (else (if (i32.eqz ($strcmp "nil" $tok)) (then (return ($INC_REF (global.get $NIL)))) (else (if (i32.eqz ($strcmp "false" $tok)) (then (return ($INC_REF (global.get $FALSE)))) (else (if (i32.eqz ($strcmp "true" $tok)) (then (return ($INC_REF (global.get $TRUE)))) (else (if (i32.eqz ($strcmp "'" $tok)) (then (return ($read_macro $str "quote" 0))) (else (if (i32.eqz ($strcmp "`" $tok)) (then (return ($read_macro $str "quasiquote" 0))) (else (if (i32.eqz ($strcmp "~@" $tok)) (then (return ($read_macro $str "splice-unquote" 0))) (else (if (i32.eqz ($strcmp "~" $tok)) (then (return ($read_macro $str "unquote" 0))) (else (if (i32.eqz ($strcmp "^" $tok)) (then (return ($read_macro $str "with-meta" 1))) (else (if (i32.eqz ($strcmp "@" $tok)) (then (return ($read_macro $str "deref" 0))) (else (if (i32.eq $c0 (CHR "(")) (then (return ($read_seq $str (global.get $LIST_T) (CHR ")")))) (else (if (i32.eq $c0 (CHR "[")) (then (return ($read_seq $str (global.get $VECTOR_T) (CHR "]")))) (else (if (i32.eq $c0 (CHR "{")) (then (return ($read_seq $str (global.get $HASHMAP_T) (CHR "}")))) (else (if (OR (i32.eq $c0 (CHR ")")) (i32.eq $c0 (CHR "]")) (i32.eq $c0 (CHR "}"))) (then ($THROW_STR_1 "unexpected '%c'" $c0) (return 0)) (else (return ($STRING (global.get $SYMBOL_T) $tok)))) )))))))))))))))))))))))))))))))) 0 ;; not reachable ) (func $read_str (param $str i32) (result i32) (global.set $read_index 0) ($read_form $str) ) (export "read_str" (func $read_str)) ) ================================================ FILE: impls/wasm/run ================================================ #!/usr/bin/env bash STEP=${STEP:-stepA_mal} case "${wasm_MODE}" in wasmtime) exec wasmtime --dir=./ --dir=../ --dir=/ $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; wasmer) exec wasmer run --dir=./ --dir=../ --dir=/ $(dirname $0)/${STEP:-stepA_mal}.wasm -- "${@}" ;; warpy) exec warpy --argv --memory-pages 256 $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; wax) exec wax $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; wace_libc) exec wace $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; wace_fooboot) echo >&2 "wace_fooboot mode not yet supported" ;; node|js|*) exec ./run.js $(dirname $0)/${STEP:-stepA_mal}.wasm "${@}" ;; esac ================================================ FILE: impls/wasm/run.js ================================================ #!/usr/bin/env node // Copyright Joel Martin // License MIT const { promisify } = require('util') const fs = require('fs') const readFile = promisify(fs.readFile) const assert = require('assert') const { TextDecoder, TextEncoder } = require('text-encoding') const node_readline = require('./node_readline.js') assert('WebAssembly' in global, 'WebAssembly not detected') // // Memory interaction utilities // // Convert node Buffer to Uint8Array function toUint8Array(buf) { let u = new Uint8Array(buf.length) for (let i = 0; i < buf.length; ++i) { u[i] = buf[i] } return u } // Read null terminated string out of webassembly memory function get_string(memory, addr) { //console.warn("get_string:", addr) let u8 = new Uint8Array(memory.buffer, addr) let length = u8.findIndex(e => e == 0) let bytes = new Uint8Array(memory.buffer, addr, length) let str = new TextDecoder('utf8').decode(bytes) return str } // Write null terminated string into webassembly memory function put_string(memory, addr, str, max_length) { let buf8 = new Uint8Array(memory.buffer, addr) let bytes = new TextEncoder('utf8').encode(str) if (max_length && bytes.length > max_length) { bytes = bytes.slice(0, max_length) } buf8.set(bytes, 0) buf8[bytes.length] = 0 // null terminator return bytes.length+1 } // Put argv structure at beginning of memory function marshal_argv(memory, offset, args) { let view = new DataView(memory.buffer, offset) let buf8 = new Uint8Array(memory.buffer, offset) let stringStart = (args.length + 1) * 4 for (let i = 0; i < args.length; i++) { let len = put_string(memory, stringStart, args[i]) view.setUint32(i*4, stringStart, true) stringStart = stringStart + len } view.setUint32(args.length*4, 0, true) return offset + stringStart // start of free memory } // Based on: // https://gist.github.com/kripken/59c67556dc03bb6d57052fedef1e61ab // Loads a WebAssembly dynamic library, returns a promise. async function loadWebAssembly(filename, args) { // Fetch the file and compile it const wasm_str = await readFile(filename) const wasm_bin = toUint8Array(wasm_str) const module = await WebAssembly.compile(wasm_bin) let memory = new WebAssembly.Memory({ initial: 256 }) // Core imports function printline(addr, stream) { console.log(get_string(memory, addr).replace(/\n$/, '')) } // Returns addr on success and -1 on failure // Truncates to max_length function readline(prompt, addr, max_length) { let line = node_readline.readline(get_string(memory, prompt)) if (line === null) { return 0 } put_string(memory, addr, line, max_length) return 1 } function read_file(path_addr, buf) { let path = get_string(memory, path_addr) let contents = fs.readFileSync(path, 'utf8') return put_string(memory, buf, contents) } function get_time_ms() { // subtract 30 years to make sure it fits into i32 without // wrapping or becoming negative return (new Date()).getTime() - 0x38640900 } // Marshal arguments const memoryStart = 0 let memoryBase = marshal_argv(memory, memoryStart, args) memoryBase = memoryBase + (8 - (memoryBase % 8)) // Create the imports for the module, including the // standard dynamic library imports imports = {} imports.env = {} imports.env.exit = process.exit imports.env.printline = printline imports.env.readline = readline imports.env.read_file = read_file imports.env.get_time_ms = get_time_ms imports.env.stdout = 0 imports.env.fputs = printline imports.env.memory = memory imports.env.memoryBase = memoryBase imports.env.table = new WebAssembly.Table({ initial: 0, element: 'anyfunc' }) imports.env.tableBase = imports.env.tableBase || 0 // Create the instance. return [new WebAssembly.Instance(module, imports), args.length, 0] } async function main() { assert(process.argv.length >= 3, 'Usage: ./run.js prog.wasm [ARGS...]') const wasm = process.argv[2] const args = process.argv.slice(2) const [instance, argc, argv] = await loadWebAssembly(wasm, args) let exports = instance.exports assert(exports, 'no exports found') assert('_main' in exports, '_main not found in wasm module exports') if ('__post_instantiate' in exports) { //console.warn('calling exports.__post_instantiate()') exports['__post_instantiate']() } //console.warn(`calling exports._main(${argc}, ${argv})`) let start = new Date() let res = exports['_main'](argc, argv) let end = new Date() //console.warn('runtime: ' + (end-start) + 'ms') process.exit(res) } if (module.parent) { module.exports.loadWebAssembly = loadWebAssembly } else { main() } ================================================ FILE: impls/wasm/step0_repl.wam ================================================ (module $step0_repl ;; READ (func $READ (param $str i32) (result i32) $str ) (func $EVAL (param $ast i32) (param $env i32) (result i32) $ast ) ;; PRINT (func $PRINT (param $ast i32) (result i32) $ast ) ;; REPL (func $rep (param $line i32) (result i32) ($PRINT ($EVAL ($READ $line) 0)) ) (func $main (param $argc i32 $argv i32) (result i32) ;; Constant location/value definitions (LET $line (STATIC_ARRAY 201)) ;; DEBUG ;;($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) ($printf_1 "%s\n" ($rep $line)) (br $repl_loop) ) ) ($print "\n") 0 ) ;; init_memory is provided by mem.wam in later steps but we just ;; printf in step0 so provide init_memory that just calls that (func $init_memory ($init_printf_mem) ) ) ================================================ FILE: impls/wasm/step1_read_print.wam ================================================ (module $step1_read_print ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL (param $ast i32 $env i32) (result i32) $ast ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $REP (param $line i32 $env i32) (result i32) (LET $mv1 0 $mv2 0 $ms 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $mv2 ($EVAL $mv1 $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) ;; ($PR_MEMORY_RAW ;; (global.get $mem) (i32.add (global.get $mem) ;; (i32.mul (global.get $mem_unused_start) 4))) (drop ($STRING (global.get $STRING_T) "uvw")) (drop ($STRING (global.get $STRING_T) "xyz")) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line 0)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step2_eval.wam ================================================ (module $step2_eval (global $repl_env (mut i32) (i32.const 0)) ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (i32.eqz ($VAL0 $ast)) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (type $fnT (func (param i32) (result i32))) (table funcref (elem $add $subtract $multiply $divide)) (func $EVAL (param $ast i32 $env i32) (result i32) (local $res2 i64) (LET $res 0 $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $found 0) (if (global.get $error_type) (return 0)) ;;($PR_VALUE "EVAL: %s\n" $ast) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res2 ($HASHMAP_GET $env $ast)) (local.set $res (i32.wrap_i64 $res2)) (local.set $found (i32.wrap_i64 (i64.shr_u $res2 (i64.const 32)))) (if (i32.eqz $found) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (return ($INC_REF $res)))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (return ($EVAL_AST $ast $env)))) (if (OR (i32.ne $ast_type (global.get $LIST_T)) ($EMPTY_Q $ast)) (then (return ($INC_REF $ast)))) ;; APPLY_LIST ;; EVAL_INVOKE (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) ;; if error, return f/args for release by caller (if (global.get $error_type) (return $f_args)) (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) ($RELEASE $f_args) (return $res)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) ($RELEASE $f_args) (return 0) ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $REP (param $line i32 $env i32) (result i32) (LET $mv1 0 $mv2 0 $ms 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $mv2 ($EVAL $mv1 $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from MAL_READ and EVAL ($RELEASE $mv2) ($RELEASE $mv1) $ms ) (func $add (param $args i32) (result i32) ($INTEGER (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $subtract (param $args i32) (result i32) ($INTEGER (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $multiply (param $args i32) (result i32) ($INTEGER (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $divide (param $args i32) (result i32) ($INTEGER (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $repl_env ($HASHMAP)) (local.set $repl_env (global.get $repl_env)) (local.set $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0))) (local.set $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1))) (local.set $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2))) (local.set $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3))) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step3_env.wam ================================================ (module $step3_env (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (i32.eqz ($VAL0 $ast)) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (type $fnT (func (param i32) (result i32))) (table funcref (elem $add $subtract $multiply $divide)) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $ast i32 $env i32) (result i32) (LET $res 0 $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $let_env 0) (if (global.get $error_type) (return 0)) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (return $res))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (return ($EVAL_AST $ast $env)))) (if (OR (i32.ne $ast_type (global.get $LIST_T)) ($EMPTY_Q $ast)) (then (return ($INC_REF $ast)))) ;; APPLY_LIST (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (if (global.get $error_type) (return $res)) ;; set a1 in env to a2 (return ($ENV_SET $env $a1 $res))) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $let_env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $let_env)) (if (global.get $error_type) (then (return 0))) ;; set key/value in the let environment (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) (local.set $res ($EVAL $a2 $let_env)) ;; EVAL_RETURN ($RELEASE $let_env) (return $res)) ) ;; EVAL_INVOKE (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) ;; if error, return f/args for release by caller (if (global.get $error_type) (return $f_args)) (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) ($RELEASE $f_args) (return $res)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) ($RELEASE $f_args) (return 0) ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $REP (param $line i32 $env i32) (result i32) (LET $mv1 0 $mv2 0 $ms 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $mv2 ($EVAL $mv1 $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from MAL_READ and EVAL ($RELEASE $mv2) ($RELEASE $mv1) $ms ) (func $add (param $args i32) (result i32) ($INTEGER (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $subtract (param $args i32) (result i32) ($INTEGER (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $multiply (param $args i32) (result i32) ($INTEGER (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $divide (param $args i32) (result i32) ($INTEGER (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $pr_memory (param $args i32) (result i32) ($PR_MEMORY -1 -1) ($INC_REF (global.get $NIL))) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) (drop ($ENV_SET_S $repl_env "+" ($FUNCTION 0))) (drop ($ENV_SET_S $repl_env "-" ($FUNCTION 1))) (drop ($ENV_SET_S $repl_env "*" ($FUNCTION 2))) (drop ($ENV_SET_S $repl_env "/" ($FUNCTION 3))) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step4_if_fn_do.wam ================================================ (module $step4_if_fn_do (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (i32.eqz ($VAL0 $ast)) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $ast i32 $env i32) (result i32) (LET $res 0 $el 0 $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $a3 0 $let_env 0 $fn_env 0 $a 0) (if (global.get $error_type) (return 0)) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (return $res))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (return ($EVAL_AST $ast $env)))) (if (OR (i32.ne $ast_type (global.get $LIST_T)) ($EMPTY_Q $ast)) (then (return ($INC_REF $ast)))) ;; APPLY_LIST (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (if (global.get $error_type) (return $res)) ;; set a1 in env to a2 (return ($ENV_SET $env $a1 $res))) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $let_env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $let_env)) (if (global.get $error_type) (then (return 0))) ;; set key/value in the let environment (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) (local.set $res ($EVAL $a2 $let_env)) ;; EVAL_RETURN ($RELEASE $let_env) (return $res)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env)) (local.set $res ($LAST $el)) ($RELEASE $el) (return $res)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (return ($INC_REF (global.get $NIL)))) (else (local.set $a3 ($MAL_GET_A3 $ast)) (return ($EVAL $a3 $env))))) (else ($RELEASE $res) (local.set $a2 ($MAL_GET_A2 $ast)) (return ($EVAL $a2 $env))))))) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (return ($ALLOC (global.get $MALFUNC_T) $a2 $a1 $env))) ) ;; EVAL_INVOKE (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) ;; if error, return f/args for release by caller (if (global.get $error_type) (return $f_args)) (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) ($RELEASE $f_args) (return $res)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then (local.set $fn_env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; claim the AST before releasing the list containing it (local.set $a ($MEM_VAL0_ptr $f)) (drop ($INC_REF $a)) ;; release f/args ($RELEASE $f_args) (local.set $res ($EVAL $a $fn_env)) ;; EVAL_RETURN ($RELEASE $fn_env) ($RELEASE $a) (return $res)) ) ;; create new environment using env and params stored in function ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) ($RELEASE $f_args) (return 0) ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step5_tco.wam ================================================ (module $step5_tco (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step6_file.wam ================================================ (module $step6_file (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0 ;; argument processing $i 0 $ret 0 $empty 0 $current 0 $val2 0) ;; DEBUG ;; ($printf_1 "argc: 0x%x\n" $argc) ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack ;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (local.set $i 2) (block $done (loop $loop (br_if $done (i32.ge_u $i $argc)) (local.set $val2 ($STRING (global.get $STRING_T) (i32.load (i32.add $argv (i32.mul $i 4))))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $i (i32.add $i 1)) (br $loop) ) ) (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) ;;($PR_MEMORY -1 -1) (if (i32.gt_u $argc 1) (then (drop ($ENV_SET_S $repl_env "*FILE*" ($STRING (global.get $STRING_T) (i32.load (i32.add $argv 4))))) ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (return 1)) (else (return 0))))) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step7_quote.wam ================================================ (module $step7_quote (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $QUASIQUOTE (param $ast i32) (result i32) (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) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) ;; if we have already been here via TCO, release previous ast (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0 ;; argument processing $i 0 $ret 0 $empty 0 $current 0 $val2 0) ;; DEBUG ;; ($printf_1 "argc: 0x%x\n" $argc) ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack ;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (local.set $i 2) (block $done (loop $loop (br_if $done (i32.ge_u $i $argc)) (local.set $val2 ($STRING (global.get $STRING_T) (i32.load (i32.add $argv (i32.mul $i 4))))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $i (i32.add $i 1)) (br $loop) ) ) (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) ;;($PR_MEMORY -1 -1) (if (i32.gt_u $argc 1) (then (drop ($ENV_SET_S $repl_env "*FILE*" ($STRING (global.get $STRING_T) (i32.load (i32.add $argv 4))))) ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (return 1)) (else (return 0))))) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step8_macros.wam ================================================ (module $step8_macros (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $QUASIQUOTE (param $ast i32) (result i32) (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) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $err 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) ;; if we have already been here via TCO, release previous ast (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "defmacro!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $f ($EVAL $a2 $env)) (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) ($SET_TYPE $res (global.get $MACRO_T)) (br_if $EVAL_return (global.get $error_type)) ($RELEASE $f) ;; set a1 in env to a2 (drop ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function or macro. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $MACRO_T)) (then (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) ($RELEASE $f) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (br $TCO_loop))) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0 ;; argument processing $i 0 $ret 0 $empty 0 $current 0 $val2 0) ;; DEBUG ;; ($printf_1 "argc: 0x%x\n" $argc) ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack ;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (local.set $i 2) (block $done (loop $loop (br_if $done (i32.ge_u $i $argc)) (local.set $val2 ($STRING (global.get $STRING_T) (i32.load (i32.add $argv (i32.mul $i 4))))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $i (i32.add $i 1)) (br $loop) ) ) (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) ;;($PR_MEMORY -1 -1) (if (i32.gt_u $argc 1) (then (drop ($ENV_SET_S $repl_env "*FILE*" ($STRING (global.get $STRING_T) (i32.load (i32.add $argv 4))))) ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (return 1)) (else (return 0))))) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/step9_try.wam ================================================ (module $step9_try (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $QUASIQUOTE (param $ast i32) (result i32) (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) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $err 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) ;; if we have already been here via TCO, release previous ast (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "defmacro!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $f ($EVAL $a2 $env)) (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) ($SET_TYPE $res (global.get $MACRO_T)) (br_if $EVAL_return (global.get $error_type)) ($RELEASE $f) ;; set a1 in env to a2 (drop ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "try*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) ;; if there is no error, return (br_if $EVAL_return (i32.eqz (global.get $error_type))) ;; if there is an error and res is set, we need to free it ($RELEASE $res) ;; if there is no catch block then return (br_if $EVAL_return (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) ;; save the current environment for release (local.set $prev_env $env) ;; create environment for the catch block eval (local.set $env ($ENV_NEW $env)) ;; set a1 and a2 from the catch block (local.set $a1 ($MAL_GET_A1 ($MAL_GET_A2 $ast))) (local.set $a2 ($MAL_GET_A2 ($MAL_GET_A2 $ast))) ;; create object for string errors (if (i32.eq (global.get $error_type) 1) (then (local.set $err ($STRING (global.get $STRING_T) (global.get $error_str)))) (else (local.set $err (global.get $error_val)))) ;; bind the catch symbol to the error object (drop ($ENV_SET $env $a1 $err)) ;; release our use, env took ownership ($RELEASE $err) ;; unset error for catch eval (global.set $error_type 0) (i32.store (global.get $error_str) (CHR "\x00")) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function or macro. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $MACRO_T)) (then (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) ($RELEASE $f) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (br $TCO_loop))) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0 ;; argument processing $i 0 $ret 0 $empty 0 $current 0 $val2 0) ;; DEBUG ;; ($printf_1 "argc: 0x%x\n" $argc) ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack ;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (local.set $i 2) (block $done (loop $loop (br_if $done (i32.ge_u $i $argc)) (local.set $val2 ($STRING (global.get $STRING_T) (i32.load (i32.add $argv (i32.mul $i 4))))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $i (i32.add $i 1)) (br $loop) ) ) (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) ;;($PR_MEMORY -1 -1) (if (i32.gt_u $argc 1) (then (drop ($ENV_SET_S $repl_env "*FILE*" ($STRING (global.get $STRING_T) (i32.load (i32.add $argv 4))))) ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (return 1)) (else (return 0))))) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/stepA_mal.wam ================================================ (module $stepA_mal (global $repl_env (mut i32) (i32.const 0)) (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $QUASIQUOTE (param $ast i32) (result i32) (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) ;; Return a list/vector/map with evaluated elements ;; of a list, vector or hashmap $ast (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (loop $loop ;; check if we are done evaluating the source sequence (if (OR (i32.eqz ($VAL0 $ast)) (AND $skiplast (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) (then (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ;; MAP_LOOP_DONE ) (func $MAL_GET_A1 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) (func $MAL_GET_A2 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) (LET $value ($ENV_GET $env (global.get $DEBUG_EVAL_S))) (if (AND $value (i32.ne $value (global.get $NIL)) (i32.ne $value (global.get $FALSE))) (then ($PR_VALUE "EVAL: %s\n" $ast)))) (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $err 0) (block $EVAL_return (loop $TCO_loop (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) ($ECHO_IF_DEBUG_EVAL $ast $env) (local.set $ast_type ($TYPE $ast)) (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then (local.set $res ($ENV_GET $env $ast)) (if (i32.eqz $res) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (br $EVAL_return))) (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) (if (i32.ne $ast_type (global.get $LIST_T)) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) (br $EVAL_return))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) (local.set $a0sym ($to_String $a0))) (if (i32.eqz ($strcmp "def!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($EVAL $a2 $env)) (br_if $EVAL_return (global.get $error_type)) ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) ;; create new environment with outer as current environment (local.set $prev_env $env) ;; save env for later release (local.set $env ($ENV_NEW $env)) (block $done (loop $loop (br_if $done (i32.eqz ($VAL0 $a1))) ;; eval current A1 odd element (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) (br_if $done (global.get $error_type)) ;; set key/value in the let environment (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) ;; release our use, ENV_SET took ownership ($RELEASE $res) ;; skip to the next pair of a1 elements (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) (br $loop) ) ) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) (local.set $ast ($LAST $ast)) ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) ;; if we have already been here via TCO, release previous ast (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "defmacro!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $f ($EVAL $a2 $env)) (local.set $res ($MALFUNC ($MEM_VAL0_ptr $f) ($MEM_VAL1_ptr $f) ($MEM_VAL2_ptr $f))) ($SET_TYPE $res (global.get $MACRO_T)) (br_if $EVAL_return (global.get $error_type)) ($RELEASE $f) ;; set a1 in env to a2 (drop ($ENV_SET $env $a1 $res)) (br $EVAL_return)) ) (if (i32.eqz ($strcmp "try*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) ;; if there is no error, return (br_if $EVAL_return (i32.eqz (global.get $error_type))) ;; if there is an error and res is set, we need to free it ($RELEASE $res) ;; if there is no catch block then return (br_if $EVAL_return (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) ;; save the current environment for release (local.set $prev_env $env) ;; create environment for the catch block eval (local.set $env ($ENV_NEW $env)) ;; set a1 and a2 from the catch block (local.set $a1 ($MAL_GET_A1 ($MAL_GET_A2 $ast))) (local.set $a2 ($MAL_GET_A2 ($MAL_GET_A2 $ast))) ;; create object for string errors (if (i32.eq (global.get $error_type) 1) (then (local.set $err ($STRING (global.get $STRING_T) (global.get $error_str)))) (else (local.set $err (global.get $error_val)))) ;; bind the catch symbol to the error object (drop ($ENV_SET $env $a1 $err)) ;; release our use, env took ownership ($RELEASE $err) ;; unset error for catch eval (global.set $error_type 0) (i32.store (global.get $error_str) (CHR "\x00")) ;; release previous environment if not the current EVAL env (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) (local.set $ast $a2) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) (if (global.get $error_type) (then (nop)) (else (if (OR (i32.eq $res (global.get $NIL)) (i32.eq $res (global.get $FALSE))) (then ($RELEASE $res) ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then (local.set $res ($INC_REF (global.get $NIL))) (br $EVAL_return)) (else (local.set $ast ($MAL_GET_A3 $ast))))) (else ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) ) (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) ) ;; EVAL_INVOKE ;; Evaluate the first element to find a function or macro. (local.set $f ($EVAL $a0 $env)) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $MACRO_T)) (then (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) ($RELEASE $f) (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) (br $TCO_loop))) ;; Evaluate the arguments. (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then (local.set $res $f) ($RELEASE $args) (br $EVAL_return))) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (if (i32.eq ($VAL0 $f) 0) ;; eval (then (local.set $res ($EVAL ($MEM_VAL1_ptr $args) (global.get $repl_env)))) (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $EVAL_return)) ) (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) ;; create new environment using env and params stored in function (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) ;; release previous environment if not the current EVAL env ;; because our new env refers to it and we no longer need to ;; track it (since we are TCO recurring) (if (i32.ne $prev_env $orig_env) (then ($RELEASE $prev_env) (local.set $prev_env 0))) ;; claim the AST before releasing the list containing it (local.set $ast ($MEM_VAL0_ptr $f)) (drop ($INC_REF $ast)) ;; if we have already been here via TCO, release previous ;; ast ;; PEND_A_LV (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) ;; release f/args ($RELEASE $f) ($RELEASE $args) (br $TCO_loop)) ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f) ($RELEASE $args) (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return ;; EVAL_RETURN (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $RE (param $line i32 $env i32) (result i32) (LET $mv1 0 $res 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $res ($EVAL $mv1 $env)) ) ;; release memory from MAL_READ ($RELEASE $mv1) $res ) (func $REP (param $line i32 $env i32) (result i32) (LET $mv2 0 $ms 0) (block $done (local.set $mv2 ($RE $line $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from RE ($RELEASE $mv2) $ms ) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0 $ms 0 ;; argument processing $i 0 $ret 0 $empty 0 $current 0 $val2 0) ;; DEBUG ;; ($printf_1 "argc: 0x%x\n" $argc) ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) ;; core.EXT: defined in wasm ($add_core_ns $repl_env) (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0))) ($checkpoint_user_memory) ;; core.mal: defined using the language itself ($RELEASE ($RE "(def! *host-language* \"WebAssembly\")" $repl_env)) ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env)) ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack ;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (local.set $i 2) (block $done (loop $loop (br_if $done (i32.ge_u $i $argc)) (local.set $val2 ($STRING (global.get $STRING_T) (i32.load (i32.add $argv (i32.mul $i 4))))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE (global.get $LIST_T) $empty $current $val2 0)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $i (i32.add $i 1)) (br $loop) ) ) (drop ($ENV_SET_S $repl_env "*ARGV*" $ret)) ;;($PR_MEMORY -1 -1) (if (i32.gt_u $argc 1) (then (drop ($ENV_SET_S $repl_env "*FILE*" ($STRING (global.get $STRING_T) (i32.load (i32.add $argv 4))))) ($RELEASE ($RE "(load-file *FILE*)" $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (return 1)) (else (return 0))))) ($RELEASE ($RE "(println (str \"Mal [\" *host-language* \"]\"))" $repl_env)) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then (if (i32.eq 2 (global.get $error_type)) (then (local.set $ms ($pr_str (global.get $error_val) 1)) ($printf_1 "Error: %s\n" ($to_String $ms)) ($RELEASE $ms) ($RELEASE (global.get $error_val))) (else ($printf_1 "Error: %s\n" (global.get $error_str)))) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) ) ================================================ FILE: impls/wasm/string.wam ================================================ (module $string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Copy len bytes from src to dst ;; Returns len (func $memmove (param $dst i32 $src i32 $len i32) (LET $idx 0) (loop $copy (i32.store8 (i32.add $idx $dst) (i32.load8_u (i32.add $idx $src))) (local.set $idx (i32.add 1 $idx)) (br_if $copy (i32.lt_u $idx $len)) ) ) (func $strlen (param $str i32) (result i32) (LET $cur $str) (loop $count (if (i32.ne 0 (i32.load8_u $cur)) (then (local.set $cur (i32.add $cur 1)) (br $count))) ) (i32.sub $cur $str) ) ;; Based on https://stackoverflow.com/a/25705264/471795 ;; This could be made much more efficient (func $strstr (param $haystack i32 $needle i32) (result i32) (LET $i 0 $needle_len ($strlen $needle) $len ($strlen $haystack)) (if (i32.eq $needle_len 0) (return $haystack)) (local.set $i 0) (block $done (loop $loop (if (i32.gt_s $i (i32.sub $len $needle_len)) (br $done)) (if (AND (i32.eq (i32.load8_u $haystack) (i32.load8_u $needle)) (i32.eqz ($strncmp $haystack $needle $needle_len))) (return $haystack)) (local.set $haystack (i32.add $haystack 1)) (local.set $i (i32.add $i 1)) (br $loop) ) ) 0 ) (func $atoi (param $str i32) (result i32) (LET $acc 0 $i 0 $neg 0 $ch 0) (block $done (loop $loop (local.set $ch (i32.load8_u (i32.add $str $i))) (if (AND (i32.ne $ch (CHR "-")) (OR (i32.lt_u $ch (CHR "0")) (i32.gt_u $ch (CHR "9")))) (br $done)) (local.set $i (i32.add $i 1)) (if (i32.eq $ch (CHR "-")) (then (local.set $neg 1)) (else (local.set $acc (i32.add (i32.mul $acc 10) (i32.sub $ch (CHR "0")))))) (br $loop) ) ) (if (result i32) $neg (then (i32.sub 0 $acc)) (else $acc)) ) (func $strcmp (param $s1 i32 $s2 i32) (result i32) (block $done (loop $loop (if (OR (i32.eqz (i32.load8_u $s1)) (i32.eqz (i32.load8_u $s2))) (br $done)) (if (i32.ne (i32.load8_u $s1) (i32.load8_u $s2)) (br $done)) (local.set $s1 (i32.add $s1 1)) (local.set $s2 (i32.add $s2 1)) (br $loop) ) ) (if (result i32) (i32.eq (i32.load8_u $s1) (i32.load8_u $s2)) (then 0) (else (if (result i32) (i32.lt_u (i32.load8_u $s1) (i32.load8_u $s2)) (then -1) (else 1)))) ) (func $strncmp (param $s1 i32 $s2 i32 $len i32) (result i32) (LET $i 0) (if (i32.eq $len 0) (return 0)) (block $done (loop $loop (if (i32.ge_u $i $len) (br $done)) (if (i32.eqz (i32.load8_u (i32.add $i $s1))) (br $done)) (if (i32.ne (i32.load8_u (i32.add $i $s1)) (i32.load8_u (i32.add $i $s2))) (br $done)) (local.set $i (i32.add $i 1)) (br $loop) ) ) (if (OR (i32.eq $i $len) (i32.eq (i32.load8_u (i32.add $i $s1)) (i32.load8_u (i32.add $i $s2)))) (return 0)) (if (result i32) (i32.lt_u (i32.load8_u (i32.add $i $s1)) (i32.load8_u (i32.add $i $s2))) (then -1) (else 1)) ) ;; Writes new string to grass with all needles in haystack replaced. ;; If the length of replace is equal to of less than needle then ;; grass can be NULL. ;; Returns length of grass. (func $REPLACE3 (param $grass i32 $haystack i32 $needle0 i32 $replace0 i32 $needle1 i32 $replace1 i32 $needle2 i32 $replace2 i32) (result i32) (LET $haystack_len ($strlen $haystack) $src_str $haystack $dst_str $grass $s 0 $found_tmp 0 $found 0 $needle 0 $replace 0 $needle_len 0 $replace_len 0 $replace_s 0 $replace_len_s 0 $needle_len_s 0) ;; in-place (if (i32.eqz $grass) (then ;; check that we aren't expanding in place (local.set $s 0) (block $done (loop $loop (if (i32.ge_u $s 3) (br $done)) (local.set $needle (if (result i32) (i32.eq $s 0) $needle0 (if (result i32) (i32.eq $s 1) $needle1 $needle2))) (local.set $replace (if (result i32) (i32.eq $s 0) $replace0 (if (result i32) (i32.eq $s 1) $replace1 $replace2))) (local.set $needle_len ($strlen $needle)) (local.set $replace_len ($strlen $replace)) (if (i32.gt_u $replace_len $needle_len) ($fatal 7 "REPLACE: invalid expanding in-place call\n")) (local.set $s (i32.add $s 1)) (br $loop) ) ) (local.set $grass $haystack) (local.set $dst_str $grass))) (block $done1 (loop $loop1 (if (i32.ge_s (i32.sub $src_str $haystack) $haystack_len) (br $done1)) ;; Find the earliest match (local.set $found 0) (local.set $s 0) (block $done2 (loop $loop2 (if (i32.ge_u $s 3) (br $done2)) (local.set $needle (if (result i32) (i32.eq $s 0) $needle0 (if (result i32) (i32.eq $s 1) $needle1 $needle2))) (local.set $replace (if (result i32) (i32.eq $s 0) $replace0 (if (result i32) (i32.eq $s 1) $replace1 $replace2))) (local.set $s (i32.add $s 1)) (local.set $found_tmp ($strstr $src_str $needle)) (if (i32.eqz $found_tmp) (br $loop2)) (if (OR (i32.eqz $found) (i32.lt_s $found_tmp $found)) (then (local.set $found $found_tmp) (local.set $needle_len_s ($strlen $needle)) (local.set $replace_s $replace) (local.set $replace_len_s ($strlen $replace)))) (br $loop2) ) ) (if (i32.eqz $found) (br $done1)) ;; copy before the match ($memmove $dst_str $src_str (i32.add (i32.sub $found $src_str) 1)) (local.set $dst_str (i32.add $dst_str (i32.sub $found $src_str))) ;; add the replace string ($memmove $dst_str $replace_s (i32.add $replace_len_s 1)) (local.set $dst_str (i32.add $dst_str $replace_len_s)) ;; Move to after the match (local.set $src_str (i32.add $found $needle_len_s)) (br $loop1) ) ) ;; Copy the left-over ($memmove $dst_str $src_str ($strlen $src_str)) (local.set $dst_str (i32.add $dst_str ($strlen $src_str))) (i32.store8 $dst_str (CHR "\x00")) (i32.sub $dst_str $grass) ) ) ================================================ FILE: impls/wasm/types.wam ================================================ ;; Mal value memory layout ;; type words ;; ---------- ---------- ;; nil ref/ 0 | 0 | | ;; false ref/ 1 | 0 | | ;; true ref/ 1 | 1 | | ;; integer ref/ 2 | int | | ;; float ref/ 3 | ??? | | ;; string/kw ref/ 4 | string ptr | | ;; symbol ref/ 5 | string ptr | | ;; list ref/ 6 | next mem idx | val mem idx | ;; vector ref/ 7 | next mem idx | val mem idx | ;; hashmap ref/ 8 | next mem idx | key mem idx | val mem idx ;; function ref/ 9 | fn idx | | ;; mal function ref/10 | body mem idx | param mem idx | env mem idx ;; macro fn ref/11 | body mem idx | param mem idx | env mem idx ;; atom ref/12 | val mem idx | | ;; environment ref/13 | hmap mem idx | outer mem idx | ;; metadata ref/14 | obj mem idx | meta mem idx | ;; FREE sz/15 | next mem idx | | (module $types (global $NIL_T i32 0) (global $BOOLEAN_T i32 1) (global $INTEGER_T i32 2) (global $FLOAT_T i32 3) (global $STRING_T i32 4) (global $SYMBOL_T i32 5) (global $LIST_T i32 6) (global $VECTOR_T i32 7) (global $HASHMAP_T i32 8) (global $FUNCTION_T i32 9) (global $MALFUNC_T i32 10) (global $MACRO_T i32 11) (global $ATOM_T i32 12) (global $ENVIRONMENT_T i32 13) (global $METADATA_T i32 14) (global $FREE_T i32 15) (global $error_type (mut i32) 0) (global $error_val (mut i32) 0) ;; Index into static string memory (static.wast) (global $error_str (mut i32) 0) (global $NIL (mut i32) 0) (global $FALSE (mut i32) 0) (global $TRUE (mut i32) 0) (global $EMPTY_LIST (mut i32) 0) (global $EMPTY_VECTOR (mut i32) 0) (global $EMPTY_HASHMAP (mut i32) 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; General functions (func $INC_REF (param $mv i32) (result i32) (i32.store $mv (i32.add (i32.load $mv) 32)) $mv ) (func $TRUE_FALSE (param $val i32) (result i32) ($INC_REF (if (result i32) $val (global.get $TRUE) (global.get $FALSE))) ) (func $THROW_STR_0 (param $fmt i32) (drop ($sprintf_1 (global.get $error_str) $fmt "")) (global.set $error_type 1) ) (func $THROW_STR_1 (param $fmt i32) (param $v0 i32) (drop ($sprintf_1 (global.get $error_str) $fmt $v0)) (global.set $error_type 1) ) (func $EQUAL_Q (param $a i32 $b i32) (result i32) (LET $ta ($TYPE $a) $tb ($TYPE $b)) (if (AND (OR (i32.eq $ta (global.get $LIST_T)) (i32.eq $ta (global.get $VECTOR_T))) (OR (i32.eq $tb (global.get $LIST_T)) (i32.eq $tb (global.get $VECTOR_T)))) (then ;; EQUAL_Q_SEQ (block $done (loop $loop (if (OR (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0)) (br $done)) (if ($EQUAL_Q ($MEM_VAL1_ptr $a) ($MEM_VAL1_ptr $b)) (then (local.set $a ($MEM_VAL0_ptr $a)) (local.set $b ($MEM_VAL0_ptr $b))) (else (return 0))) (br $loop) ) ) (return (AND (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0)))) (else (if (AND (i32.eq $ta (global.get $HASHMAP_T)) (i32.eq $tb (global.get $HASHMAP_T))) ;; EQUAL_Q_HM (then (return 1)) ;; TODO: remove this once strings are interned (else (if (OR (AND (i32.eq $ta (global.get $STRING_T)) (i32.eq $tb (global.get $STRING_T))) (AND (i32.eq $ta (global.get $SYMBOL_T)) (i32.eq $tb (global.get $SYMBOL_T)))) (then (return (i32.eqz ($strcmp ($to_String $a) ($to_String $b))))) (else (return (AND (i32.eq $ta $tb) (i32.eq ($VAL0 $a) ($VAL0 $b)))))))))) 0 ;; not reachable ) (func $DEREF_META (param $mv i32) (result i32) (loop $loop (if (i32.eq ($TYPE $mv) (global.get $METADATA_T)) (then (local.set $mv ($MEM_VAL0_ptr $mv)) (br $loop))) ) $mv ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; string functions (func $to_MalString (param $mv i32) (result i32) ;; TODO: assert mv is a string/keyword/symbol (i32.add (global.get $string_mem) ($VAL0 $mv)) ) (func $to_String (param $mv i32) (result i32) ;; skip string refcnt and size (i32.add 4 ($to_MalString $mv)) ) ;; Duplicate regular character array string into a Mal string and ;; return the MalVal pointer (func $STRING (param $type i32 $str i32) (result i32) (LET $ms ($ALLOC_STRING $str ($strlen $str) 1)) ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem))) ) ;; Find first duplicate (internet) of mv. If one is found, free up ;; mv and return the interned version. If no duplicate is found, ;; return NULL. (func $INTERN_STRING (param $mv i32) (result i32) (LET $res 0 $ms ($to_MalString $mv) $existing_ms ($FIND_STRING (i32.add $ms 4)) $tmp 0) (if (AND $existing_ms (i32.lt_s $existing_ms $ms)) (then (local.set $tmp $mv) (local.set $res ($ALLOC_SCALAR (global.get $STRING_T) (i32.sub $existing_ms (global.get $string_mem)))) (i32.store16 $existing_ms (i32.add (i32.load16_u $existing_ms) 1)) ($RELEASE $tmp))) $res ) (func $STRING_INIT (param $type i32) (result i32) (LET $ms ($ALLOC_STRING "" 0 0)) ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem))) ) (func $STRING_FINALIZE (param $mv i32 $size i32) (result i32) ;; Check if the new string can be interned. (LET $tmp ($INTERN_STRING $mv) $ms ($to_MalString $mv)) (if $tmp (then (local.set $mv $tmp)) (else ;;; ms->size = sizeof(MalString) + size + 1 (i32.store16 (i32.add $ms 2) (i32.add (i32.add 4 $size) 1)) ;;; string_mem_next = (void *)ms + ms->size (global.set $string_mem_next (i32.add $ms (i32.load16_u (i32.add $ms 2)))))) $mv ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; numeric functions (func $INTEGER (param $val i32) (result i32) ($ALLOC_SCALAR (global.get $INTEGER_T) $val) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; sequence functions (func $MAP_LOOP_START (param $type i32) (result i32) (LET $res (if (result i32) (i32.eq $type (global.get $LIST_T)) (then (global.get $EMPTY_LIST)) (else (if (result i32) (i32.eq $type (global.get $VECTOR_T)) (then (global.get $EMPTY_VECTOR)) (else (if (result i32) (i32.eq $type (global.get $HASHMAP_T)) (then (global.get $EMPTY_HASHMAP)) (else ($THROW_STR_1 "read_seq invalid type %d" $type) 0))))))) ($INC_REF $res) ) (func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32) (param $current i32) (param $val2 i32) (param $val3 i32) (result i32) (LET $res ($ALLOC $type $empty $val2 $val3)) ;; sequence took ownership ($RELEASE $empty) ($RELEASE $val2) (if (i32.eq $type (global.get $HASHMAP_T)) ($RELEASE $val3)) (if (i32.gt_u $current (global.get $EMPTY_HASHMAP)) ;; if not first element, set current next to point to new element (i32.store ($VAL0_ptr $current) ($IDX $res))) $res ) (func $FORCE_SEQ_TYPE (param $type i32) (param $mv i32) (result i32) (LET $res 0) ;; if it's already the right type, inc ref cnt and return it (if (i32.eq $type ($TYPE $mv)) (return ($INC_REF $mv))) ;; if it's empty, return the sequence match (if (i32.le_u $mv (global.get $EMPTY_HASHMAP)) (return ($MAP_LOOP_START $type))) ;; otherwise, copy first element to turn it into correct type ($ALLOC $type ($MEM_VAL0_ptr $mv) ($MEM_VAL1_ptr $mv) 0) ) (func $LIST (param $seq i32 $first i32) (result i32) ($ALLOC (global.get $LIST_T) $seq $first 0) ) (func $LIST2 (param $first i32 $second i32) (result i32) ;; last element is empty list (LET $tmp ($LIST (global.get $EMPTY_LIST) $second) $res ($LIST $tmp $first)) ($RELEASE $tmp) ;; new list takes ownership of previous $res ) (func $LIST3 (param $first i32 $second i32 $third i32) (result i32) (LET $tmp ($LIST2 $second $third) $res ($LIST $tmp $first)) ($RELEASE $tmp) ;; new list takes ownership of previous $res ) (func $LIST_Q (param $mv i32) (result i32) (i32.eq ($TYPE $mv) (global.get $LIST_T)) ) (func $EMPTY_Q (param $mv i32) (result i32) (i32.eq ($VAL0 $mv) 0) ) (func $COUNT (param $mv i32) (result i32) (LET $cnt 0) (block $done (loop $loop (if (i32.eq ($VAL0 $mv) 0) (br $done)) (local.set $cnt (i32.add $cnt 1)) (local.set $mv ($MEM_VAL0_ptr $mv)) (br $loop) ) ) $cnt ) (func $LAST (param $mv i32) (result i32) (LET $cur 0) ;; TODO: check that actually a list/vector (if (i32.eq ($VAL0 $mv) 0) ;; empty seq, return nil (return ($INC_REF (global.get $NIL)))) (block $done (loop $loop ;; end, return previous value (if (i32.eq ($VAL0 $mv) 0) (br $done)) ;; current becomes previous entry (local.set $cur $mv) ;; next entry (local.set $mv ($MEM_VAL0_ptr $mv)) (br $loop) ) ) ($INC_REF ($MEM_VAL1_ptr $cur)) ) ;; make a copy of sequence seq from index start to end ;; set last to last element of slice before the empty ;; set after to element following slice (or original) (func $SLICE (param $seq i32) (param $start i32) (param $end i32) (result i64) (LET $idx 0 $res ($INC_REF (global.get $EMPTY_LIST)) $last 0 $tmp $res) ;; advance seq to start (block $done (loop $loop (if (OR (i32.ge_s $idx $start) (i32.eqz ($VAL0 $seq))) (br $done)) (local.set $seq ($MEM_VAL0_ptr $seq)) (local.set $idx (i32.add $idx 1)) (br $loop) ) ) (block $done (loop $loop ;; if current position is at end, then return or if we reached ;; end seq, then return (if (OR (AND (i32.ne $end -1) (i32.ge_s $idx $end)) (i32.eqz ($VAL0 $seq))) (then (local.set $res $tmp) (br $done))) ;; allocate new list element with copied value (local.set $res ($LIST (global.get $EMPTY_LIST) ($MEM_VAL1_ptr $seq))) ;; sequence took ownership ($RELEASE (global.get $EMPTY_LIST)) (if (i32.eqz $last) (then ;; if first element, set return value to new element (local.set $tmp $res)) (else ;; if not the first element, set return value to new element (i32.store ($VAL0_ptr $last) ($IDX $res)))) (local.set $last $res) ;; update last list element ;; advance to next element of seq (local.set $seq ($MEM_VAL0_ptr $seq)) (local.set $idx (i32.add $idx 1)) (br $loop) ) ) ;; combine last/res as hi 32/low 32 of i64 (i64.or (i64.shl (i64.extend_i32_u $last) (i64.const 32)) (i64.extend_i32_u $res)) ) (func $HASHMAP (result i32) ;; just point to static empty hash-map ($INC_REF (global.get $EMPTY_HASHMAP)) ) (func $ASSOC1 (param $hm i32 $k i32 $v i32) (result i32) (LET $res ($ALLOC (global.get $HASHMAP_T) $hm $k $v)) ;; we took ownership of previous release ($RELEASE $hm) $res ) (func $ASSOC1_S (param $hm i32 $k i32 $v i32) (result i32) (LET $kmv ($STRING (global.get $STRING_T) $k) $res ($ASSOC1 $hm $kmv $v)) ;; map took ownership of key ($RELEASE $kmv) $res ) (func $HASHMAP_GET (param $hm i32) (param $key_mv i32) (result i64) (LET $key ($to_String $key_mv) $found 0 $res 0 $test_key_mv 0) (block $done (loop $loop ;;; if (VAL0(hm) == 0) (if (i32.eq ($VAL0 $hm) 0) (then (local.set $res (global.get $NIL)) (br $done))) ;;; test_key_mv = MEM_VAL1(hm) (local.set $test_key_mv ($MEM_VAL1_ptr $hm)) ;;; if (strcmp(key, to_String(test_key_mv)) == 0) (if (i32.eq ($strcmp $key ($to_String $test_key_mv)) 0) (then (local.set $found 1) (local.set $res ($MEM_VAL2_ptr $hm)) (br $done))) (local.set $hm ($MEM_VAL0_ptr $hm)) (br $loop) ) ) ;; combine found/res as hi 32/low 32 of i64 (i64.or (i64.shl (i64.extend_i32_u $found) (i64.const 32)) (i64.extend_i32_u $res)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; function functions (func $FUNCTION (param $index i32) (result i32) ($ALLOC_SCALAR (global.get $FUNCTION_T) $index) ) (func $MALFUNC (param $ast i32 $params i32 $env i32) (result i32) ($ALLOC (global.get $MALFUNC_T) $ast $params $env) ) ) ================================================ FILE: impls/wren/Dockerfile ================================================ FROM ubuntu:18.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install g++ RUN apt-get -y install git COPY wren-add-gettimeofday.patch /tmp/ RUN cd /tmp && git clone --depth=1 https://github.com/wren-lang/wren.git \ && cd wren \ && patch -p1 < /tmp/wren-add-gettimeofday.patch \ && make \ && cp ./wren /usr/local/bin/ \ && cd /tmp && rm -rf wren ================================================ FILE: impls/wren/Makefile ================================================ SOURCES = types.wren env.wren printer.wren reader.wren readline.wren interop.wren core.wren stepA_mal.wren all: true dist: mal mal.wren: $(SOURCES) cat $+ | grep -v '^import "./' > $@ mal: mal.wren echo "#!/usr/bin/env wren" > $@ cat $< >> $@ chmod +x $@ .PHONY: clean clean: rm -f mal.wren mal ================================================ FILE: impls/wren/README.md ================================================ # Wren implementation ### Adding a time function Since Wren doesn't have a time function, we add a `System.gettimeofday` function which returns a float with the number of seconds since epoch (with fractions of seconds). This is done by applying the patch in `wren-add-gettimeofday.path` to Wren's source code before compiling it (see `Dockerfile`). ### Wren interop See examples in `tests/stepA_mal.mal` for usage of `wren-eval` to evaluate Wren expressions inside a Mal program. ================================================ FILE: impls/wren/core.wren ================================================ import "io" for File import "./reader" for MalReader import "./readline" for Readline import "./printer" for Printer import "./types" for MalVal, MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalAtom, MalException import "./interop" for Interop class Core { static fn(func) { MalNativeFn.new(func) } static ns { return { "=": fn { |a| a[0] == a[1] }, "throw": fn { |a| MalException.set(a[0]) Fiber.abort("___MalException___") }, "nil?": fn { |a| a[0] == null }, "true?": fn { |a| a[0] == true }, "false?": fn { |a| a[0] == false }, "string?": fn { |a| a[0] is String && !MalVal.isKeyword(a[0]) }, "symbol": fn { |a| a[0] is MalSymbol ? a[0] : MalSymbol.new(a[0]) }, "symbol?": fn { |a| a[0] is MalSymbol }, "keyword": fn { |a| MalVal.isKeyword(a[0]) ? a[0] : MalVal.newKeyword(a[0]) }, "keyword?": fn { |a| MalVal.isKeyword(a[0]) }, "number?": fn { |a| a[0] is Num }, "fn?": fn { |a| a[0] is MalNativeFn || (a[0] is MalFn && !a[0].isMacro) }, "macro?": fn { |a| a[0] is MalFn && a[0].isMacro }, "pr-str": fn { |a| a.map { |e| Printer.pr_str(e, true) }.join(" ") }, "str": fn { |a| a.map { |e| Printer.pr_str(e, false) }.join() }, "prn": fn { |a| System.print(a.map { |e| Printer.pr_str(e, true) }.join(" ")) return null }, "println": fn { |a| System.print(a.map { |e| Printer.pr_str(e, false) }.join(" ")) return null }, "read-string": fn { |a| MalReader.read_str(a[0]) }, "readline": fn { |a| Readline.readLine(a[0]) }, "slurp": fn { |a| File.read(a[0]) }, "<": fn { |a| a[0] < a[1] }, "<=": fn { |a| a[0] <= a[1] }, ">": fn { |a| a[0] > a[1] }, ">=": fn { |a| a[0] >= a[1] }, "+": fn { |a| a[0] + a[1] }, "-": fn { |a| a[0] - a[1] }, "*": fn { |a| a[0] * a[1] }, "/": fn { |a| a[0] / a[1] }, "time-ms": fn { |a| (System.gettimeofday * 1000).floor }, "list": fn { |a| MalList.new(a) }, "list?": fn { |a| a[0] is MalList }, "vector": fn { |a| MalVector.new(a) }, "vector?": fn { |a| a[0] is MalVector }, "hash-map": fn { |a| MalMap.fromList(a) }, "map?": fn { |a| a[0] is MalMap }, "assoc": fn { |a| a[0].assoc(a[1...a.count]) }, "dissoc": fn { |a| a[0].dissoc(a[1...a.count]) }, "get": fn { |a| a[0] == null ? null : a[0].data[a[1]] }, "contains?": fn { |a| a[0].data.containsKey(a[1]) }, "keys": fn { |a| MalList.new(a[0].data.keys.toList) }, "vals": fn { |a| MalList.new(a[0].data.values.toList) }, "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 }, "empty?": fn { |a| a[0].isEmpty }, "count": fn { |a| a[0] == null ? 0 : a[0].count }, "apply": fn { |a| a[0].call(a[1...(a.count - 1)] + a[-1].elements) }, "map": fn { |a| MalList.new(a[1].elements.map { |e| a[0].call([e]) }.toList) }, "conj": fn { |a| if (a[0] is MalList) return MalList.new(a[-1..1] + a[0].elements) if (a[0] is MalVector) return MalVector.new(a[0].elements + a[1..-1]) }, "seq": fn { |a| if (a[0] == null) return null if (a[0].count == 0) return null if (a[0] is String) return MalList.new(a[0].toList) if (a[0] is MalVector) return MalList.new(a[0].elements) return a[0] }, "meta": fn { |a| a[0].meta }, "with-meta": fn { |a| var x = a[0].clone() x.meta = a[1] return x }, "atom": fn { |a| MalAtom.new(a[0]) }, "atom?": fn { |a| a[0] is MalAtom }, "deref": fn { |a| a[0].value }, "reset!": fn { |a| a[0].value = a[1] }, "swap!": fn { |a| a[0].value = a[1].call([a[0].value] + a[2..-1]) }, "wren-eval": fn { |a| Interop.wren_eval(a[0]) } } } } ================================================ FILE: impls/wren/env.wren ================================================ import "./types" for MalList class Env { construct new() { _outer = null _data = {} } construct new(outer) { _outer = outer _data = {} } construct new(outer, binds, exprs) { _outer = outer _data = {} for (i in 0...binds.count) { if (binds[i].value == "&") { _data[binds[i + 1].value] = MalList.new(exprs[i..-1]) break } else { _data[binds[i].value] = exprs[i] } } } set(k, v) { _data[k] = v } find(k) { if (_data.containsKey(k)) return this if (_outer) return _outer.find(k) return null } get(k) { var foundEnv = find(k) if (!foundEnv) Fiber.abort("'%(k)' not found") return foundEnv.getValue(k) } getValue(k) { _data[k] } } ================================================ FILE: impls/wren/interop.wren ================================================ import "meta" for Meta import "./types" for MalList, MalMap class Interop { static wren_eval(str) { var f = Meta.compileExpression(str) return f == null ? null : wren2mal(f.call()) } static wren2mal(v) { if (v == null || v == true || v == false) return v if (v is Num || v is String) return v if (v is Map) { var m = {} for (e in v) { m[wren2mal(e.key)] = wren2mal(e.value) } return MalMap.new(m) } if (v is Sequence) return MalList.new(v.map { |e| wren2mal(e) }.toList) return null } } ================================================ FILE: impls/wren/printer.wren ================================================ import "./types" for MalVal, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalAtom class Printer { static joinElements(elements, print_readably) { return elements.map { |e| pr_str(e, print_readably) }.join(" ") } static joinMapElements(data, print_readably) { return data.map { |e| pr_str(e.key, print_readably) + " " + pr_str(e.value, print_readably) }.join(" ") } static escape(s) { return "\"" + s.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n") + "\"" } static pr_str(obj) { pr_str(obj, true) } static pr_str(obj, print_readably) { if (obj == null) return "nil" if (obj is MalList) return "(%(joinElements(obj.elements, print_readably)))" if (obj is MalVector) return "[%(joinElements(obj.elements, print_readably))]" if (obj is MalMap) return "{%(joinMapElements(obj.data, print_readably))}" if (obj is MalNativeFn) return "#" if (obj is MalFn) return "#" if (obj is MalAtom) return "(atom %(pr_str(obj.value, print_readably)))" if (MalVal.isKeyword(obj)) return ":%(obj[1..-1])" if (obj is String) return print_readably ? escape(obj) : obj return obj.toString } } ================================================ FILE: impls/wren/reader.wren ================================================ import "./types" for MalVal, MalSymbol, MalList, MalVector, MalMap class Tokenizer { construct new(s) { _s = s } tokenize() { _pos = 0 var tokens = [] while (true) { var token = nextToken() if (token == null) break if (token.count > 0) tokens.add(token) } return tokens } static eolChars { "\r\n" } static whitespace { " ,\r\n\t" } static delimiters { "[]{}()'`^@" } static separators { Tokenizer.whitespace + "[]{}()'\"`,;" } nextToken() { if (isEOF()) return null var ch = curr if (Tokenizer.whitespace.contains(ch)) { advance() return "" } if (Tokenizer.delimiters.contains(ch)) { advance() return ch } if (ch == "~") { advance() if (!isEOF() && curr == "@") { advance() return "~@" } else { return "~" } } if (ch == ";") { advance() while (!isEOF() && !Tokenizer.eolChars.contains(curr)) advance() return "" } if (ch == "\"") { var s = ch advance() while (!isEOF() && curr != "\"") { if (curr == "\\") { s = s + curr advance() if (isEOF()) Fiber.abort("expected '\"', got EOF 111") } s = s + curr advance() } if (isEOF()) Fiber.abort("expected '\"', got EOF 222") s = s + curr advance() return s } var token = ch advance() while (!isEOF() && !Tokenizer.separators.contains(curr)) { token = token + curr advance() } return token } curr { _s[_pos] } isEOF() { _pos >= _s.count } advance() { _pos = _pos + 1 } } class Reader { construct new(tokens) { _tokens = tokens _pos = 0 } next() { if (_pos >= _tokens.count) return null var token = _tokens[_pos] _pos = _pos + 1 return token } peek() { if (_pos >= _tokens.count) return null return _tokens[_pos] } } class MalReader { static parse_str(token) { if (token.count <= 2) return "" return token[1..-2].replace("\\\\", "\u029e").replace("\\\"", "\"").replace("\\n", "\n").replace("\u029e", "\\") } static is_all_digits(s) { if (s.count == 0) return false return s.all { |c| c.bytes[0] >= 0x30 && c.bytes[0] <= 0x39 } } static is_number(token) { return token.startsWith("-") ? is_all_digits(token[1..-1]) : is_all_digits(token) } static read_atom(rdr) { var token = rdr.next() if (is_number(token)) return Num.fromString(token) if (token.startsWith("\"")) return parse_str(token) if (token.startsWith(":")) return MalVal.newKeyword(token[1..-1]) if (token == "nil") return null if (token == "true") return true if (token == "false") return false return MalSymbol.new(token) } static read_seq(rdr, start, end) { var token = rdr.next() if (token != start) Fiber.abort("expected '%(start)'") var elements = [] token = rdr.peek() while (token != end) { if (!token) Fiber.abort("expected '%(end)', got EOF") elements.add(read_form(rdr)) token = rdr.peek() } rdr.next() return elements } static reader_macro(rdr, sym) { rdr.next() return MalList.new([MalSymbol.new(sym), read_form(rdr)]) } static read_form(rdr) { var token = rdr.peek() if (token == "'") return reader_macro(rdr, "quote") if (token == "`") return reader_macro(rdr, "quasiquote") if (token == "~") return reader_macro(rdr, "unquote") if (token == "~@") return reader_macro(rdr, "splice-unquote") if (token == "^") { rdr.next() var meta = read_form(rdr) return MalList.new([MalSymbol.new("with-meta"), read_form(rdr), meta]) } if (token == "@") return reader_macro(rdr, "deref") if (token == "(") return MalList.new(read_seq(rdr, "(", ")")) if (token == ")") Fiber.abort("unexpected ')'") if (token == "[") return MalVector.new(read_seq(rdr, "[", "]")) if (token == "]") Fiber.abort("unexpected ']'") if (token == "{") return MalMap.fromList(read_seq(rdr, "{", "}")) if (token == "}") Fiber.abort("unexpected '}'") return read_atom(rdr) } static read_str(s) { var tokens = Tokenizer.new(s).tokenize() if (tokens.count == 0) return null return read_form(Reader.new(tokens)) } } ================================================ FILE: impls/wren/readline.wren ================================================ import "io" for Stdin, Stdout class Readline { static readLine(prompt) { var line = null var fiber = Fiber.new { System.write(prompt) Stdout.flush() line = Stdin.readLine() } var error = fiber.try() return error ? null : line } } ================================================ FILE: impls/wren/run ================================================ #!/usr/bin/env bash exec wren $(dirname $0)/${STEP:-stepA_mal}.wren "${@}" ================================================ FILE: impls/wren/step0_repl.wren ================================================ import "./readline" for Readline class Mal { static read(str) { return str } static eval(ast, env) { return ast } static print(ast) { return ast } static rep(str) { return print(eval(read(str), null)) } static main() { while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") System.print(rep(line)) } System.print() } } Mal.main() ================================================ FILE: impls/wren/step1_read_print.wren ================================================ import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { return ast } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), null)) } static main() { while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step2_eval.wren ================================================ import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalList, MalVector, MalMap class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { // System.print("EVAL: %(print(ast))") // Process non-list types. if (ast is MalSymbol) { if (!env.containsKey(ast.value)) Fiber.abort("'%(ast.value)' not found") return env[ast.value] } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = { "+": Fn.new { |a| a[0] + a[1] }, "-": Fn.new { |a| a[0] - a[1] }, "*": Fn.new { |a| a[0] * a[1] }, "/": Fn.new { |a| a[0] / a[1] } } while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step3_env.wren ================================================ import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalList, MalVector, MalMap class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } return eval(ast[2], letEnv) } } var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() __repl_env.set("+", Fn.new { |a| a[0] + a[1] }) __repl_env.set("-", Fn.new { |a| a[0] - a[1] }) __repl_env.set("*", Fn.new { |a| a[0] * a[1] }) __repl_env.set("/", Fn.new { |a| a[0] / a[1] }) while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step4_if_fn_do.wren ================================================ import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalList, MalVector, MalMap import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } return eval(ast[2], letEnv) } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } return eval(ast[-1], env) } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { return eval(ast[2], env) } else { return ast.count > 3 ? eval(ast[3], env) : null } } else if (ast[0].value == "fn*") { return Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) } } } var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step5_tco.wren ================================================ import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalList, MalVector, MalMap, MalNativeFn, MalFn import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) tco = true } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step6_file.wren ================================================ import "os" for Process import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalList, MalVector, MalMap, MalNativeFn, MalFn import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) tco = true } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (Process.arguments.count > 0) { rep("(load-file \"%(Process.arguments[0])\")") return } while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step7_quote.wren ================================================ import "os" for Process import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } 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 (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 { return ast } } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "quote") { return ast[1] } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) tco = true } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if (Process.arguments.count > 0) { rep("(load-file \"%(Process.arguments[0])\")") return } while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step8_macros.wren ================================================ import "os" for Process import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } 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 (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 { return ast } } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "quote") { return ast[1] } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true } else if (ast[0].value == "defmacro!") { return env.set(ast[1].value, eval(ast[2], env).makeMacro()) } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) } } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (Process.arguments.count > 0) { rep("(load-file \"%(Process.arguments[0])\")") return } while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() if (fiber.error) System.print("Error: %(fiber.error)") } } System.print() } } Mal.main() ================================================ FILE: impls/wren/step9_try.wren ================================================ import "os" for Process import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalException import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } 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 (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 { return ast } } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "quote") { return ast[1] } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true } else if (ast[0].value == "defmacro!") { return env.set(ast[1].value, eval(ast[2], env).makeMacro()) } else if (ast[0].value == "try*") { if (ast.count > 2 && ast[2][0] is MalSymbol && ast[2][0].value == "catch*") { var fiber = Fiber.new { eval(ast[1], env) } var result = fiber.try() var error = fiber.error if (!error) return result if (error == "___MalException___") { error = MalException.value MalException.set(null) } return eval(ast[2][2], Env.new(env, [ast[2][1]], [error])) } else { return eval(ast[1], env) } } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) } } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) // core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (Process.arguments.count > 0) { rep("(load-file \"%(Process.arguments[0])\")") return } while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() var error = fiber.error if (error) { if (error == "___MalException___") { error = Printer.pr_str(MalException.value, false) MalException.set(null) } System.print("Error: %(error)") } } } System.print() } } Mal.main() ================================================ FILE: impls/wren/stepA_mal.wren ================================================ import "os" for Process import "./env" for Env import "./readline" for Readline import "./reader" for MalReader import "./printer" for Printer import "./types" for MalSymbol, MalSequential, MalList, MalVector, MalMap, MalNativeFn, MalFn, MalException import "./core" for Core class Mal { static read(str) { return MalReader.read_str(str) } 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 (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 { return ast } } static eval(ast, env) { while (true) { var tco = false var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { var m = {} for (e in ast.data) { m[e.key] = eval(e.value, env) } return MalMap.new(m) } else { return ast } // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { return env.set(ast[1].value, eval(ast[2], env)) } else if (ast[0].value == "let*") { var letEnv = Env.new(env) var i = 0 while (i < ast[1].count) { letEnv.set(ast[1][i].value, eval(ast[1][i + 1], letEnv)) i = i + 2 } ast = ast[2] env = letEnv tco = true } else if (ast[0].value == "quote") { return ast[1] } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true } else if (ast[0].value == "defmacro!") { return env.set(ast[1].value, eval(ast[2], env).makeMacro()) } else if (ast[0].value == "try*") { if (ast.count > 2 && ast[2][0] is MalSymbol && ast[2][0].value == "catch*") { var fiber = Fiber.new { eval(ast[1], env) } var result = fiber.try() var error = fiber.error if (!error) return result if (error == "___MalException___") { error = MalException.value MalException.set(null) } return eval(ast[2][2], Env.new(env, [ast[2][1]], [error])) } else { return eval(ast[1], env) } } else if (ast[0].value == "do") { for (i in 1...(ast.count - 1)) { eval(ast[i], env) } ast = ast[-1] tco = true } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { ast = ast[2] } else { if (ast.count <= 3) return null ast = ast[3] } tco = true } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) } } else { Fiber.abort("unknown function type") } } } } static print(ast) { return Printer.pr_str(ast) } static rep(str) { return print(eval(read(str), __repl_env)) } static main() { __repl_env = Env.new() // core.wren: defined in wren for (e in Core.ns) { __repl_env.set(e.key, e.value) } __repl_env.set("eval", MalNativeFn.new { |a| eval(a[0], __repl_env) }) __repl_env.set("*ARGV*", MalList.new(Process.arguments.count > 0 ? Process.arguments[1..-1] : [])) // core.mal: defined using the language itself rep("(def! *host-language* \"wren\")") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))") if (Process.arguments.count > 0) { rep("(load-file \"%(Process.arguments[0])\")") return } rep("(println (str \"Mal [\" *host-language* \"]\"))") while (true) { var line = Readline.readLine("user> ") if (line == null) break if (line != "") { var fiber = Fiber.new { System.print(rep(line)) } fiber.try() var error = fiber.error if (error) { if (error == "___MalException___") { error = Printer.pr_str(MalException.value, false) MalException.set(null) } System.print("Error: %(error)") } } } System.print() } } Mal.main() ================================================ FILE: impls/wren/tests/step5_tco.mal ================================================ ;; Wren: skipping non-TCO recursion ;; Reason: completes up to 1,000,000 (with extended timeout) ================================================ FILE: impls/wren/tests/stepA_mal.mal ================================================ ;; Testing basic Wren interop ;;; wren-eval evaluates the given string as an expression. (wren-eval "7") ;=>7 (wren-eval "0x41") ;=>65 (wren-eval "\"7\"") ;=>"7" (wren-eval "[ 7,8,9 ]") ;=>(7 8 9) (wren-eval "{ \"abc\": 789 }") ;=>{"abc" 789} (wren-eval "System.print(\"hello\")") ;/hello ;=>"hello" (wren-eval "[\"a\", \"b\", \"c\"].map { |x| \"X%(x)Y\" }.join(\" \")") ;=>"XaY XbY XcY" (wren-eval "[1,2,3].map { |x| 1 + x }") ;=>(2 3 4) (wren-eval "[null, (1 == 1), (1 == 2)]") ;=>(nil true false) (wren-eval "Fiber.abort(\"AAA\" + \"BBB\")") ;/Error: AAABBB ================================================ FILE: impls/wren/types.wren ================================================ class MalVal { static newKeyword(value) { "\u029e%(value)" } static isKeyword(obj) { obj is String && obj.count > 0 && obj[0] == "\u029e" } meta { _meta } meta=(value) { _meta = value } } class MalSymbol is MalVal { construct new(value) { _value = value } value { _value } toString { _value } ==(other) { other is MalSymbol && other.value == _value } !=(other) { !(this == other) } } class MalSequential is MalVal { construct new(elements) { _elements = elements } elements { _elements } [index] { _elements[index] } isEmpty { _elements.count == 0 } count { _elements.count } first { isEmpty ? null : _elements[0] } rest { MalList.new(isEmpty ? [] : elements[1..-1]) } ==(other) { if (!(other is MalSequential)) return false if (other.count != count) return false for (i in 0...count) { if (other[i] != this[i]) return false } return true } !=(other) { !(this == other) } } class MalList is MalSequential { construct new(elements) { super(elements) } clone() { MalList.new(elements) } } class MalVector is MalSequential { construct new(elements) { super(elements) } clone() { MalVector.new(elements) } } class MalMap is MalVal { construct new(data) { _data = data } construct fromList(elements) { _data = {} var i = 0 while (i < elements.count) { _data[elements[i]] = elements[i + 1] i = i + 2 } } clone() { MalMap.new(_data) } data { _data } assoc(pairsList) { var newData = {} for (e in _data) { newData[e.key] = e.value } var i = 0 while (i < pairsList.count) { newData[pairsList[i]] = pairsList[i + 1] i = i + 2 } return MalMap.new(newData) } dissoc(keysList) { var newData = {} for (e in _data) { newData[e.key] = e.value } for (k in keysList) { newData.remove(k) } return MalMap.new(newData) } ==(other) { if (!(other is MalMap)) return false if (other.data.count != data.count) return false for (e in _data) { if (other.data[e.key] != e.value) return false } return true } !=(other) { !(this == other) } } class MalNativeFn is MalVal { construct new(fn) { _fn = fn } call(args) { _fn.call(args) } clone() { MalNativeFn.new(_fn) } } class MalFn is MalVal { construct new(ast, params, env, fn) { _ast = ast _params = params _env = env _fn = fn _isMacro = false } construct new(ast, params, env, fn, isMacro) { _ast = ast _params = params _env = env _fn = fn _isMacro = isMacro } ast { _ast } params { _params } env { _env } isMacro { _isMacro } clone() { MalFn.new(_ast, _params, _env, _fn, _isMacro) } makeMacro() { MalFn.new(_ast, _params, _env, _fn, true) } call(args) { _fn.call(args) } } class MalAtom is MalVal { construct new(value) { _value = value } value { _value } value=(other) { _value = other } clone() { MalAtom.new(value) } } class MalException { static value { __exception } static set(exception) { __exception = exception } } ================================================ FILE: impls/wren/wren-add-gettimeofday.patch ================================================ diff --git a/src/vm/wren_core.c b/src/vm/wren_core.c index 34a13c8b..3c4e6ab8 100644 --- a/src/vm/wren_core.c +++ b/src/vm/wren_core.c @@ -4,6 +4,7 @@ #include #include #include +#include #include "wren_common.h" #include "wren_core.h" @@ -1121,6 +1122,13 @@ DEF_PRIMITIVE(string_toString) RETURN_VAL(args[0]); } +DEF_PRIMITIVE(system_gettimeofday) +{ + struct timeval tv; + gettimeofday(&tv, NULL); + RETURN_NUM((double)tv.tv_sec + (double)tv.tv_usec/1000000.0); +} + DEF_PRIMITIVE(system_clock) { RETURN_NUM((double)clock() / CLOCKS_PER_SEC); @@ -1374,6 +1382,7 @@ void wrenInitializeCore(WrenVM* vm) PRIMITIVE(vm->rangeClass, "toString", range_toString); ObjClass* systemClass = AS_CLASS(wrenFindVariable(vm, coreModule, "System")); + PRIMITIVE(systemClass->obj.classObj, "gettimeofday", system_gettimeofday); PRIMITIVE(systemClass->obj.classObj, "clock", system_clock); PRIMITIVE(systemClass->obj.classObj, "gc()", system_gc); PRIMITIVE(systemClass->obj.classObj, "writeString_(_)", system_writeString); ================================================ FILE: impls/xslt/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN DEBIAN_FRONTEND=noninteractive apt-get -y install \ default-jre-headless libsaxonhe-java ================================================ FILE: impls/xslt/Makefile ================================================ .DEFAULT: echo .PHONY: clean all: echo "hello there general kenobi" ================================================ FILE: impls/xslt/core.xslt ================================================ false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false false ================================================ FILE: impls/xslt/env.xslt ================================================ ================================================ FILE: impls/xslt/printer.xslt ================================================ true false nil ? ? ? ? Unknown ================================================ FILE: impls/xslt/reader.xslt ================================================ Odd number of values to hash EOF while reading sequence ================================================ FILE: impls/xslt/readline.xslt ================================================ ================================================ FILE: impls/xslt/run ================================================ #!/usr/bin/python3 import time import os.path import readline import sys import xml.etree.ElementTree as ET from threading import Thread from threading import Lock from collections import deque saxon_jar = '/usr/share/java/Saxon-HE-*.jar' saxon = f'java -Xmx2G -cp {saxon_jar} net.sf.saxon.Transform' step_dir = os.path.dirname(sys.argv[0]) step_base = os.getenv(key='STEP', default='stepA_mal') fname = os.path.join(step_dir, step_base + '.xslt') args = sys.argv[1:] tree = ET.Element('mal') if len(args) > 0: args0 = args[0] ET.SubElement(tree, 'argv') for a in tree.iter('mal'): for a in a.iter('argv'): for arg in args[1:]: ET.SubElement(a, 'arg').text = arg ET.SubElement(tree, 'no_repl') tree = ET.ElementTree(tree) stdout = sys.stdout try: readline.read_history_file('.xslt_mal_history') except: pass HALT = False THE_PID = None init_t = time.time() * 1000 readline_queue = deque() os.system('rm -rf xsl_error.xml') os.system('mkfifo xsl_error.xml') def setup_request_file(): os.system('rm -rf xsl_input-string') os.system('mkfifo xsl_input-string') def get_one(fd): s = b"" while True: x = os.read(fd, 1) if x == b'\n': break if x == b'': break s += x if s == "": return None return s.decode('utf-8') def serve_one_request(res): global HALT if len(res) == 0: return try: xtree = ET.fromstring("" + res.strip('\x00') + "") # stdout.write(xtree.attrib['kind']) for req in xtree: if req.attrib['kind'] == 'readline': x = None if len(readline_queue) > 0: x = readline_queue.popleft() else: x = input(req.attrib['value']) with open('xsl_input-string', 'w') as fx: fx.write(x) # stdout.write(' = ' + x) elif req.attrib['kind'] == 'halt': HALT = True elif req.attrib['kind'] == 'display': stdout.write(req.attrib['value'] + '\n') elif req.attrib['kind'] == 'time': x = time.time() * 1000 - init_t # stdout.write(' = ' + str(int(x))) with open('xsl_input-string', 'w') as fx: fx.write(str(int(x))) # stdout.write('\n') elif req.attrib['kind'] == 'xpath-eval': xpath = req.attrib['value'] with open('xsl-eval.xslt', 'w') as f: f.write(f'') with open('xsl-null.xml', 'w') as f: f.write(req.attrib['context']) if os.system(f'{saxon} -xsl:xsl-eval.xslt -s:xsl-null.xml > xsl-eval_output.xml'): x = '' else: with open('xsl-eval_output.xml', 'r') as f: x = f.read() with open('xsl_input-string', 'w') as fx: fx.write(x) else: stdout.write("UNKNOWN REQUEST " + req.attrib['kind']) # stdout.write('\n') except Exception as e: # if str(e) != 'no element found: line 1, column 0': # f.seek(0) # print(e, list(x for x in f.read())) return # with open('xsl_error.xml', 'w') as f: # f.write('') def transform(do_print=True): global tree, HALT, THE_PID tree.write('xslt_input.xml') setup_request_file() pid = os.fork() if pid == 0: os.system(f'{saxon} -xsl:"{fname}" -s:xslt_input.xml -TP:perf.html > xslt_output.xml 2> xsl_error.xml') HALT = True else: THE_PID = pid fd = os.open('xsl_error.xml', os.O_RDONLY | os.O_CLOEXEC) while True: try: if HALT: os.kill(THE_PID, 9) raise KeyboardInterrupt() cmd = get_one(fd) if cmd: serve_one_request(cmd) except KeyboardInterrupt: exit() except Exception as e: print("Harness error:", e) tree = ET.parse('xslt_output.xml') if do_print: stdout = '' for a in tree.iter('mal'): for a in a.iter('stdout'): stdout = a print(stdout.text) stdout.clear() del stdout if len(args) > 0: readline_queue.append(f'(do (load-file "{args0}") (xslt-halt))') transform(do_print=False) else: if fname == 'stepA_mal.xslt': readline_queue.append('(println (str "Mal [" *host-language* "]"))') transform(do_print=False) else: transform() readline.write_history_file('.xslt_mal_history') ================================================ FILE: impls/xslt/step0_repl.inc.xslt ================================================ ================================================ FILE: impls/xslt/step0_repl.xslt ================================================ ================================================ FILE: impls/xslt/step1_read_print.inc.xslt ================================================ ================================================ FILE: impls/xslt/step1_read_print.xslt ================================================ ================================================ FILE: impls/xslt/step2_eval.inc.xslt ================================================ Invalid function ================================================ FILE: impls/xslt/step2_eval.xslt ================================================ ================================================ FILE: impls/xslt/step3_env.inc.xslt ================================================ ================================================ FILE: impls/xslt/step3_env.xslt ================================================ ================================================ FILE: impls/xslt/step4_if_fn_do.inc.xslt ================================================ (def! not (fn* (a) (if a false true))) ================================================ FILE: impls/xslt/step4_if_fn_do.xslt ================================================ ================================================ FILE: impls/xslt/step6_file.inc.xslt ================================================ (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))) ================================================ FILE: impls/xslt/step6_file.xslt ================================================ ================================================ FILE: impls/xslt/step7_quote.inc.xslt ================================================ (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))) ================================================ FILE: impls/xslt/step7_quote.xslt ================================================ ================================================ FILE: impls/xslt/step8_macros.inc.xslt ================================================ (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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)))))))) true false ================================================ FILE: impls/xslt/step8_macros.xslt ================================================ ================================================ FILE: impls/xslt/step9_try.inc.xslt ================================================ (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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)))))))) true false ================================================ FILE: impls/xslt/step9_try.xslt ================================================ ================================================ FILE: impls/xslt/stepA_mal.inc.xslt ================================================ (do (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) (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))))))) (def! *host-language* "XSLT")) true false ================================================ FILE: impls/xslt/stepA_mal.xslt ================================================ ================================================ FILE: impls/xslt/test.xslt ================================================ ================================================ FILE: impls/yorick/Dockerfile ================================================ FROM ubuntu:xenial MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python # Some typical implementation and test requirements RUN apt-get -y install curl libreadline-dev libedit-dev RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install yorick yorick-yeti yorick-yeti-regex ENV HOME /mal ================================================ FILE: impls/yorick/Makefile ================================================ SOURCES_BASE = hash.i types.i reader.i printer.i SOURCES_LISP = env.i core.i stepA_mal.i SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: all dist clean all: dist dist: mal mal: $(SOURCES) echo "#!/usr/bin/yorick -batch" > $@ cat $+ | grep -v "^require," >> $@ chmod +x $@ clean: rm -f mal ================================================ FILE: impls/yorick/core.i ================================================ require, "types.i" func mal_equal(a) { return new_boolean(equal(*a(1), *a(2))); } func mal_throw(a) { return MalError(obj=a(1)); } func mal_nil_q(a) { return new_boolean(structof(*a(1)) == MalNil); } func mal_true_q(a) { return new_boolean(structof(*a(1)) == MalTrue); } func mal_false_q(a) { return new_boolean(structof(*a(1)) == MalFalse); } func mal_string_q(a) { return new_boolean(structof(*a(1)) == MalString); } func mal_symbol(a) { return MalSymbol(val=a(1)->val); } func mal_symbol_q(a) { return new_boolean(structof(*a(1)) == MalSymbol); } func mal_keyword(a) { return MalKeyword(val=a(1)->val); } func mal_keyword_q(a) { return new_boolean(structof(*a(1)) == MalKeyword); } func mal_number_q(a) { return new_boolean(structof(*a(1)) == MalNumber); } func mal_fn_q(a) { if (structof(*a(1)) == MalNativeFunction) return MAL_TRUE; return new_boolean(structof(*a(1)) == MalFunction && !a(1)->macro); } func mal_macro_q(a) { return new_boolean(structof(*a(1)) == MalFunction && a(1)->macro); } func string_helper(a, delimiter, readable) { res = "" for (i = 1; i <= numberof(a); ++i) { if (i > 1) res += delimiter res += pr_str(*a(i), readable) } return res } func mal_pr_str(a) { return MalString(val=string_helper(a, " ", 1)); } func mal_str(a) { return MalString(val=string_helper(a, "", 0)); } func mal_prn(a) { write, format="%s\n", string_helper(a, " ", 1); return MAL_NIL; } func mal_println(a) { write, format="%s\n", string_helper(a, " ", 0); return MAL_NIL; } func mal_read_string(a) { return read_str(a(1)->val); } func mal_readline(a) { extern stdin_file stdin_file = open("/dev/stdin", "r") write, format="%s", a(1)->val line = rdline(stdin_file, prompt="") return line ? MalString(val=line) : MAL_NIL } func mal_slurp(a) { f = open(a(1)->val) lines = rdfile(f) close, f s = "" for (i = 1; i <= numberof(lines); ++i) { s += (lines(i) + "\n") } return MalString(val=s) } func mal_lt(a) { return new_boolean(a(1)->val < a(2)->val); } func mal_lte(a) { return new_boolean(a(1)->val <= a(2)->val); } func mal_gt(a) { return new_boolean(a(1)->val > a(2)->val); } func mal_gte(a) { return new_boolean(a(1)->val >= a(2)->val); } func mal_add(a) { return MalNumber(val=(a(1)->val + a(2)->val)); } func mal_sub(a) { return MalNumber(val=(a(1)->val - a(2)->val)); } func mal_mul(a) { return MalNumber(val=(a(1)->val * a(2)->val)); } func mal_div(a) { return MalNumber(val=(a(1)->val / a(2)->val)); } func mal_time_ms(a) { elapsed = array(double, 3) timer, elapsed return MalNumber(val=floor(elapsed(3) * 1000)) } func mal_list(a) { return MalList(val=&a); } func mal_list_q(a) { return new_boolean(structof(*a(1)) == MalList); } func mal_vector(a) { return MalVector(val=&a); } func mal_vector_q(a) { return new_boolean(structof(*a(1)) == MalVector); } func mal_hash_map(a) { return array_to_hashmap(a); } func mal_map_q(a) { return new_boolean(structof(*a(1)) == MalHashmap); } func mal_assoc(a) { h = *(a(1)->val) k1 = *h.keys v1 = *h.vals new_h = Hash(keys=&k1, vals=&v1) for (i = 2; i <= numberof(a); i += 2) { hash_set, new_h, hashmap_obj_to_key(*a(i)), *a(i + 1) } return MalHashmap(val=&new_h); } func mal_dissoc(a) { h = *(a(1)->val) k1 = *h.keys v1 = *h.vals new_h = Hash(keys=&k1, vals=&v1) for (i = 2; i <= numberof(a); ++i) { hash_delete, new_h, hashmap_obj_to_key(*a(i)) } return MalHashmap(val=&new_h); } func mal_get(a) { if (structof(*a(1)) == MalNil) return MAL_NIL h = *(a(1)->val) key_obj = *a(2) val = hash_get(h, hashmap_obj_to_key(key_obj)) return is_void(val) ? MAL_NIL : val } func mal_contains_q(a) { if (structof(*a(1)) == MalNil) return MAL_FALSE h = *(a(1)->val) key_obj = *a(2) return hash_has_key(h, hashmap_obj_to_key(key_obj)) ? MAL_TRUE : MAL_FALSE } func mal_keys(a) { keys_strs = *(a(1)->val->keys) if (numberof(keys_strs) == 0) return MalList(val=&[]) res = array(pointer, numberof(keys_strs)) for (i = 1; i <= numberof(keys_strs); ++i) { res(i) = &hashmap_key_to_obj(keys_strs(i)) } return MalList(val=&res); } func mal_vals(a) { return MalList(val=a(1)->val->vals); } func mal_sequential_q(a) { return new_boolean(structof(*a(1)) == MalList || structof(*a(1)) == MalVector); } func mal_cons(a) { a2_len = count(*a(2)) seq = array(pointer, a2_len + 1) seq(1) = a(1) if (a2_len > 0) { seq(2:) = *(a(2)->val) } return MalList(val=&seq) } func mal_concat(a) { seq = [] for (i = 1; i <= numberof(a); ++i) { grow, seq, *(a(i)->val) } 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 if (index >= count(*a(1))) return MalError(message="nth: index out of range") return *((*(a(1)->val))(index + 1)) } func mal_first(a) { if (structof(*a(1)) == MalNil || count(*a(1)) == 0) return MAL_NIL return *((*(a(1)->val))(1)) } func mal_rest(a) { if (structof(*a(1)) == MalNil) return MalList(val=&[]) return rest(*a(1)) } func mal_empty_q(a) { return new_boolean((structof(*a(1)) == MalNil ? 1 : count(*a(1)) == 0)); } func mal_count(a) { return MalNumber(val=(structof(*a(1)) == MalNil ? 0 : count(*a(1)))); } func call_func(fn, args) { if (structof(fn) == MalNativeFunction) { return call_core_fn(fn.val, args) } else if (structof(fn) == MalFunction) { fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) return EVAL(*fn.ast, fn_env) } else { return MalError(message="Unknown function type") } } func mal_apply(a) { mid_args = numberof(a) > 2 ? a(2:-1) : [] return call_func(*a(1), grow(mid_args, *(a(0)->val))) } func mal_map(a) { fn = *a(1) seq = *(a(2)->val) if (numberof(seq) == 0) return MalList(val=&[]) new_seq = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { new_val = call_func(fn, [seq(i)]) if (structof(new_val) == MalError) return new_val new_seq(i) = &new_val } return MalList(val=&new_seq) } func mal_conj(a) { obj = *a(1) type = structof(obj) if (type == MalList) { res = obj for (i = 2; i <= numberof(a); ++i) { res = mal_cons([a(i), &res]) } return res } else if (type == MalVector) { seq = *obj.val grow, seq, a(2:) return MalVector(val=&seq) } else { return MalError(message="conj requires list or vector") } } func mal_seq(a) { obj = *a(1) type = structof(obj) if (type == MalString) { len = strlen(obj.val) if (len == 0) return MAL_NIL seq = array(pointer, len) for (i = 1; i <= len; ++i) { seq(i) = &MalString(val=strpart(obj.val, i:i)) } return MalList(val=&seq) } else if (type == MalList) { return count(obj) == 0 ? MAL_NIL : obj } else if (type == MalVector) { return count(obj) == 0 ? MAL_NIL : MalList(val=obj.val) } else if (type == MalNil) { return MAL_NIL } else { return MalError(message="seq requires string or list or vector or nil") } } func mal_meta(a) { meta_obj = *(a(1)->meta) return is_void(meta_obj) ? MAL_NIL : meta_obj } func mal_with_meta(a) { new_obj = *a(1) new_obj.meta = a(2) return new_obj } func mal_atom(a) { return MalAtom(val=&MalAtomVal(val=a(1))); } func mal_atom_q(a) { return new_boolean(structof(*a(1)) == MalAtom); } func mal_deref(a) { return *(a(1)->val->val); } func mal_reset_bang(a) { a(1)->val->val = a(2); return *(a(1)->val->val); } func mal_swap_bang(a) { old_val = mal_deref([a(1)]) args = array(pointer, numberof(a) - 1) args(1) = &old_val if (numberof(a) > 2) args(2:) = a(3:) new_val = call_func(*a(2), args) if (structof(new_val) == MalError) return new_val return mal_reset_bang([a(1), &new_val]) } func mal_eval(a) { return EVAL(*a(1), repl_env); } func yorick_to_mal(e) { if (is_void(e)) return MAL_NIL if (is_scalar(e)) { if (is_numerical(e)) return MalNumber(val=e) else if (is_string(e)) return MalString(val=e) else return MalString(val=totxt(e)) } else { seq = array(pointer, numberof(e)) for (i = 1; i <= numberof(e); ++i) { seq(i) = &yorick_to_mal(e(i)) } return MalList(val=&seq) } } func mal_yorick_eval(a) { return yorick_to_mal(exec(a(1)->val)); } core_ns = h_new() h_set, core_ns, "=", mal_equal h_set, core_ns, "throw", mal_throw h_set, core_ns, "nil?", mal_nil_q h_set, core_ns, "true?", mal_true_q h_set, core_ns, "false?", mal_false_q h_set, core_ns, "string?", mal_string_q h_set, core_ns, "symbol", mal_symbol h_set, core_ns, "symbol?", mal_symbol_q h_set, core_ns, "keyword", mal_keyword h_set, core_ns, "keyword?", mal_keyword_q h_set, core_ns, "number?", mal_number_q h_set, core_ns, "fn?", mal_fn_q h_set, core_ns, "macro?", mal_macro_q h_set, core_ns, "pr-str", mal_pr_str h_set, core_ns, "str", mal_str h_set, core_ns, "prn", mal_prn h_set, core_ns, "println", mal_println h_set, core_ns, "read-string", mal_read_string h_set, core_ns, "readline", mal_readline h_set, core_ns, "slurp", mal_slurp h_set, core_ns, "<", mal_lt h_set, core_ns, "<=", mal_lte h_set, core_ns, ">", mal_gt h_set, core_ns, ">=", mal_gte h_set, core_ns, "+", mal_add h_set, core_ns, "-", mal_sub h_set, core_ns, "*", mal_mul h_set, core_ns, "/", mal_div h_set, core_ns, "time-ms", mal_time_ms h_set, core_ns, "list", mal_list h_set, core_ns, "list?", mal_list_q h_set, core_ns, "vector", mal_vector h_set, core_ns, "vector?", mal_vector_q h_set, core_ns, "hash-map", mal_hash_map h_set, core_ns, "map?", mal_map_q h_set, core_ns, "assoc", mal_assoc h_set, core_ns, "dissoc", mal_dissoc h_set, core_ns, "get", mal_get h_set, core_ns, "contains?", mal_contains_q h_set, core_ns, "keys", mal_keys 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 h_set, core_ns, "empty?", mal_empty_q h_set, core_ns, "count", mal_count h_set, core_ns, "apply", mal_apply h_set, core_ns, "map", mal_map h_set, core_ns, "conj", mal_conj h_set, core_ns, "seq", mal_seq h_set, core_ns, "meta", mal_meta h_set, core_ns, "with-meta", mal_with_meta h_set, core_ns, "atom", mal_atom h_set, core_ns, "atom?", mal_atom_q h_set, core_ns, "deref", mal_deref h_set, core_ns, "reset!", mal_reset_bang h_set, core_ns, "swap!", mal_swap_bang h_set, core_ns, "eval", mal_eval h_set, core_ns, "yorick-eval", mal_yorick_eval func call_core_fn(name, args_list) { f = h_get(core_ns, name) return f(args_list) } ================================================ FILE: impls/yorick/env.i ================================================ require, "hash.i" require, "types.i" struct Env { pointer outer Hash data } func env_new(outer_ptr, binds=, exprs=) { env = Env(outer=outer_ptr, data=hash_new()) for (i = 1; i <= numberof(binds); ++i) { if (binds(i)->val == "&") { rest_args = numberof(exprs) >= i ? exprs(i:) : [] env_set, env, binds(i + 1)->val, MalList(val=&rest_args) break } else { env_set, env, binds(i)->val, *exprs(i) } } return env } func env_find(env, key) { if (hash_has_key(env.data, key)) return env if (is_void(*env.outer)) return nil return env_find(*env.outer, key) } func env_get(env, key) { found_env = env_find(env, key) if (is_void(found_env)) return MalError(message=("'" + key + "' not found")) return hash_get(found_env.data, key) } func env_set(&env, key, val) { d = env.data hash_set, d, key, val env.data = d return val } ================================================ FILE: impls/yorick/hash.i ================================================ // Implement our old naive O(n) map because Yeti's hash table (h_new()) cannot // be used inside arrays and structs (we can't get a pointer to hash table). // This prevents saving pointer to environment in MalFunction for example. struct Hash { pointer keys pointer vals } func hash_new(void) { return Hash(keys=&[], vals=&[]) } func hash_get(h, key) { for (i = 1; i <= numberof(*h.keys); ++i) { if ((*h.keys)(i) == key) return *((*h.vals)(i)) } return nil } func hash_has_key(h, key) { for (i = 1; i <= numberof(*h.keys); ++i) { if ((*h.keys)(i) == key) return 1 } return 0 } func hash_set(&h, key, val) { if (is_void(*h.keys)) { h.keys = &[key] h.vals = &[&val] return } for (i = 1; i <= numberof(*h.keys); ++i) { if ((*h.keys)(i) == key) { (*h.vals)(i) = &val return } } tmp = *h.keys grow, tmp, [key] h.keys = &tmp tmp = *h.vals grow, tmp, [&val] h.vals = &tmp } func hash_delete(&h, key) { if (is_void(*h.keys) || numberof(*h.keys) == 0) return k = *h.keys v = *h.vals if (numberof(k) == 1) { if (k(1) == key) { h.keys = &[] h.vals = &[] return } } for (i = 1; i <= numberof(k); ++i) { if (k(i) == key) { if (i == 1) { h.keys = &(k(i+1:)) h.vals = &(v(i+1:)) } else if (i == numberof(k)) { h.keys = &(k(1:i-1)) h.vals = &(v(1:i-1)) } else { h.keys = &grow(k(1:i-1), k(i+1:)) h.vals = &grow(v(1:i-1), v(i+1:)) } return } } } ================================================ FILE: impls/yorick/printer.i ================================================ require, "types.i" func format_seq(val, start_char, end_char, readable) { seq = *val res = "" for (i = 1; i <= numberof(seq); ++i) { if (i > 1) res += " " res += pr_str(*seq(i), readable) } return start_char + res + end_char } func format_hashmap(h, readable) { res = "" for (i = 1; i <= numberof(*h.keys); ++i) { if (i > 1) res += " " key = hashmap_key_to_obj((*h.keys)(i)) res += pr_str(key, readable) + " " + pr_str(*((*h.vals)(i)), readable) } return "{" + res + "}" } func escape(s) { s1 = streplaceall(s, "\\", "\\\\") s2 = streplaceall(s1, "\"", "\\\"") s3 = streplaceall(s2, "\n", "\\n") return "\"" + s3 + "\"" } func pr_str(ast, readable) { type = structof(ast) if (type == MalNil) return "nil" else if (type == MalTrue) return "true" else if (type == MalFalse) return "false" else if (type == MalNumber) return totxt(ast.val) else if (type == MalSymbol) return ast.val else if (type == MalString) return readable ? escape(ast.val) : ast.val else if (type == MalKeyword) return ":" + ast.val else if (type == MalList) return format_seq(ast.val, "(", ")", readable) else if (type == MalVector) return format_seq(ast.val, "[", "]", readable) else if (type == MalHashmap) return format_hashmap(*ast.val, readable) else if (type == MalAtom) return "(atom " + pr_str(*(ast.val->val), readable) + ")" else if (type == MalNativeFunction) return "#" else if (type == MalFunction) return "#" else MalError(message=("Unknown type " + totxt(type))) } ================================================ FILE: impls/yorick/reader.i ================================================ #include "yeti_regex.i" require, "types.i" TOKENIZER_REGEXP = regcomp("[[:space:],]*(~@|[][{}()'`~@]|\"([\\].|[^\\\"])*\"?|;[^\n]*|[^][[:space:]{}()'\"`~@,;]*)") func tokenize(str) { match0 = "" match1 = "" pos = 1 tokens = [] while (1) { m = regmatch(TOKENIZER_REGEXP, str, match0, match1, start=pos, indices=1) if (m == 0) break b = match1(1) e = match1(2) - 1 if (e < b) { pos = match1(2) + 1 continue } token = strpart(str, b:e) pos = match1(2) if (strpart(token, 1:1) == ";") continue grow, tokens, [token] } return tokens } struct Reader { pointer tokens int pos } func reader_peek(rdr) { if (rdr.pos > numberof(*rdr.tokens)) return string(0) return (*rdr.tokens)(rdr.pos) } func reader_next(rdr) { token = reader_peek(rdr) rdr.pos += 1 return token } NUMBER_REGEXP = regcomp("^-?[0-9]+$") STR_REGEXP = regcomp("^\"([\\].|[^\\\"])*\"$") STR_BAD_REGEXP = regcomp("^\".*$") func unescape(s) { s = strpart(s, 2:-1) // remove surrounding quotes s = streplaceall(s, "\\\\", "\x01") s = streplaceall(s, "\\n", "\n") s = streplaceall(s, "\\\"", "\"") return streplaceall(s, "\x01", "\\") } func read_atom(rdr) { token = reader_next(rdr) if (token == "nil") return MAL_NIL else if (token == "true") return MAL_TRUE else if (token == "false") return MAL_FALSE else if (regmatch(NUMBER_REGEXP, token)) return MalNumber(val=tonum(token)) else if (regmatch(STR_REGEXP, token)) return MalString(val=unescape(token)) else if (regmatch(STR_BAD_REGEXP, token)) return MalError(message=("expected '\"', got EOF")) else if (strpart(token, 1:1) == ":") return MalKeyword(val=strpart(token, 2:)) else return MalSymbol(val=token) } func read_seq(rdr, start_char, end_char) { token = reader_next(rdr) if (token != start_char) { return MalError(message=("expected '" + start_char + "', got EOF")) } elements = [] token = reader_peek(rdr) while (token != end_char) { if (token == string(0)) { return MalError(message=("expected '" + end_char + "', got EOF")) } e = read_form(rdr) if (structof(e) == MalError) return e grow, elements, [&e] token = reader_peek(rdr) } token = reader_next(rdr) return elements } func read_list(rdr) { seq = read_seq(rdr, "(", ")") if (structof(seq) == MalError) return seq return MalList(val=&seq) } func read_vector(rdr) { seq = read_seq(rdr, "[", "]") if (structof(seq) == MalError) return seq return MalVector(val=&seq) } func read_hashmap(rdr) { seq = read_seq(rdr, "{", "}") if (structof(seq) == MalError) return seq return array_to_hashmap(seq) } func reader_macro(rdr, symbol_name) { shortcut = reader_next(rdr) form = read_form(rdr) if (structof(form) == MalError) return form seq = [&MalSymbol(val=symbol_name), &form] return MalList(val=&seq) } func reader_with_meta_macro(rdr) { shortcut = reader_next(rdr) meta = read_form(rdr) if (structof(meta) == MalError) return meta form = read_form(rdr) if (structof(form) == MalError) return form seq = [&MalSymbol(val="with-meta"), &form, &meta] return MalList(val=&seq) } func read_form(rdr) { token = reader_peek(rdr) if (token == "'") return reader_macro(rdr, "quote") else if (token == "`") return reader_macro(rdr, "quasiquote") else if (token == "~") return reader_macro(rdr, "unquote") else if (token == "~@") return reader_macro(rdr, "splice-unquote") else if (token == "@") return reader_macro(rdr, "deref") else if (token == "^") return reader_with_meta_macro(rdr) else if (token == "(") return read_list(rdr) else if (token == ")") return MalError(message="unexpected ')'") else if (token == "[") return read_vector(rdr) else if (token == "]") return MalError(message="unexpected ']'") else if (token == "{") return read_hashmap(rdr) else if (token == "}") return MalError(message="unexpected '}'") else return read_atom(rdr) } func read_str(str) { tokens = tokenize(str) rdr = Reader(tokens=&tokens, pos=1) return read_form(rdr) } ================================================ FILE: impls/yorick/run ================================================ #!/usr/bin/env bash export YORICK_MAL_PATH="$(dirname $0)" exec yorick -batch "$YORICK_MAL_PATH/${STEP:-stepA_mal}.i" "${@}" ================================================ FILE: impls/yorick/step0_repl.i ================================================ func READ(str) { return str } func EVAL(exp, env) { return exp } func PRINT(exp) { return exp } func REP(str) { return PRINT(EVAL(READ(str), "")) } func main(void) { stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) write, format="%s\n", REP(line) } write, "" } main; ================================================ FILE: impls/yorick/step1_read_print.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" func READ(str) { return read_str(str) } func EVAL(exp, env) { if (structof(exp) == MalError) return exp return exp } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func REP(str) { return PRINT(EVAL(READ(str), "")) } func main(void) { stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step2_eval.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" func READ(str) { return read_str(str) } func eval_ast(ast, env) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalList(val=&res) } func EVAL(ast, env) { // write, format="EVAL: %s\n", pr_str(ast, 1) // Process non-list types. type = structof(ast) if (type == MalSymbol) { val = h_get(env, ast.val) if (is_void(val)) return MalError(message=("'" + ast.val + "' not found")) return val } else if (type == MalList) { // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalVector(val=&res) } else if (type == MalHashmap) { h = *(ast.val) if (numberof(*h.keys) == 0) return ast res = hash_new() for (i = 1; i <= numberof(*h.keys); ++i) { new_val = EVAL(*((*h.vals)(i)), env) if (structof(new_val) == MalError) return new_val hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) } else return ast // The else branch includes MalError. Now ast is a list. if (numberof(*ast.val) == 0) return ast el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func main(void) { repl_env = h_new() h_set, repl_env, "+", MalNativeFunction(val="+") h_set, repl_env, "-", MalNativeFunction(val="-") h_set, repl_env, "*", MalNativeFunction(val="*") h_set, repl_env, "/", MalNativeFunction(val="/") stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step3_env.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func eval_ast(ast, env) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalList(val=&res) } func EVAL(ast, env) { dbgeval = structof(env_get(env, "DEBUG-EVAL")) if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { write, format="EVAL: %s\n", pr_str(ast, 1) } // Process non-list types. type = structof(ast) if (type == MalSymbol) { return env_get(env, ast.val) } else if (type == MalList) { // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalVector(val=&res) } else if (type == MalHashmap) { h = *(ast.val) if (numberof(*h.keys) == 0) return ast res = hash_new() for (i = 1; i <= numberof(*h.keys); ++i) { new_val = EVAL(*((*h.vals)(i)), env) if (structof(new_val) == MalError) return new_val hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) } else return ast // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } return EVAL(*lst(3), let_env) } else { el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func main(void) { repl_env = env_new(pointer(0)) env_set, repl_env, "+", MalNativeFunction(val="+") env_set, repl_env, "-", MalNativeFunction(val="-") env_set, repl_env, "*", MalNativeFunction(val="*") env_set, repl_env, "/", MalNativeFunction(val="/") stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step4_if_fn_do.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func eval_ast(ast, env) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalList(val=&res) } func EVAL(ast, env) { dbgeval = structof(env_get(env, "DEBUG-EVAL")) if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { write, format="EVAL: %s\n", pr_str(ast, 1) } // Process non-list types. type = structof(ast) if (type == MalSymbol) { return env_get(env, ast.val) } else if (type == MalList) { // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalVector(val=&res) } else if (type == MalHashmap) { h = *(ast.val) if (numberof(*h.keys) == 0) return ast res = hash_new() for (i = 1; i <= numberof(*h.keys); ++i) { new_val = EVAL(*((*h.vals)(i)), env) if (structof(new_val) == MalError) return new_val hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) } else return ast // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } return EVAL(*lst(3), let_env) } else if (a1 == "do") { ret = nil for (i = 2; i <= numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } return ret } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { return EVAL(*lst(4), env) } else { return MAL_NIL } } else { return EVAL(*lst(3), env) } } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } else if (structof(*seq(1)) == MalFunction) { fn = *seq(1) exprs = numberof(seq) > 1 ? seq(2:) : [] fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) return EVAL(*fn.ast, fn_env) } else { return MalError(message="Unknown function type") } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func main(void) { repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step5_tco.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func eval_ast(ast, env) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalList(val=&res) } func EVAL(ast, env) { while (1) { dbgeval = structof(env_get(env, "DEBUG-EVAL")) if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { write, format="EVAL: %s\n", pr_str(ast, 1) } // Process non-list types (todo: indent right) type = structof(ast) if (type == MalSymbol) { return env_get(env, ast.val) } else if (type == MalList) { // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalVector(val=&res) } else if (type == MalHashmap) { h = *(ast.val) if (numberof(*h.keys) == 0) return ast res = hash_new() for (i = 1; i <= numberof(*h.keys); ++i) { new_val = EVAL(*((*h.vals)(i)), env) if (structof(new_val) == MalError) return new_val hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) } else return ast // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } else if (structof(*seq(1)) == MalFunction) { fn = *seq(1) exprs = numberof(seq) > 1 ? seq(2:) : [] fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func main(void) { repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step6_file.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func eval_ast(ast, env) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalList(val=&res) } func EVAL(ast, env) { while (1) { dbgeval = structof(env_get(env, "DEBUG-EVAL")) if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { write, format="EVAL: %s\n", pr_str(ast, 1) } // Process non-list types (todo: indent right) type = structof(ast) if (type == MalSymbol) { return env_get(env, ast.val) } else if (type == MalList) { // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast res = array(pointer, numberof(seq)) for (i = 1; i <= numberof(seq); ++i) { e = EVAL(*seq(i), env) if (structof(e) == MalError) return e res(i) = &e } return MalVector(val=&res) } else if (type == MalHashmap) { h = *(ast.val) if (numberof(*h.keys) == 0) return ast res = hash_new() for (i = 1; i <= numberof(*h.keys); ++i) { new_val = EVAL(*((*h.vals)(i)), env) if (structof(new_val) == MalError) return new_val hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) } else return ast // The else branch includes MalError. Now ast is a list. lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } else if (structof(*seq(1)) == MalFunction) { fn = *seq(1) exprs = numberof(seq) > 1 ? seq(2:) : [] fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func get_command_line(void) // Force quiet mode (-q) to prevent Yorick from printing its banner { argv = get_argv() return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] } func prepare_argv_list(args) { if (numberof(args) <= 1) return MalList(val=&[]) str_lst = array(pointer, numberof(args) - 1) for (i = 2; i <= numberof(args); ++i) { str_lst(i - 1) = &MalString(val=args(i)) } return MalList(val=&str_lst) } repl_env = nil func main(void) { extern repl_env repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } command_line_args = process_argv() env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env if (numberof(command_line_args) > 0) { RE, "(load-file \"" + command_line_args(1) + "\")", repl_env return 0 } stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step7_quote.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func starts_with(seq, sym) { return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym } func quasiquote_loop(seq) { acc = MalList(val=&[]) for (i=numberof(seq); 0val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "quote") { return *lst(2) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { el = eval_ast(ast, env) if (structof(el) == MalError) return el seq = *el.val if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } else if (structof(*seq(1)) == MalFunction) { fn = *seq(1) exprs = numberof(seq) > 1 ? seq(2:) : [] fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func get_command_line(void) // Force quiet mode (-q) to prevent Yorick from printing its banner { argv = get_argv() return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] } func prepare_argv_list(args) { if (numberof(args) <= 1) return MalList(val=&[]) str_lst = array(pointer, numberof(args) - 1) for (i = 2; i <= numberof(args); ++i) { str_lst(i - 1) = &MalString(val=args(i)) } return MalList(val=&str_lst) } repl_env = nil func main(void) { extern repl_env repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } command_line_args = process_argv() env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env if (numberof(command_line_args) > 0) { RE, "(load-file \"" + command_line_args(1) + "\")", repl_env return 0 } stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step8_macros.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func starts_with(seq, sym) { return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym } func quasiquote_loop(seq) { acc = MalList(val=&[]) for (i=numberof(seq); 0val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "quote") { return *lst(2) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value new_value.macro = 1 return env_set(env, lst(2)->val, new_value) } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } else { fn = EVAL(*lst(1), env) if (structof(fn) == MalError) return fn if (is_macro(fn)) { if (numberof(lst) == 1) { args = [] } else { args = lst(2:) } fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = EVAL(*fn.ast, fn_env) continue // TCO } // Evaluate arguments if (numberof(lst) == 1) { args = [] } else { args = array(pointer, numberof(lst) - 1) for (i = 1; i <= numberof(args); ++i) { e = EVAL(*lst(1+i), env) if (structof(e) == MalError) return e args(i) = &e } } // Apply if (structof(fn) == MalNativeFunction) { return call_core_fn(fn.val, args) } else if (structof(fn) == MalFunction) { fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func get_command_line(void) // Force quiet mode (-q) to prevent Yorick from printing its banner { argv = get_argv() return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] } func prepare_argv_list(args) { if (numberof(args) <= 1) return MalList(val=&[]) str_lst = array(pointer, numberof(args) - 1) for (i = 2; i <= numberof(args); ++i) { str_lst(i - 1) = &MalString(val=args(i)) } return MalList(val=&str_lst) } repl_env = nil func main(void) { extern repl_env repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } command_line_args = process_argv() env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env if (numberof(command_line_args) > 0) { RE, "(load-file \"" + command_line_args(1) + "\")", repl_env return 0 } stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) write, format="Error: %s\n", result.message else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/step9_try.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func starts_with(seq, sym) { return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym } func quasiquote_loop(seq) { acc = MalList(val=&[]) for (i=numberof(seq); 0val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "quote") { return *lst(2) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value new_value.macro = 1 return env_set(env, lst(2)->val, new_value) } else if (a1 == "try*") { ret = EVAL(*lst(2), env) if (structof(ret) == MalError && numberof(lst) > 2) { exc = *ret.obj if (is_void(exc)) { exc = MalString(val=ret.message) } catch_lst = *(lst(3)->val) catch_env = env_new(&env) env_set, catch_env, catch_lst(2)->val, exc return EVAL(*catch_lst(3), catch_env) } else { return ret } } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } else { fn = EVAL(*lst(1), env) if (structof(fn) == MalError) return fn if (is_macro(fn)) { if (numberof(lst) == 1) { args = [] } else { args = lst(2:) } fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = EVAL(*fn.ast, fn_env) continue // TCO } // Evaluate arguments if (numberof(lst) == 1) { args = [] } else { args = array(pointer, numberof(lst) - 1) for (i = 1; i <= numberof(args); ++i) { e = EVAL(*lst(1+i), env) if (structof(e) == MalError) return e args(i) = &e } } // Apply if (structof(fn) == MalNativeFunction) { return call_core_fn(fn.val, args) } else if (structof(fn) == MalFunction) { fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func get_command_line(void) // Force quiet mode (-q) to prevent Yorick from printing its banner { argv = get_argv() return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] } func prepare_argv_list(args) { if (numberof(args) <= 1) return MalList(val=&[]) str_lst = array(pointer, numberof(args) - 1) for (i = 2; i <= numberof(args); ++i) { str_lst(i - 1) = &MalString(val=args(i)) } return MalList(val=&str_lst) } repl_env = nil func main(void) { extern repl_env repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } command_line_args = process_argv() env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) // core.mal: defined using the language itself RE, "(def! not (fn* (a) (if a false true)))", repl_env RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env if (numberof(command_line_args) > 0) { RE, "(load-file \"" + command_line_args(1) + "\")", repl_env return 0 } stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) { exc = *result.obj if (is_void(exc)) { write, format="Error: %s\n", result.message } else { write, format="Error: %s\n", pr_str(exc, 1) } } else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/stepA_mal.i ================================================ set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() require, "reader.i" require, "printer.i" require, "core.i" require, "env.i" func READ(str) { return read_str(str) } func starts_with(seq, sym) { return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym } func quasiquote_loop(seq) { acc = MalList(val=&[]) for (i=numberof(seq); 0val if (a1 == "def!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value return env_set(env, lst(2)->val, new_value) } else if (a1 == "let*") { let_env = env_new(&env) args_lst = *(lst(2)->val) for (i = 1; i <= numberof(args_lst); i += 2) { var_name = args_lst(i)->val var_value = EVAL(*args_lst(i + 1), let_env) if (structof(var_value) == MalError) return var_value env_set, let_env, var_name, var_value } ast = *lst(3) env = let_env // TCO } else if (a1 == "quote") { return *lst(2) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { new_value = EVAL(*lst(3), env) if (structof(new_value) == MalError) return new_value new_value.macro = 1 return env_set(env, lst(2)->val, new_value) } else if (a1 == "try*") { ret = EVAL(*lst(2), env) if (structof(ret) == MalError && numberof(lst) > 2) { exc = *ret.obj if (is_void(exc)) { exc = MalString(val=ret.message) } catch_lst = *(lst(3)->val) catch_env = env_new(&env) env_set, catch_env, catch_lst(2)->val, exc return EVAL(*catch_lst(3), catch_env) } else { return ret } } else if (a1 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) if (structof(ret) == MalError) return ret } ast = *lst(numberof(lst)) // TCO } else if (a1 == "if") { cond_val = EVAL(*lst(2), env) if (structof(cond_val) == MalError) return cond_val if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { if (numberof(lst) > 3) { ast = *lst(4) } else { return MAL_NIL } } else { ast = *lst(3) } // TCO } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } else { fn = EVAL(*lst(1), env) if (structof(fn) == MalError) return fn if (is_macro(fn)) { if (numberof(lst) == 1) { args = [] } else { args = lst(2:) } fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = EVAL(*fn.ast, fn_env) continue // TCO } // Evaluate arguments if (numberof(lst) == 1) { args = [] } else { args = array(pointer, numberof(lst) - 1) for (i = 1; i <= numberof(args); ++i) { e = EVAL(*lst(1+i), env) if (structof(e) == MalError) return e args(i) = &e } } // Apply if (structof(fn) == MalNativeFunction) { return call_core_fn(fn.val, args) } else if (structof(fn) == MalFunction) { fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = *fn.ast env = fn_env // TCO } else { return MalError(message="Unknown function type") } } } } func PRINT(exp) { if (structof(exp) == MalError) return exp return pr_str(exp, 1) } func RE(str, env) { return EVAL(READ(str), env) } func REP(str, env) { return PRINT(EVAL(READ(str), env)) } func get_command_line(void) // Force quiet mode (-q) to prevent Yorick from printing its banner { argv = get_argv() return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] } func prepare_argv_list(args) { if (numberof(args) <= 1) return MalList(val=&[]) str_lst = array(pointer, numberof(args) - 1) for (i = 2; i <= numberof(args); ++i) { str_lst(i - 1) = &MalString(val=args(i)) } return MalList(val=&str_lst) } repl_env = nil func main(void) { extern repl_env repl_env = env_new(pointer(0)) // core.i: defined using Yorick core_symbols = h_keys(core_ns) for (i = 1; i <= numberof(core_symbols); ++i) { env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) } command_line_args = process_argv() env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) // core.mal: defined using the language itself RE, "(def! *host-language* \"yorick\")", repl_env RE, "(def! not (fn* (a) (if a false true)))", repl_env RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))", repl_env RE, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env if (numberof(command_line_args) > 0) { RE, "(load-file \"" + command_line_args(1) + "\")", repl_env return 0 } RE, "(println (str \"Mal [\" *host-language* \"]\"))", repl_env stdin_file = open("/dev/stdin", "r") while (1) { write, format="%s", "user> " line = rdline(stdin_file, prompt="") if (!line) break if (strlen(line) > 0) { result = REP(line, repl_env) if (structof(result) == MalError) { exc = *result.obj if (is_void(exc)) { write, format="Error: %s\n", result.message } else { write, format="Error: %s\n", pr_str(exc, 1) } } else write, format="%s\n", result } } write, "" } main; ================================================ FILE: impls/yorick/tests/stepA_mal.mal ================================================ ;; Testing basic Yorick interop (yorick-eval "7") ;=>7 (yorick-eval "\"7\" + \"89\"") ;=>"789" (yorick-eval "123 == 123") ;=>1 (yorick-eval "123 == 456") ;=>0 (yorick-eval "[7, 8, 9]") ;=>(7 8 9) (yorick-eval "write, format=\"%s-%d\\x0A\", \"hello\", 1234; return nil;") ;/hello-1234 ;=>nil (yorick-eval "extern my_global_var; my_global_var = 8; return nil;") (yorick-eval "my_global_var") ;=>8 (yorick-eval "a = [7, 8, 9]; return a + 10;") ;=>(17 18 19) (yorick-eval "[\"ab\", \"cd\", \"ef\"] + [\"X\", \"Y\", \"Z\"]") ;=>("abX" "cdY" "efZ") (yorick-eval "strpart(\"ABCDEFGHIJ\", 4:7)") ;=>"DEFG" ================================================ FILE: impls/yorick/types.i ================================================ require, "hash.i" struct MalError { string message pointer obj } struct MalNil { int val } MAL_NIL = MalNil() struct MalTrue { int val } MAL_TRUE = MalTrue() struct MalFalse { int val } MAL_FALSE = MalFalse() struct MalNumber { int val } func new_number(s) { return MalNumber(val=atoi(s)) } struct MalSymbol { string val pointer meta } struct MalString { string val pointer meta } struct MalKeyword { string val pointer meta } struct MalList { pointer val pointer meta } struct MalVector { pointer val pointer meta } func count(obj) { return numberof(*obj.val); } func rest(obj) { seq = count(obj) <= 1 ? [] : ((*obj.val)(2:)) return MalList(val=&seq) } struct MalHashmap { pointer val pointer meta } func hashmap_obj_to_key(obj) { if (structof(obj) == MalString) return "str:" + obj.val else if (structof(obj) == MalSymbol) return "sym:" + obj.val else if (structof(obj) == MalKeyword) return "key:" + obj.val else error, "Unsupported obj type for hash key" } func hashmap_key_to_obj(key) { type_str = strpart(key, 1:4) val = strpart(key, 5:) if (type_str == "str:") return MalString(val=val) else if (type_str == "sym:") return MalSymbol(val=val) else if (type_str == "key:") return MalKeyword(val=val) else error, "Unsupported key type" } func array_to_hashmap(seq) { if (numberof(seq) % 2 != 0) return MalError(message="Odd number of elements in hashmap") h = hash_new() for (i = 1; i <= numberof(seq); i += 2) { hash_set, h, hashmap_obj_to_key(*seq(i)), *seq(i + 1) } return MalHashmap(val=&h) } struct MalNativeFunction { string val pointer meta } struct MalFunction { pointer env pointer binds pointer ast int macro pointer meta } struct MalAtom { pointer val pointer meta } func is_macro(obj) { return (structof(obj) == MalFunction && obj.macro); } struct MalAtomVal { pointer val } func new_boolean(b) { if (b) return MAL_TRUE return MAL_FALSE } func equal_seq(seq_a, seq_b) { if (numberof(seq_a) != numberof(seq_b)) return 0 for (i = 1; i <= numberof(seq_a); ++i) { if (!equal(*seq_a(i), *seq_b(i))) return 0 } return 1 } func equal_hash(hm_a, hm_b) { if (numberof(*hm_a.keys) != numberof(*hm_b.keys)) return 0 for (i = 1; i <= numberof(*hm_a.keys); ++i) { key_a = (*hm_a.keys)(i) val_a = *((*hm_a.vals)(i)) val_b = hash_get(hm_b, key_a) if (is_void(val_b) || !equal(val_a, val_b)) return 0 } return 1 } func equal(a, b) { ta = structof(a) tb = structof(b) if (ta == MalNil) return tb == MalNil else if (ta == MalTrue) return tb == MalTrue else if (ta == MalFalse) return tb == MalFalse else if (ta == MalNumber) return tb == MalNumber && a.val == b.val else if (ta == MalSymbol) return tb == MalSymbol && a.val == b.val else if (ta == MalString) return tb == MalString && a.val == b.val else if (ta == MalKeyword) return tb == MalKeyword && a.val == b.val else if (ta == MalList || ta == MalVector) { return (tb == MalList || tb == MalVector) && equal_seq(*(a.val), *(b.val)) } else if (ta == MalHashmap) return tb == MalHashmap && equal_hash(*a.val, *b.val) else return 0 } func streplaceall(s, pattern, subst) { return streplace(s, strfind(pattern, s, n=999), subst) } ================================================ FILE: impls/zig/Dockerfile ================================================ FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## # General requirements for testing or common across many # implementations ########################################################## RUN apt-get -y update # Required for running tests RUN apt-get -y install make python3 RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal ########################################################## # Specific implementation requirements ########################################################## RUN apt-get -y install ca-certificates curl gcc libc6-dev libpcre3-dev libreadline-dev xz-utils RUN curl https://ziglang.org/download/0.13.0/zig-linux-x86_64-0.13.0.tar.xz | tar -xJC/opt RUN ln -fst/usr/local/bin /opt/zig-linux-x86_64-0.13.0/zig ENV HOME /mal ================================================ FILE: impls/zig/Makefile ================================================ STEPS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try stepA_mal all: $(STEPS) zig_opts += --release=safe zig_opts += -Doptimize=Debug $(STEPS): zig build $(zig_opts) -Dname=$@ -Droot_source_file=$@.zig .PHONY: all $(STEPS) clean clean: rm -fr .zig-cache/ zig-out/ rm -f *~ ================================================ FILE: impls/zig/README ================================================ debug_alloc in types.zig may help with reference counting. TODO Simplify the printer with the new reader functions in the zig library. NOTE Before implementing any optimization or optional fix that would increase the complexity, please take into account that someone has to maintain the code, and the zig language evolves quickly. Some memory leaks are probably already present, especially when an error interrupts the normal execution flow. Examples of things that are deliberately not implemented... * TCO for try* * preallocate integers between 0 and 100 at startup * use ArrayList.ensureTotalCapacityPrecise/HashMap.ensureTotalCapacity after most calls to new_list/vector/map. * store symbols in a global hash map, * implement lists/vectors as slices/cons cells/whatever * deallocate cyclic structures not detected by reference counting like (let* (f (fn* () nil))) (def! a (atom 2)) (def! v [a]) (reset! a v) ================================================ FILE: impls/zig/build.zig ================================================ const Builder = @import("std").Build; pub fn build(b: *Builder) void { // Two options select the built step. const name = b.option([]const u8, "name", "step name (without .zig)") orelse "stepA_mal"; const root_source_file = b.path( b.option([]const u8, "root_source_file", "step name (with .zig)") orelse "stepA_mal.zig"); const exe = b.addExecutable(.{ .name = name, .root_source_file = root_source_file, .target = b.standardTargetOptions(.{}), .optimize = b.standardOptimizeOption(.{}), }); exe.linkSystemLibrary("c"); exe.linkSystemLibrary("pcre"); exe.linkSystemLibrary("readline"); b.default_step.dependOn(&exe.step); b.installArtifact(exe); } ================================================ FILE: impls/zig/core.zig ================================================ const std = @import("std"); const Allocator = std.heap.c_allocator; const MalType = @import("types.zig").MalType; const printer = @import("printer.zig"); const reader = @import("reader.zig"); const getline_prompt = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const MalError = @import("error.zig").MalError; const hmap = @import("hmap.zig"); const MalLinkedList = @import("linked_list.zig").MalLinkedList; const MalHashMap = @import("hmap.zig").MalHashMap; // Set by the step file at startup. pub var apply_function: *const fn(f: MalType, args: []*MalType) MalError!*MalType = undefined; const safeAdd = @import("std").math.add; const safeSub = @import("std").math.sub; const safeMul = @import("std").math.mul; const safeDivFloor = @import("std").math.divFloor; const stdout_file = std.io.getStdOut(); const throw = @import("error.zig").throw; fn int_plus(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeAdd(i64, x, y); return MalType.new_int(res); } fn int_minus(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeSub(i64, x, y); return MalType.new_int(res); } fn int_mult(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeMul(i64, x, y); return MalType.new_int(res); } fn int_div(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeDivFloor(i64, x, y); return MalType.new_int(res); } fn int_lt(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; return MalType.new_bool((try a1.as_int()) < (try a2.as_int())); } fn int_leq(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; return MalType.new_bool((try a1.as_int()) <= (try a2.as_int())); } fn int_gt(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; return MalType.new_bool((try a1.as_int()) > (try a2.as_int())); } fn int_geq(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; return MalType.new_bool((try a1.as_int()) >= (try a2.as_int())); } fn _linked_list_equality(l1: []const *MalType, l2:[]const *MalType) bool { if(l1.len != l2.len) return false; for(l1, l2) |m1, m2| { if(! _equality(m1.*, m2.*)) { return false; } } return true; } fn _hashmap_equality(h1: MalHashMap, h2: MalHashMap) bool { if(h1.count() != h2.count()) { return false; } var iterator = h1.iterator(); while(iterator.next()) |pair| { const optional_val = h2.get(pair.key_ptr.*); if(optional_val) |val| { const el_cmp = _equality(pair.value_ptr.*.*, val.*); if(! el_cmp) { return false; } } else { return false; } } return true; } fn equality(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; return MalType.new_bool(_equality(a1.*, a2.*)); } fn _equality(a1: MalType, a2: MalType) bool { switch(a1) { .Nil => { switch(a2) { .Nil => return true, else => return false, } }, .False => { switch(a2) { .False => return true, else => return false, } }, .True => { switch(a2) { .True => return true, else => return false, } }, .Int => |l1| { switch(a2) { .Int => |l2| return l1.data == l2.data, else => return false, } }, .String => |s1| { switch(a2) { .String => |s2| return string_eql(s1.data, s2.data), else => return false, } }, .Symbol => |s1| { switch(a2) { .Symbol => |s2| return string_eql(s1.data, s2.data), else => return false, } }, .Keyword => |s1| { switch(a2) { .Keyword => |s2| return string_eql(s1.data, s2.data), else => return false, } }, .List, .Vector => |l1| { switch(a2) { .List, .Vector => |l2| return _linked_list_equality( l1.data.items, l2.data.items), else => return false, } }, .HashMap => |h1| { switch(a2) { .HashMap => |h2| return _hashmap_equality(h1.data, h2.data), else => return false, } }, else => { return false; }, } } fn list(args: []*MalType) !*MalType { const new_mal = try MalType.new_list(); errdefer new_mal.decref(); for(args) |x| { try new_mal.List.data.append(Allocator, x); x.incref(); } return new_mal; } fn vector(args: []*MalType) !*MalType { const new_mal = try MalType.new_vector(); errdefer new_mal.decref(); for(args) |x| { try new_mal.Vector.data.append(Allocator, x); x.incref(); } return new_mal; } fn map(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const func_mal = args[0]; const args_mal = args[1]; var to_map_ll = try args_mal.as_slice(); const new_list = try MalType.new_list(); errdefer new_list.decref(); for(0..to_map_ll.len) |i| { const new_mal = try apply_function(func_mal.*, to_map_ll[i..i+1]); try new_list.List.data.append(Allocator, new_mal); } return new_list; } fn is_list(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .List => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_vector(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .Vector => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_string(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .String => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_number(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .Int => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_fn(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const is_function = switch(a1.*) { .FnCore => true, .Func => |func_data| ! func_data.is_macro, else => false, }; return MalType.new_bool(is_function); } fn is_macro(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const is_func_and_macro = switch(a1.*) { .Func => |data| data.is_macro, else => false, }; return MalType.new_bool(is_func_and_macro); } fn empty(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const slice = try a1.as_slice(); return MalType.new_bool(slice.len == 0); } fn prn(args: []*MalType) MalError!*MalType { try printer.n_stdout(args, true, true); try stdout_file.writeAll("\n"); const mal = &MalType.NIL; return mal; } fn println(args: []*MalType) !*MalType { try printer.n_stdout(args, false, true); try stdout_file.writeAll("\n"); const mal = &MalType.NIL; return mal; } fn str(args: []*MalType) !*MalType { const items = try printer.print_mal_to_string(args, false, false); errdefer Allocator.free(items); return MalType.new_string(items, false); } fn pr_str(args: []*MalType) !*MalType { const s = try printer.print_mal_to_string(args, true, true); errdefer Allocator.free(s); return MalType.new_string(s, false); } fn slurp(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const path = try a1.as_string(); const dir = std.fs.cwd(); const items = try dir.readFileAlloc(Allocator, path, 10000); return MalType.new_string(items, false); } fn atom(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const result = try MalType.new_atom(a1); a1.incref(); return result; } fn is_atom(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; return switch(args[0].*) { .Atom => &MalType.TRUE, else => &MalType.FALSE, }; } fn deref(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; switch(a1.*) { .Atom => |atom_val| { atom_val.data.incref(); return atom_val.data; }, else => return MalError.TypeError, } } fn atom_reset(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; switch(a1.*) { .Atom => |*atom_val| { atom_val.data.decref(); atom_val.data = a2; // incref for the atom and for the result a2.incref(); a2.incref(); return a2; }, else => return MalError.TypeError, } } fn atom_swap(args: []*MalType) !*MalType { const n = args.len; if(n < 2) return MalError.ArgError; const atom_val = switch(args[0].*) { .Atom => |*a| a, else => return MalError.TypeError, }; var new_args = try Allocator.alloc(*MalType, args.len - 1); defer Allocator.free(new_args); var i:usize = 0; new_args[i] = atom_val.data; i+=1; for(args[2..args.len]) |x| { new_args[i] = x; i += 1; } std.debug.assert(i == new_args.len); const new_mal = try apply_function(args[1].*, new_args); atom_val.data.decref(); // after the computation atom_val.data = new_mal; new_mal.incref(); return new_mal; } fn vec(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; switch(a1.*) { .List => |l| { const result = try MalType.new_vector(); errdefer result.decref(); for(l.data.items) |x| { try result.Vector.data.append(Allocator, x); x.incref(); } return result; }, .Vector => { a1.incref(); return a1; }, else => return MalError.TypeError, } } fn cons(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const old_ll = try a2.as_slice(); const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, a1); a1.incref(); for(old_ll) |x| { try new_list.List.data.append(Allocator, x); x.incref(); } return new_list; } pub fn concat(args: []*MalType) !*MalType { const new_mal = try MalType.new_list(); errdefer new_mal.decref(); for(args) |x| { for(try x.as_slice()) |y| { try new_mal.List.data.append(Allocator, y); y.incref(); } } return new_mal; } fn rest(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const new_mal = try MalType.new_list(); errdefer new_mal.decref(); switch(a1.*) { .List, .Vector => |l| { const old_list = l.data.items; if(old_list.len != 0) { for(l.data.items[1..]) |x| { try new_mal.List.data.append(Allocator, x); x.incref(); } } }, .Nil => { }, else => return MalError.TypeError, } return new_mal; } fn nth(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const l = try a1.as_slice(); const i = try a2.as_int(); const pos: usize = @intCast(i); if(pos < 0 or l.len <= pos) { return MalError.OutOfBounds; } const result = l[pos]; result.incref(); return result; } fn first(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; switch(a1.*) { .List, .Vector => |l| { if(l.data.items.len == 0) return &MalType.NIL; const result = l.data.items[0]; result.incref(); return result; }, .Nil => return &MalType.NIL, else => return MalError.TypeError, } } fn is_nil(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .Nil => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_true(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .True => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_false(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .False => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_symbol(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .Symbol => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_keyword(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .Keyword => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_map(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .HashMap => &MalType.TRUE, else => &MalType.FALSE, }; } fn is_sequential(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return switch(a1.*) { .List, .Vector => &MalType.TRUE, else => &MalType.FALSE, }; } fn symbol(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const string = try a1.as_string(); return MalType.new_symbol(string, true); } pub fn hash_map(args: []*MalType) !*MalType { const new_mal = try MalType.new_hashmap(); errdefer new_mal.decref(); try hmap.map_insert_from_kvs(&new_mal.HashMap.data, args); return new_mal; } pub fn hash_map_assoc(args: []*MalType) !*MalType { if(args.len < 1) return MalError.ArgError; const a1 = args[0]; const new_mal = try MalType.new_hashmap(); errdefer new_mal.decref(); const base_hmap = try a1.as_map(); try hmap.map_insert_from_map(&new_mal.HashMap.data, base_hmap); try hmap.map_insert_from_kvs(&new_mal.HashMap.data, args[1..]); return new_mal; } pub fn hash_map_dissoc(args: []*MalType) !*MalType { if(args.len < 1) return MalError.ArgError; const a1 = args[0]; const new_mal = try MalType.new_hashmap(); errdefer new_mal.decref(); const base_hmap = try a1.as_map(); try hmap.map_insert_from_map(&new_mal.HashMap.data, base_hmap); for(args[1..]) |k| { switch(k.*) { .Keyword, .String => { if(new_mal.HashMap.data.fetchRemove(k)) |old| { old.key.decref(); old.value.decref(); } }, else => return MalError.TypeError, } } return new_mal; } fn hash_map_get(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const hm = switch(a1.*) { .HashMap => |m| m.data, .Nil => return &MalType.NIL, else => return MalError.TypeError, }; switch(a2.*) { .Keyword, .String => {}, else => return MalError.TypeError, } if(hm.get(a2)) |value| { value.incref(); return value; } return &MalType.NIL; } fn hash_map_contains(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; switch(a2.*) { .Keyword, .String => { const hm = try a1.as_map(); return MalType.new_bool(hm.contains(a2)); }, else => return MalError.TypeError, } } fn hash_map_keys(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const hm = try a1.as_map(); const new_mal = try MalType.new_list(); errdefer new_mal.decref(); var iterator = hm.keyIterator(); while(iterator.next()) |key_mal| { try new_mal.List.data.append(Allocator, key_mal.*); key_mal.*.incref(); } return new_mal; } fn hash_map_vals(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const hm = try a1.as_map(); const new_mal = try MalType.new_list(); errdefer new_mal.decref(); var iterator = hm.valueIterator(); while(iterator.next()) |val| { try new_mal.List.data.append(Allocator, val.*); val.*.incref(); } return new_mal; } fn sequence_length(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const len = switch(a1.*) { .List, .Vector => |l| l.data.items.len, .String => |s| s.data.len, .Nil => 0, else => return MalError.TypeError, }; return MalType.new_int(@intCast(len)); } fn keyword(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; switch(a1.*) { .String => |s| { return MalType.new_keyword(s.data, true); }, .Keyword => { a1.incref(); return a1; }, else => return MalError.TypeError, } } fn core_readline(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const prompt = try a1.as_string(); const optional_read_line = try getline_prompt(prompt); if(optional_read_line) |read_line| { return MalType.new_string(read_line, false); } return &MalType.NIL; } fn time_ms(args: []*MalType) !*MalType { if(args.len != 0) return MalError.ArgError; const itime = std.time.milliTimestamp(); return try MalType.new_int(@intCast(itime)); } fn meta(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const result = switch(a1.*) { .List, .Vector => |l| l.metadata, .FnCore => |l| l.metadata, .Func => |l| l.metadata, .HashMap => |l| l.metadata, else => return MalError.TypeError, }; result.incref(); return result; } fn with_meta(args: []*MalType) !*MalType { if(args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; switch(a1.*) { .List => |l| { const new_mal = try MalType.new_list(); errdefer new_mal.decref(); for(l.data.items) |x| { try new_mal.List.data.append(Allocator, x); x.incref(); } new_mal.List.metadata = a2; a2.incref(); return new_mal; }, .Vector => |l| { const new_mal = try MalType.new_vector(); errdefer new_mal.decref(); for(l.data.items) |x| { try new_mal.Vector.data.append(Allocator, x); x.incref(); } new_mal.Vector.metadata = a2; a2.incref(); return new_mal; }, .FnCore => |l| { const new_mal = try MalType.newFnCore(l.data); new_mal.FnCore.metadata = a2; a2.incref(); return new_mal; }, .Func => |l| { const new_mal = try MalType.newFunc(l.arg_list, l.body, l.environment); l.arg_list.incref(); l.body.incref(); l.environment.incref(); new_mal.Func.metadata = a2; a2.incref(); return new_mal; }, .HashMap => |l| { const new_mal = try MalType.new_hashmap(); errdefer new_mal.decref(); try hmap.map_insert_from_map(&new_mal.HashMap.data, l.data); new_mal.HashMap.metadata = a2; a2.incref(); return new_mal; }, else => return MalError.TypeError, } } fn seq(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; switch(a1.*) { .List => |l| { if(l.data.items.len == 0) return &MalType.NIL; a1.incref(); return a1; }, .Vector => |l| { if(l.data.items.len == 0) return &MalType.NIL; const mal_copy = try MalType.new_list(); errdefer mal_copy.decref(); for(l.data.items) |x| { try mal_copy.List.data.append(Allocator, x); x.incref(); } return mal_copy; }, .String => |s| { if(s.data.len == 0) return &MalType.NIL; const new_list = try MalType.new_list(); errdefer new_list.decref(); for(s.data) |x| { const one_char = try Allocator.alloc(u8, 1); one_char[0] = x; const new_char = try MalType.new_string(one_char, false); errdefer new_char.decref(); try new_list.List.data.append(Allocator, new_char); } return new_list; }, .Nil => { return &MalType.NIL; }, else => { return MalError.TypeError; } } } pub fn conj(args: []*MalType) !*MalType { if(args.len == 0) return MalError.ArgError; const container = args[0]; switch(container.*) { .List => |l| { const return_mal = try MalType.new_list(); errdefer return_mal.decref(); for(1..args.len) |j| { const new_item = args[args.len-j]; try return_mal.List.data.append(Allocator, new_item); new_item.incref(); } for(l.data.items) |x| { try return_mal.List.data.append(Allocator, x); x.incref(); } return return_mal; }, .Vector => |l|{ const return_mal = try MalType.new_vector(); errdefer return_mal.decref(); for(l.data.items) |x| { try return_mal.Vector.data.append(Allocator, x); x.incref(); } for(args[1..]) |x| { try return_mal.Vector.data.append(Allocator, x); x.incref(); } return return_mal; }, else => return MalError.ArgError, } } fn read_string(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; const str_to_eval = try a1.as_string(); var read = try reader.read_str(str_to_eval); return reader.read_form(&read); } pub fn do_apply(args: []*MalType) !*MalType { if(args.len < 2) return MalError.ArgError; const a1 = args[0]; const last = args[args.len - 1]; const more_args = try last.as_slice(); var fargs = try Allocator.alloc(*MalType, args.len + more_args.len - 2); defer Allocator.free(fargs); var i:usize = 0; for(args[1..args.len-1]) |x| { fargs[i] = x; i+=1; } for(more_args) |x| { fargs[i] = x; i+=1; } std.debug.assert(i == fargs.len); return apply_function(a1.*, fargs); } pub fn core_throw(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return throw(a1); } pub const CorePair = struct { name: []const u8, func: *const fn(args: []*MalType) MalError!*MalType, }; pub const core_namespace = [_]CorePair { .{ .name = "+", .func = &int_plus }, .{ .name = "-", .func = &int_minus }, .{ .name = "*", .func = &int_mult }, .{ .name = "/", .func = &int_div }, .{ .name = "<", .func = &int_lt }, .{ .name = "<=", .func = &int_leq }, .{ .name = ">", .func = &int_gt }, .{ .name = ">=", .func = &int_geq }, .{ .name = "=", .func = &equality }, .{ .name = "list?", .func = &is_list }, .{ .name = "vector?", .func = &is_vector }, .{ .name = "count", .func = &sequence_length }, .{ .name = "list", .func = &list, }, .{ .name = "vector", .func = &vector, }, .{ .name = "map", .func = &map }, .{ .name = "empty?", .func = &empty }, .{ .name = "prn", .func = &prn }, .{ .name = "println", .func = &println }, .{ .name = "pr-str", .func = &pr_str }, .{ .name = "str", .func = &str }, .{ .name = "slurp", .func = &slurp }, .{ .name = "atom", .func = &atom }, .{ .name = "atom?", .func = &is_atom }, .{ .name = "deref", .func = &deref }, .{ .name = "reset!", .func = &atom_reset }, .{ .name = "swap!", .func = &atom_swap }, .{ .name = "vec", .func = &vec }, .{ .name = "cons", .func = &cons }, .{ .name = "concat", .func = &concat }, .{ .name = "rest", .func = &rest }, .{ .name = "nth", .func = &nth }, .{ .name = "first", .func = &first }, .{ .name = "nil?", .func = &is_nil }, .{ .name = "true?", .func = &is_true }, .{ .name = "false?", .func = &is_false }, .{ .name = "symbol", .func = &symbol }, .{ .name = "symbol?", .func = &is_symbol }, .{ .name = "keyword?", .func = &is_keyword }, .{ .name = "map?", .func = &is_map }, .{ .name = "sequential?", .func = &is_sequential }, .{ .name = "apply", .func = &do_apply }, .{ .name = "hash-map", .func = &hash_map }, .{ .name = "assoc", .func = &hash_map_assoc }, .{ .name = "dissoc", .func = &hash_map_dissoc }, .{ .name = "get", .func = &hash_map_get }, .{ .name = "contains?", .func = &hash_map_contains }, .{ .name = "keys", .func = &hash_map_keys }, .{ .name = "vals", .func = &hash_map_vals }, .{ .name = "keyword", .func = &keyword }, .{ .name = "read-string", .func = &read_string }, .{ .name = "readline", .func = &core_readline }, .{ .name = "time-ms", .func = &time_ms }, .{ .name = "meta", .func = &meta }, .{ .name = "with-meta", .func = &with_meta }, .{ .name = "fn?", .func = &is_fn }, .{ .name = "string?", .func = &is_string }, .{ .name = "number?", .func = &is_number }, .{ .name = "macro?", .func = &is_macro }, .{ .name = "seq", .func = &seq }, .{ .name = "conj", .func = &conj }, .{ .name = "throw", .func = &core_throw }, }; ================================================ FILE: impls/zig/env.zig ================================================ const std = @import("std"); const warn = std.log.warn; const allocator = std.heap.c_allocator; const MalType = @import("types.zig").MalType; const MalHashMap = @import("hmap.zig").MalHashMap; const MalError = @import("error.zig").MalError; const hash_map = @import("hmap.zig"); const debug_alloc = @import("types.zig").debug_alloc; pub const Env = struct { outer: ?*Env, data: MalHashMap, refcount: i32 = 1, pub fn new_root() Env { return .{.outer = null, .data = .{}}; } pub fn new(outer: *Env) !*Env { // The caller is in charge of incremeting the reference count // for outer if necessary. const env = try allocator.create(Env); env.* = .{ .outer = outer, .data = .{} }; if(debug_alloc) warn("Env: new {any}", .{env}); return env; } pub fn incref(env: *Env) void { if(debug_alloc) { warn("Env: incref {any}", .{env}); } env.refcount += 1; // std.debug.assert(env.refcount < 100); } pub fn decref(env: *Env) void { var e = env; while (true) { if(debug_alloc) { warn("Env: decref {any}", .{e}); e.print_keys(); } std.debug.assert (0 < e.refcount); e.refcount -= 1; if(0 < e.refcount) { break; } if(debug_alloc) { warn("Env: FREE {any}", .{e}); } const old = e; if(e.outer) |outer| { e = outer; } else { warn("INTERNAL ERROR: repl-env should never reach a 0 refcount.", .{}); break; } hash_map.map_destroy(&old.data); allocator.destroy(old); } } // Incref both the key and value. pub fn set(env: *Env, key: *MalType, value: *MalType) !void { // The caller is in charge of incremeting the reference count // for the value if necessary. switch (key.*) { .Symbol => { if(debug_alloc) { warn("Env: set {s} {any}", .{key.Symbol.data, key}); } try hash_map.map_insert_incref_key(&env.data, key, value); }, else => return MalError.ArgError, } } pub fn get(env: Env, key: *MalType) !?*MalType { // The result is not increfed(). switch (key.*) { .Symbol => { if(debug_alloc) { warn("Env: get {s} {any}", .{key.Symbol.data, key}); } var e: * const Env = &env; while(true) { if(e.data.get(key)) |value| { return value; } e = e.outer orelse return null; } }, else => return MalError.KeyError, } } pub fn print_keys(env: Env) void { var it = env.data.keyIterator(); var count: i32 = 5; while (it.next()) |key| { warn(" key={s},", .{key.*.Symbol.data}); count -= 1; if(count <= 0) { warn(" ...", .{}); break; } } } }; ================================================ FILE: impls/zig/error.zig ================================================ const assert = @import("std").debug.assert; const MalType = @import("types.zig").MalType; pub const MalError = error { SystemError, ApplyError, KeyError, ThrownError, TypeError, ArgError, Overflow, DivisionByZero, OutOfBounds, OutOfMemory, InvalidCharacter, DiskQuota, FileTooBig, InputOutput, NoSpaceLeft, DeviceBusy, InvalidArgument, AccessDenied, BrokenPipe, SystemResources, OperationAborted, NotOpenForWriting, LockViolation, WouldBlock, ConnectionResetByPeer, Unexpected, InvalidUtf8, SharingViolation, PathAlreadyExists, FileNotFound, PipeBusy, NameTooLong, InvalidWtf8, BadPathName, NetworkNotFound, AntivirusInterference, SymLinkLoop, ProcessFdQuotaExceeded, SystemFdQuotaExceeded, NoDevice, IsDir, NotDir, FileLocksNotSupported, FileBusy, Unseekable, ConnectionTimedOut, NotOpenForReading, SocketNotConnected, }; var error_data: ?*MalType = null; pub fn throw(mal: *MalType) MalError { assert(error_data == null); error_data = mal; mal.incref(); return MalError.ThrownError; } pub fn get_error_data() ?*MalType { defer error_data = null; return error_data; } ================================================ FILE: impls/zig/hmap.zig ================================================ const warn = @import("std").log.warn; const allocator = @import("std").heap.c_allocator; const hash_map = @import("std").hash_map; const MalType = @import("types.zig").MalType; const string_eql = @import("std").hash_map.eqlString; const MalError = @import("error.zig").MalError; const debug_alloc = @import("types.zig").debug_alloc; const Context = struct { pub fn hash(_: @This(), key: *MalType) u64 { return switch(key.*) { .Symbol, .String, .Keyword => |s| hash_map.hashString(s.data), else => unreachable, }; } pub fn eql(_: @This(), ma: *MalType, mb: *MalType) bool { return switch(ma.*) { .Keyword => |a| switch(mb.*) { .Keyword => |b| string_eql(a.data, b.data), else => false, }, .String => |a| switch(mb.*) { .String => |b| string_eql(a.data, b.data), else => false, }, .Symbol => |a| switch(mb.*) { .Symbol => |b| string_eql(a.data, b.data), else => false, }, else => unreachable, }; } }; pub const MalHashMap = hash_map.HashMapUnmanaged(*MalType, *MalType, Context, 80); pub fn map_destroy(hashmap: *MalHashMap) void { if (debug_alloc) { warn("destroy_map_elements", .{}); } var iterator = hashmap.iterator(); while(iterator.next()) |pair| { pair.key_ptr.*.decref(); pair.value_ptr.*.decref(); } hashmap.deinit(allocator); } // If the key was present in the map, the implementation reuses it, // instead of the new one. So we need to increment the reference // counting for the key here. // The ref count of the value is not incremented here. pub fn map_insert_incref_key(hashmap: *MalHashMap, key: *MalType, value: *MalType) !void { switch(key.*) { .String, .Keyword, .Symbol => { if (try hashmap.fetchPut(allocator, key, value)) |old| { // No change in the key reference count. old.value.decref(); } else { key.incref(); } }, else => return MalError.TypeError, } } pub fn map_insert_from_map(hashmap: *MalHashMap, from: MalHashMap) !void { var iterator = from.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; try map_insert_incref_key(hashmap, key, value); value.incref(); } } pub fn map_insert_from_kvs(hashmap: *MalHashMap, kvs: []const *MalType) !void { if (kvs.len % 2 == 1) { return MalError.TypeError; } for (0..kvs.len/2) |i| { const key = kvs[2*i]; const value = kvs[2*i+1]; try map_insert_incref_key(hashmap, key, value); value.incref(); } } ================================================ FILE: impls/zig/linked_list.zig ================================================ const allocator = @import("std").heap.c_allocator; const ArrayListUnmanaged = @import("std").ArrayListUnmanaged; const MalType = @import("types.zig").MalType; // The name is poorly choosen but historical. pub const MalLinkedList = ArrayListUnmanaged(*MalType); pub fn list_destroy(ll: *MalLinkedList) void { for(ll.items) |x| x.decref(); ll.deinit(allocator); } ================================================ FILE: impls/zig/printer.zig ================================================ const std = @import("std"); const stdout_writer = std.io.getStdOut().writer(); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; // TODO fix emacs highlighting, remove this const backslash = \\\ ; pub fn one_stdout(mal: MalType) !void { try print_to_buffer(mal, stdout_writer, true); } pub fn n_stdout(args: []const *MalType, readably: bool, sep: bool) !void { try n_writer(stdout_writer, args, readably, sep); } fn n_writer(rb: anytype, args: []const *MalType, readable: bool, sep: bool) !void { for (args, 0..) |node, idx| { if(0 < idx and sep) { try rb.writeAll(" "); } try print_to_buffer(node.*, rb, readable); } } pub fn print_mal_to_string(args: []const *MalType, readable: bool, sep: bool) ![]u8 { var rb = std.ArrayListUnmanaged(u8) { }; errdefer rb.deinit(Allocator); const writer = rb.writer(Allocator); try n_writer(writer, args, readable, sep); return rb.toOwnedSlice(Allocator); } fn print_to_buffer(mal: MalType, rb: anytype, readable: bool) MalError!void { switch(mal) { .String => |string| { if(readable) { try rb.writeAll("\""); // TODO: optimize this for(string.data, 0..) |this_char, i| { if(this_char == '"' or this_char==92) { try rb.writeAll(backslash); } if(this_char == '\n') { try rb.writeAll("\\n"); } else { try rb.writeAll(string.data[i..i+1]); } } try rb.writeAll("\""); } else { try rb.writeAll(string.data); } }, .Keyword => |kwd| { try rb.writeAll(":"); try rb.writeAll(kwd.data); }, .Int => |val| { try rb.print("{0}", .{val.data}); }, .Nil => { try rb.writeAll("nil"); }, .True => { try rb.writeAll("true"); }, .False => { try rb.writeAll("false"); }, .List => |l| { try rb.writeAll("("); try n_writer(rb, l.data.items, readable, true); try rb.writeAll(")"); }, .Vector => |v| { try rb.writeAll("["); try n_writer(rb, v.data.items, readable, true); try rb.writeAll("]"); }, .Atom => |atom_value| { try rb.writeAll("(atom "); try print_to_buffer(atom_value.data.*, rb, readable); try rb.writeAll(")"); }, .Func, .FnCore => { try rb.writeAll("#"); }, .Symbol => |value| { try rb.writeAll(value.data); }, .HashMap => |h| { try rb.writeAll("{"); var iterator = h.data.iterator(); var first = true; while(iterator.next()) |pair| { if(!first) { try rb.writeAll(" "); } try print_to_buffer(pair.key_ptr.*.*, rb, true); try rb.writeAll(" "); try print_to_buffer(pair.value_ptr.*.*, rb, readable); first = false; } try rb.writeAll("}"); }, } } ================================================ FILE: impls/zig/reader.zig ================================================ const fmt = @import("std").fmt; const pcre = @cImport({ @cInclude("pcre.h"); }); const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Allocator = @import("std").heap.c_allocator; const string_eql = @import("std").hash_map.eqlString; const linked_list = @import("linked_list.zig"); const assert = @import("std").debug.assert; const throw = @import("error.zig").throw; const MalHashMap = @import("hmap.zig").MalHashMap; const map_insert_incref_key = @import("hmap.zig").map_insert_incref_key; const match: [*]const u8 = \\[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*) ; var error_msg: [*c]const u8 = undefined; var erroroffset: c_int = 0; var re: ?*pcre.pcre = null; const Reader = struct { position: u32, string: [] const u8, tokens: [] usize, pub fn init(string: [] const u8, tokens: [] usize) Reader { return Reader { .position = 0, .string = string, .tokens = tokens, }; } pub fn next(self: *Reader) void { self.position += 1; } pub fn peek(self: *Reader) ?[]const u8 { while(!self.eol()) { const start = self.tokens[2*self.position]; const end = self.tokens[2*self.position+1]; if(self.string[start] == ';') { self.position += 1; continue; } return self.string[start..end]; } return null; } pub fn eol(self: *Reader) bool { return (2 * self.position >= self.tokens.len); } }; const AliasPair = struct { name: []const u8, value: []const u8, count: u8, }; const alias_pairs = [_] AliasPair { AliasPair {.name="@", .value="deref", .count=1}, AliasPair {.name="\'", .value="quote", .count=1}, AliasPair {.name="`", .value="quasiquote", .count=1}, AliasPair {.name="~", .value="unquote", .count=1}, AliasPair {.name="~@", .value="splice-unquote", .count=1}, AliasPair {.name="^", .value="with-meta", .count=2}, }; pub fn read_form(reader: *Reader) MalError!*MalType { const token = reader.peek() orelse return MalError.ArgError; reader.next(); if(token[0] == '(') { return try read_list(reader); } else if(token[0] == '[') { return try read_vector(reader); } else if(token[0] == ':') { return MalType.new_keyword(token[1..], true); } else if(token[0] == '{') { return try read_hashmap(reader); } for(alias_pairs) |pair| { const name = pair.name; const value = pair.value; const count = pair.count; if(string_eql(token, name)) { assert (count == 1 or count == 2); const result = try MalType.new_list(); errdefer result.decref(); const first = try MalType.new_symbol(value, true); try result.List.data.append(Allocator, first); for(0..count) |_| { const second = try read_form(reader); errdefer second.decref(); try result.List.data.insert(Allocator, 1, second); } return result; } } if(token_is_int(token)) { const value = try fmt.parseInt(i32, token, 10); return try MalType.new_int(value); } else if(string_eql(token, "nil")) { return &MalType.NIL; } else if(string_eql(token, "true")) { return &MalType.TRUE; } else if(string_eql(token, "false")) { return &MalType.FALSE; } else if(token[0] == '"') { return try read_atom_string(token); } else { return try MalType.new_symbol(token, true); } } fn read_list(reader: *Reader) !*MalType { const result = try MalType.new_list(); errdefer result.decref(); while(try read_list_element(reader, ')', "unbalanced '('")) |mal| { try result.List.data.append(Allocator, mal); } return result; } fn read_vector(reader: *Reader) !*MalType { const result = try MalType.new_vector(); errdefer result.decref(); while(try read_list_element(reader, ']', "unbalanced '['")) |mal| { try result.Vector.data.append(Allocator, mal); } return result; } fn read_hashmap(reader: *Reader) !*MalType { const result = try MalType.new_hashmap(); errdefer result.decref(); while(try read_list_element(reader, '}', "unbalanced '{'")) |key| { const value = try read_form(reader); errdefer value.decref(); try map_insert_incref_key(&result.HashMap.data, key, value); key.decref(); } return result; } fn read_list_element(reader: *Reader, comptime closer: u8, comptime unbalanced: []const u8, ) !?*MalType { if(reader.peek()) |next_token| { if(next_token[0] == closer) { reader.next(); return null; } return try read_form(reader); } return throw(try MalType.new_string(unbalanced, true)); } fn char_is_int(c: u8) bool { return (c >= '0' and c <= '9'); } fn token_is_int(token: []const u8) bool { if(char_is_int(token[0])) return true; if(token.len >= 2 and token[0] == '-' and char_is_int(token[1])) return true; return false; } fn read_atom_string(token: []const u8) MalError!*MalType { const n = token.len; if(token[0] != '"' or token[n-1] != '"' or n <= 1) { return throw(try MalType.new_string("unbalanced '\"'", true)); } var tmp_buffer = try Allocator.alloc(u8, n-2); errdefer Allocator.free(tmp_buffer); var i: usize = 1; var j: usize = 0; const escape_char: u8 = '\\'; //TODO: remove this comment required by bad emacs config ' while(i < n-1) { if(token[i] != escape_char) { tmp_buffer[j] = token[i]; j += 1; i += 1; } else { if(i==n-2) { return throw(try MalType.new_string("unbalanced '\"'", true)); } if(token[i+1] == 'n') { tmp_buffer[j] = '\n'; } else { tmp_buffer[j] = token[i+1]; } j += 1; i += 2; } } return try MalType.new_string(tmp_buffer[0..j], false); } pub fn read_str(string: [] const u8) MalError!Reader { if(re == null) { re = pcre.pcre_compile(&match[0], 0, &error_msg, &erroroffset, 0); } const tokens = try tokenize(re, string); return Reader.init(string, tokens); } // Allocates an array of matches. Caller is becomes owner of memory. fn tokenize(regex: ?*pcre.pcre, string: [] const u8) MalError![] usize { // TODO: pass in allocator const buffer_size: usize = 3 * string.len + 10; var indices: [] c_int = try Allocator.alloc(c_int, buffer_size); defer Allocator.free(indices); var match_buffer: [] usize = try Allocator.alloc(usize, buffer_size); defer Allocator.free(match_buffer); var current_match: usize = 0; var start_pos: c_int = 0; var rc: c_int = 0; var start_match: usize = 0; var end_match: usize = 0; const subject_size: c_int = @intCast(string.len); while(start_pos < subject_size) { rc = pcre.pcre_exec(regex, 0, &string[0], subject_size, start_pos, 0, &indices[0], @intCast(buffer_size)); if(rc <= 0) break; start_pos = indices[1]; start_match = @intCast(indices[2]); end_match = @intCast(indices[3]); match_buffer[current_match] = start_match; match_buffer[current_match+1] = end_match; current_match += 2; } var matches: [] usize = try Allocator.alloc(usize, current_match); for(0..current_match) |i| { matches[i] = match_buffer[i]; } return matches; } ================================================ FILE: impls/zig/readline.zig ================================================ const allocator = @import("std").heap.c_allocator; const readline = @cImport( @cInclude("readline/readline.h")); const rl_hist = @cImport( @cInclude("readline/history.h")); const free = @import("std").c.free; fn addNullByte(prompt: []const u8) ![]u8 { const result = try allocator.alloc(u8, prompt.len + 1); for (0.., prompt) |i, source| result[i] = source; result[prompt.len] = 0; return result; } fn slice_from_cstr(str: [*]const u8) ![]const u8 { var length: usize = 0; while(str[length] != 0) { length += 1; } // TODO: check for 0-length const slice = try allocator.alloc(u8, length); for (str, 0..length) |source, i| { slice[i] = source; } return slice; } pub fn getline(prompt: []const u8) !?[]const u8 { const null_terminated_prompt = try addNullByte(prompt); defer allocator.free(null_terminated_prompt); const input = readline.readline(&null_terminated_prompt[0]); if(input) |actual| { defer free(actual); const aslice = try slice_from_cstr(actual); rl_hist.add_history(actual); return aslice; } return null; } ================================================ FILE: impls/zig/run ================================================ #!/bin/sh exec $(dirname $0)/zig-out/bin/${STEP:-stepA_mal} "${@}" ================================================ FILE: impls/zig/step0_repl.zig ================================================ const getline = @import("readline.zig").getline; const Allocator = @import("std").heap.c_allocator; const stdout_file = @import("std").io.getStdOut(); fn READ(a: []const u8) []const u8 { return a; } fn EVAL(a: []const u8) []const u8 { return a; } fn PRINT(a: []const u8) !void { try stdout_file.writeAll(a); try stdout_file.writeAll("\n"); } fn rep(input: []const u8) !void { const read_input = READ(input); const eval_input = EVAL(read_input); try PRINT(eval_input); } pub fn main() !void { while(try getline("user> ")) |line| { defer Allocator.free(line); try rep(line); } } ================================================ FILE: impls/zig/step1_read_print.zig ================================================ const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const get_error_data = @import("error.zig").get_error_data; const stdout_file = @import("std").io.getStdOut(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } fn EVAL(a: *MalType) *MalType { a.incref(); return a; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = EVAL(read_input); defer eval_input.decref(); try PRINT(eval_input.*); } pub fn main() !void { while(try getline("user> ")) |line| { defer Allocator.free(line); rep(line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step2_eval.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const hash_map = @import("hmap.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = hash_map.MalHashMap { }; fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } fn EVAL(mal: *MalType, env: hash_map.MalHashMap) MalError!*MalType { // try stdout_file.writeAll("EVAL: "); // try PRINT(mal.*); switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } else { const first_mal = items[0]; const evaluated_first = try EVAL(first_mal, env); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env); try args.List.data.append(Allocator, new_item); } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, repl_environment); defer eval_input.decref(); try PRINT(eval_input.*); } fn EVAL_symbol(mal: *MalType, env: hash_map.MalHashMap) !*MalType { if(env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: hash_map.MalHashMap) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: hash_map.MalHashMap) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env); // key *is* new in this map. try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } const safeAdd = @import("std").math.add; const safeSub = @import("std").math.sub; const safeMul = @import("std").math.mul; const safeDivFloor = @import("std").math.divFloor; fn int_plus(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeAdd(i64, x, y); return MalType.new_int(res); } fn int_minus(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeSub(i64, x, y); return MalType.new_int(res); } fn int_mult(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeMul(i64, x, y); return MalType.new_int(res); } fn int_div(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeDivFloor(i64, x, y); return MalType.new_int(res); } fn make_environment() !void { const plus_sym = try MalType.new_symbol("+", true); const plus_mal = try MalType.newFnCore(&int_plus); try repl_environment.put(Allocator, plus_sym, plus_mal); const minus_sym = try MalType.new_symbol("-", true); const minus_mal = try MalType.newFnCore(&int_minus); try repl_environment.put(Allocator, minus_sym, minus_mal); const mult_sym = try MalType.new_symbol("*", true); const mult_mal = try MalType.newFnCore(&int_mult); try repl_environment.put(Allocator, mult_sym, mult_mal); const div_sym = try MalType.new_symbol("/", true); const div_mal = try MalType.newFnCore(&int_div); try repl_environment.put(Allocator, div_sym, div_mal); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { try make_environment(); while(try getline("user> ")) |line| { defer Allocator.free(line); rep(line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step3_env.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal: *MalType, env: *Env) MalError!*MalType { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "let*")) { return EVAL_let(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env); try args.List.data.append(Allocator, new_item); } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_let(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); env.incref(); defer new_env.decref(); for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } return EVAL(eval_arg, new_env); } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment); defer eval_input.decref(); try PRINT(eval_input.*); } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env); // key *is* new in this map. try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } const safeAdd = @import("std").math.add; const safeSub = @import("std").math.sub; const safeMul = @import("std").math.mul; const safeDivFloor = @import("std").math.divFloor; fn int_plus(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeAdd(i64, x, y); return MalType.new_int(res); } fn int_minus(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeSub(i64, x, y); return MalType.new_int(res); } fn int_mult(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeMul(i64, x, y); return MalType.new_int(res); } fn int_div(args: []*MalType) MalError!*MalType { if (args.len != 2) return MalError.ArgError; const a1 = args[0]; const a2 = args[1]; const x = try a1.as_int(); const y = try a2.as_int(); const res = try safeDivFloor(i64, x, y); return MalType.new_int(res); } fn make_environment() !void { const plus_sym = try MalType.new_symbol("+", true); const plus_mal = try MalType.newFnCore(&int_plus); try repl_environment.set(plus_sym, plus_mal); const minus_sym = try MalType.new_symbol("-", true); const minus_mal = try MalType.newFnCore(&int_minus); try repl_environment.set(minus_sym, minus_mal); const mult_sym = try MalType.new_symbol("*", true); const mult_mal = try MalType.newFnCore(&int_mult); try repl_environment.set(mult_sym, mult_mal); const div_sym = try MalType.new_symbol("/", true); const div_mal = try MalType.newFnCore(&int_div); try repl_environment.set(div_sym, div_mal); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { try make_environment(); while(try getline("user> ")) |line| { defer Allocator.free(line); rep(line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step4_if_fn_do.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal: *MalType, env: *Env) MalError!*MalType { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "let*")) { return EVAL_let(items[1..], env); } else if(string_eql(symbol, "do")) { return EVAL_do(items[1..], env); } else if(string_eql(symbol, "if")) { return EVAL_if(items[1..], env); } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env); try args.List.data.append(Allocator, new_item); } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_let(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); env.incref(); defer new_env.decref(); for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } return EVAL(eval_arg, new_env); } fn EVAL_do(args: []*MalType, env: *Env) !*MalType { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env); item.decref(); } return EVAL(last_mal, env); } fn EVAL_if(args: []*MalType, env: *Env) !*MalType { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; return EVAL(second_arg, env); } if(args.len == 2) { return &MalType.NIL; } const third_arg = args[2]; return EVAL(third_arg, env); } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { try make_environment(); while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step5_tco.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { try make_environment(); while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step6_file.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn eval(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return EVAL(a1, &repl_environment, false); } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const eval_sym = try MalType.new_symbol("eval", true); const eval_mal = try MalType.newFnCore(eval); try repl_environment.set(eval_sym, eval_mal); eval_sym.decref(); const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); const load_file_string: [] const u8 = \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ; try rep(false, load_file_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { // Break a circular dependency between modules. core.apply_function = &apply_function; try make_environment(); const args = try std.process.argsAlloc(Allocator); const arg_list = try MalType.new_list(); if(1 < args.len) { for (args[2..]) |arg| { const new_mal = try MalType.new_string(arg, false); try arg_list.List.data.append(Allocator, new_mal); } } const argv_sym = try MalType.new_symbol("*ARGV*", true); try repl_environment.set(argv_sym, arg_list); argv_sym.decref(); if(args.len > 1) { const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); try rep(false, run_cmd); return; } while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step7_quote.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else if(string_eql(symbol, "quote")) { return EVAL_quote(items[1..]); } else if(string_eql(symbol, "quasiquote")) { if(items.len != 2) return MalError.ArgError; const second = items[1]; mal = try quasiquote(second); continue; } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn eval(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return EVAL(a1, &repl_environment, false); } fn starts_with(mal: MalType, sym: []const u8) ?*MalType { const ll = switch(mal) { .List => |l| l, else => return null, }; const items = ll.data.items; if(items.len != 2) { return null; } const ss = switch(items[0].*) { .Symbol => |s| s, else => return null, }; if(string_eql(ss.data, sym)) { return items[1]; } return null; } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn EVAL_quote(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const quoted = args[0]; quoted.incref(); return quoted; } fn quasiquote(ast: *MalType) MalError!*MalType { switch (ast.*) { .Symbol, .HashMap => { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); try new_list.List.data.append(Allocator, ast); ast.incref(); return new_list; }, .List => |l| { if(starts_with(ast.*, "unquote")) |unquoted| { unquoted.incref(); return unquoted; } return try qq_loop(l.data.items); }, .Vector => |l| { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); return new_list; }, else => { ast.incref(); return ast; }, } } fn qq_loop(items: []*MalType) !*MalType { var result = try MalType.new_list(); errdefer result.decref(); for (0..items.len) |i| { const elt = items[items.len - 1 - i]; const new_list = try MalType.new_list(); errdefer new_list.decref(); if(starts_with(elt.*, "splice-unquote")) |unquoted| { try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); try new_list.List.data.append(Allocator, unquoted); unquoted.incref(); } else { try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); try new_list.List.data.append(Allocator, try quasiquote(elt)); } try new_list.List.data.append(Allocator, result); result = new_list; } return result; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const eval_sym = try MalType.new_symbol("eval", true); const eval_mal = try MalType.newFnCore(eval); try repl_environment.set(eval_sym, eval_mal); eval_sym.decref(); const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); const load_file_string: [] const u8 = \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ; try rep(false, load_file_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { // Break a circular dependency between modules. core.apply_function = &apply_function; try make_environment(); const args = try std.process.argsAlloc(Allocator); const arg_list = try MalType.new_list(); if(1 < args.len) { for (args[2..]) |arg| { const new_mal = try MalType.new_string(arg, false); try arg_list.List.data.append(Allocator, new_mal); } } const argv_sym = try MalType.new_symbol("*ARGV*", true); try repl_environment.set(argv_sym, arg_list); argv_sym.decref(); if(args.len > 1) { const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); try rep(false, run_cmd); return; } while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step8_macros.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "defmacro!")) { return EVAL_defmacro(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else if(string_eql(symbol, "quote")) { return EVAL_quote(items[1..]); } else if(string_eql(symbol, "quasiquote")) { if(items.len != 2) return MalError.ArgError; const second = items[1]; mal = try quasiquote(second); continue; } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); switch (evaluated_first.*) { .Func => |func_data| { if(func_data.is_macro) { mal = try apply_function(evaluated_first.*, items[1..]); continue; } }, else => {} } // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn eval(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return EVAL(a1, &repl_environment, false); } fn starts_with(mal: MalType, sym: []const u8) ?*MalType { const ll = switch(mal) { .List => |l| l, else => return null, }; const items = ll.data.items; if(items.len != 2) { return null; } const ss = switch(items[0].*) { .Symbol => |s| s, else => return null, }; if(string_eql(ss.data, sym)) { return items[1]; } return null; } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); errdefer new_value.decref(); const f = switch (new_value.*) { .Func => |func_data| func_data, else => return MalError.TypeError, }; const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); f.arg_list.incref(); f.body.incref(); f.environment.incref(); macro.Func.is_macro = true; try env.set(symbol_name, macro); macro.incref(); return macro; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn EVAL_quote(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const quoted = args[0]; quoted.incref(); return quoted; } fn quasiquote(ast: *MalType) MalError!*MalType { switch (ast.*) { .Symbol, .HashMap => { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); try new_list.List.data.append(Allocator, ast); ast.incref(); return new_list; }, .List => |l| { if(starts_with(ast.*, "unquote")) |unquoted| { unquoted.incref(); return unquoted; } return try qq_loop(l.data.items); }, .Vector => |l| { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); return new_list; }, else => { ast.incref(); return ast; }, } } fn qq_loop(items: []*MalType) !*MalType { var result = try MalType.new_list(); errdefer result.decref(); for (0..items.len) |i| { const elt = items[items.len - 1 - i]; const new_list = try MalType.new_list(); errdefer new_list.decref(); if(starts_with(elt.*, "splice-unquote")) |unquoted| { try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); try new_list.List.data.append(Allocator, unquoted); unquoted.incref(); } else { try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); try new_list.List.data.append(Allocator, try quasiquote(elt)); } try new_list.List.data.append(Allocator, result); result = new_list; } return result; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const eval_sym = try MalType.new_symbol("eval", true); const eval_mal = try MalType.newFnCore(eval); try repl_environment.set(eval_sym, eval_mal); eval_sym.decref(); const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); const load_file_string: [] const u8 = \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ; try rep(false, load_file_string); const def_cond_macro_string: [] const u8 = \\(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))))))) ; try rep(false, def_cond_macro_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { // Break a circular dependency between modules. core.apply_function = &apply_function; try make_environment(); const args = try std.process.argsAlloc(Allocator); const arg_list = try MalType.new_list(); if(1 < args.len) { for (args[2..]) |arg| { const new_mal = try MalType.new_string(arg, false); try arg_list.List.data.append(Allocator, new_mal); } } const argv_sym = try MalType.new_symbol("*ARGV*", true); try repl_environment.set(argv_sym, arg_list); argv_sym.decref(); if(args.len > 1) { const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); try rep(false, run_cmd); return; } while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/step9_try.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "defmacro!")) { return EVAL_defmacro(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else if(string_eql(symbol, "quote")) { return EVAL_quote(items[1..]); } else if(string_eql(symbol, "quasiquote")) { if(items.len != 2) return MalError.ArgError; const second = items[1]; mal = try quasiquote(second); continue; } else if(string_eql(symbol, "try*")) { return EVAL_try(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); switch (evaluated_first.*) { .Func => |func_data| { if(func_data.is_macro) { mal = try apply_function(evaluated_first.*, items[1..]); continue; } }, else => {} } // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn eval(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return EVAL(a1, &repl_environment, false); } fn starts_with(mal: MalType, sym: []const u8) ?*MalType { const ll = switch(mal) { .List => |l| l, else => return null, }; const items = ll.data.items; if(items.len != 2) { return null; } const ss = switch(items[0].*) { .Symbol => |s| s, else => return null, }; if(string_eql(ss.data, sym)) { return items[1]; } return null; } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); errdefer new_value.decref(); const f = switch (new_value.*) { .Func => |func_data| func_data, else => return MalError.TypeError, }; const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); f.arg_list.incref(); f.body.incref(); f.environment.incref(); macro.Func.is_macro = true; try env.set(symbol_name, macro); macro.incref(); return macro; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn EVAL_quote(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const quoted = args[0]; quoted.incref(); return quoted; } fn EVAL_try(args: []*MalType, env: *Env) !*MalType { if(args.len != 1 and args.len != 2) return MalError.ArgError; const mal_to_try = args[0]; if(args.len == 1) { return EVAL(mal_to_try, env, false); } const catch_mal = args[1]; const catch_list = switch (catch_mal.*) { .List => |l| l.data.items, else => return MalError.TypeError, }; if(catch_list.len != 3) return MalError.ArgError; switch (catch_list[0].*) { .Symbol => |s| { if(!string_eql(s.data, "catch*")) return MalError.ArgError; }, else => return MalError.ArgError, } const evaled_mal = EVAL(mal_to_try, env, false) catch |err| { const err_symbol = catch_list[1]; const err_body = catch_list[2]; const err_val = get_error_data() orelse try MalType.new_string(@errorName(err), true); const new_env = try Env.new(env); env.incref(); defer new_env.decref(); try new_env.set(err_symbol, err_val); // no incref for err_val. const result = EVAL(err_body, new_env, false); return result; }; return evaled_mal; } fn quasiquote(ast: *MalType) MalError!*MalType { switch (ast.*) { .Symbol, .HashMap => { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); try new_list.List.data.append(Allocator, ast); ast.incref(); return new_list; }, .List => |l| { if(starts_with(ast.*, "unquote")) |unquoted| { unquoted.incref(); return unquoted; } return try qq_loop(l.data.items); }, .Vector => |l| { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); return new_list; }, else => { ast.incref(); return ast; }, } } fn qq_loop(items: []*MalType) !*MalType { var result = try MalType.new_list(); errdefer result.decref(); for (0..items.len) |i| { const elt = items[items.len - 1 - i]; const new_list = try MalType.new_list(); errdefer new_list.decref(); if(starts_with(elt.*, "splice-unquote")) |unquoted| { try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); try new_list.List.data.append(Allocator, unquoted); unquoted.incref(); } else { try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); try new_list.List.data.append(Allocator, try quasiquote(elt)); } try new_list.List.data.append(Allocator, result); result = new_list; } return result; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const eval_sym = try MalType.new_symbol("eval", true); const eval_mal = try MalType.newFnCore(eval); try repl_environment.set(eval_sym, eval_mal); eval_sym.decref(); const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); const load_file_string: [] const u8 = \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ; try rep(false, load_file_string); const def_cond_macro_string: [] const u8 = \\(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))))))) ; try rep(false, def_cond_macro_string); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { // Break a circular dependency between modules. core.apply_function = &apply_function; try make_environment(); const args = try std.process.argsAlloc(Allocator); const arg_list = try MalType.new_list(); if(1 < args.len) { for (args[2..]) |arg| { const new_mal = try MalType.new_string(arg, false); try arg_list.List.data.append(Allocator, new_mal); } } const argv_sym = try MalType.new_symbol("*ARGV*", true); try repl_environment.set(argv_sym, arg_list); argv_sym.decref(); if(args.len > 1) { const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); try rep(false, run_cmd); return; } while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/stepA_mal.zig ================================================ const std = @import("std"); const reader = @import("reader.zig"); const printer = @import("printer.zig"); const getline = @import("readline.zig").getline; const string_eql = std.hash_map.eqlString; const hash_map = @import("hmap.zig"); const core = @import("core.zig"); const Allocator = @import("std").heap.c_allocator; const MalType = @import("types.zig").MalType; const MalError = @import("error.zig").MalError; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const Env = @import("env.zig").Env; const get_error_data = @import("error.zig").get_error_data; const throw = @import("error.zig").throw; const stdout_file = std.io.getStdOut(); var repl_environment = Env.new_root(); fn READ(a: []const u8) !*MalType { var read = try reader.read_str(a); return reader.read_form(&read); } // Do not allocate this one on each EVAL run. // The string is static, but will never be deallocated. var DEBUG_EVAL = MalType { .Symbol = .{ .data = "DEBUG-EVAL" } }; fn EVAL(mal_arg: *MalType, env_arg: *Env, finally_destroy_env: bool) MalError!*MalType { var mal = mal_arg; var env = env_arg; var fde = finally_destroy_env; defer if(fde) env.decref(); while(true) { if(try env.get(&DEBUG_EVAL)) |dbgeval| { switch (dbgeval.*) { .Nil, .False => {}, else => { try stdout_file.writeAll("EVAL: "); try PRINT(mal.*); } } } switch(mal.*) { .List => |ll| { const items = ll.data.items; if(items.len == 0) { mal.incref(); return mal; } const first_mal = items[0]; const symbol = switch(first_mal.*) { .Symbol => |symbol| symbol.data, else => "", }; if(string_eql(symbol, "def!")) { return EVAL_def(items[1..], env); } else if(string_eql(symbol, "defmacro!")) { return EVAL_defmacro(items[1..], env); } else if(string_eql(symbol, "let*")) { try EVAL_let(items[1..], &mal, &env, &fde); continue; } else if(string_eql(symbol, "do")) { try EVAL_do(items[1..], &mal, env); continue; } else if(string_eql(symbol, "if")) { try EVAL_if(items[1..], &mal, env); continue; } else if(string_eql(symbol, "fn*")) { return EVAL_fn(items[1..], env); } else if(string_eql(symbol, "quote")) { return EVAL_quote(items[1..]); } else if(string_eql(symbol, "quasiquote")) { if(items.len != 2) return MalError.ArgError; const second = items[1]; mal = try quasiquote(second); continue; } else if(string_eql(symbol, "try*")) { return EVAL_try(items[1..], env); } else { const evaluated_first = try EVAL(first_mal, env, false); defer evaluated_first.decref(); switch (evaluated_first.*) { .Func => |func_data| { if(func_data.is_macro) { mal = try apply_function(evaluated_first.*, items[1..]); continue; } }, else => {} } // A slice would be sufficient, but a List is convenient // for partial deallocation in case of error. const args = try MalType.new_list(); defer args.decref(); for(items[1..]) |x| { const new_item = try EVAL(x, env, false); try args.List.data.append(Allocator, new_item); } switch(evaluated_first.*) { .Func => |func_data| { if(fde) { env.decref(); } else { fde = true; } env = try func_data.gen_env(args.List.data.items); mal = func_data.body; continue; }, else => {}, } return apply_function(evaluated_first.*, args.List.data.items); } }, .Symbol => { return EVAL_symbol(mal, env); }, .Vector => |ll| { return EVAL_vector(ll.data.items, env); }, .HashMap => |hmap| { return EVAL_map(hmap.data, env); }, else => { mal.incref(); return mal; }, } } } fn eval(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const a1 = args[0]; return EVAL(a1, &repl_environment, false); } fn starts_with(mal: MalType, sym: []const u8) ?*MalType { const ll = switch(mal) { .List => |l| l, else => return null, }; const items = ll.data.items; if(items.len != 2) { return null; } const ss = switch(items[0].*) { .Symbol => |s| s, else => return null, }; if(string_eql(ss.data, sym)) { return items[1]; } return null; } fn EVAL_def(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); try env.set(symbol_name, new_value); new_value.incref(); return new_value; } fn EVAL_defmacro(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const symbol_name = args[0]; const second_arg = args[1]; const new_value = try EVAL(second_arg, env, false); errdefer new_value.decref(); const f = switch (new_value.*) { .Func => |func_data| func_data, else => return MalError.TypeError, }; const macro = try MalType.newFunc(f.arg_list, f.body, f.environment); f.arg_list.incref(); f.body.incref(); f.environment.incref(); macro.Func.is_macro = true; try env.set(symbol_name, macro); macro.incref(); return macro; } fn EVAL_let(args: []*MalType, mal_ptr: **MalType, env_ptr: **Env, fde: *bool) !void { if(args.len != 2) return MalError.ArgError; const env = env_ptr.*; const binding_arg = args[0]; const eval_arg = args[1]; const binds = try binding_arg.as_slice(); if(binds.len % 2 != 0) return MalError.ArgError; const new_env = try Env.new(env); // Change env and fde in case an error occurs later in this procedure // and fde triggers an env.decref() at the exit of EVAL. if(!fde.*) { env.incref(); fde.* = true; } env_ptr.* = new_env; for(0..binds.len / 2) |i| { const key = binds[2*i]; const val_mal = binds[2*i + 1]; const evaled_mal = try EVAL(val_mal, new_env, false); errdefer evaled_mal.decref(); try new_env.set(key, evaled_mal); // Do not increment the refcount for the value. } mal_ptr.* = eval_arg; } fn EVAL_do(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len == 0) return MalError.ArgError; const last_mal = args[args.len - 1]; for (args[0..args.len - 1]) |form| { const item = try EVAL(form, env, false); item.decref(); } mal_ptr.* = last_mal; } fn EVAL_if(args: []*MalType, mal_ptr: **MalType, env: *Env) !void { if(args.len != 2 and args.len != 3) return MalError.ArgError; const first_arg = args[0]; const evaled = try EVAL(first_arg, env, false); const is_true = switch(evaled.*) { .False => false, .Nil => false, else => true, }; evaled.decref(); if(is_true) { const second_arg = args[1]; mal_ptr.* = second_arg; return; } if(args.len == 2) { mal_ptr.* = &MalType.NIL; return; } const third_arg = args[2]; mal_ptr.* = third_arg; } fn EVAL_fn(args: []*MalType, env: *Env) !*MalType { if(args.len != 2) return MalError.ArgError; const arg_mal = args[0]; const body_mal = args[1]; for (try arg_mal.as_slice()) |x| { switch (x.*) { .Symbol => {}, else => return MalError.TypeError, } } const new_func = try MalType.newFunc(arg_mal, body_mal, env); arg_mal.incref(); body_mal.incref(); env.incref(); return new_func; } fn EVAL_quote(args: []*MalType) !*MalType { if(args.len != 1) return MalError.ArgError; const quoted = args[0]; quoted.incref(); return quoted; } fn EVAL_try(args: []*MalType, env: *Env) !*MalType { if(args.len != 1 and args.len != 2) return MalError.ArgError; const mal_to_try = args[0]; if(args.len == 1) { return EVAL(mal_to_try, env, false); } const catch_mal = args[1]; const catch_list = switch (catch_mal.*) { .List => |l| l.data.items, else => return MalError.TypeError, }; if(catch_list.len != 3) return MalError.ArgError; switch (catch_list[0].*) { .Symbol => |s| { if(!string_eql(s.data, "catch*")) return MalError.ArgError; }, else => return MalError.ArgError, } const evaled_mal = EVAL(mal_to_try, env, false) catch |err| { const err_symbol = catch_list[1]; const err_body = catch_list[2]; const err_val = get_error_data() orelse try MalType.new_string(@errorName(err), true); const new_env = try Env.new(env); env.incref(); defer new_env.decref(); try new_env.set(err_symbol, err_val); // no incref for err_val. const result = EVAL(err_body, new_env, false); return result; }; return evaled_mal; } fn quasiquote(ast: *MalType) MalError!*MalType { switch (ast.*) { .Symbol, .HashMap => { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("quote", true)); try new_list.List.data.append(Allocator, ast); ast.incref(); return new_list; }, .List => |l| { if(starts_with(ast.*, "unquote")) |unquoted| { unquoted.incref(); return unquoted; } return try qq_loop(l.data.items); }, .Vector => |l| { const new_list = try MalType.new_list(); errdefer new_list.decref(); try new_list.List.data.append(Allocator, try MalType.new_symbol("vec", true)); try new_list.List.data.append(Allocator, try qq_loop(l.data.items)); return new_list; }, else => { ast.incref(); return ast; }, } } fn qq_loop(items: []*MalType) !*MalType { var result = try MalType.new_list(); errdefer result.decref(); for (0..items.len) |i| { const elt = items[items.len - 1 - i]; const new_list = try MalType.new_list(); errdefer new_list.decref(); if(starts_with(elt.*, "splice-unquote")) |unquoted| { try new_list.List.data.append(Allocator, try MalType.new_symbol("concat", true)); try new_list.List.data.append(Allocator, unquoted); unquoted.incref(); } else { try new_list.List.data.append(Allocator, try MalType.new_symbol("cons", true)); try new_list.List.data.append(Allocator, try quasiquote(elt)); } try new_list.List.data.append(Allocator, result); result = new_list; } return result; } fn PRINT(mal: MalType) !void { try printer.one_stdout(mal); try stdout_file.writeAll("\n"); } fn rep(print: bool, input: []const u8) !void { const read_input = try READ(input); defer read_input.decref(); const eval_input = try EVAL(read_input, &repl_environment, false); defer eval_input.decref(); if(print) { try PRINT(eval_input.*); } } fn EVAL_symbol(mal: *MalType, env: *Env) !*MalType { if(try env.get(mal)) |value| { value.incref(); return value; } const err = try std.fmt.allocPrint(Allocator, "'{s}' not found", .{mal.Symbol.data}); return throw(try MalType.new_string(err, false)); } fn EVAL_vector(ll: []*MalType, env: *Env) !*MalType { const ret_mal = try MalType.new_vector(); errdefer ret_mal.decref(); for(ll) |x| { const new_mal = try EVAL(x, env, false); try ret_mal.Vector.data.append(Allocator, new_mal); } return ret_mal; } fn EVAL_map(hmap: hash_map.MalHashMap, env: *Env) !*MalType { const new_hashmap = try MalType.new_hashmap(); errdefer new_hashmap.decref(); var iterator = hmap.iterator(); while(iterator.next()) |pair| { const key = pair.key_ptr.*; const value = pair.value_ptr.*; const evaled_value = try EVAL(value, env, false); try hash_map.map_insert_incref_key(&new_hashmap.HashMap.data, key, evaled_value); } return new_hashmap; } fn make_environment() !void { for(core.core_namespace) |pair| { const name = try MalType.new_symbol(pair.name, true); const func_mal = try MalType.newFnCore(pair.func); try repl_environment.set(name, func_mal); name.decref(); } const eval_sym = try MalType.new_symbol("eval", true); const eval_mal = try MalType.newFnCore(eval); try repl_environment.set(eval_sym, eval_mal); eval_sym.decref(); const def_not_string: [] const u8 = \\(def! not (fn* (a) (if a false true))) ; try rep(false, def_not_string); const load_file_string: [] const u8 = \\(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ; try rep(false, load_file_string); const def_cond_macro_string: [] const u8 = \\(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))))))) ; try rep(false, def_cond_macro_string); const host_language_sym = try MalType.new_symbol("*host-language*", true); const host_language_mal = try MalType.new_string("Zig", true); try repl_environment.set(host_language_sym, host_language_mal); } fn do_print_header() !void { const welcome_msg_cmd: [] const u8 = \\(println (str "Mal [" *host-language* "]")) ; try rep(false, welcome_msg_cmd); } pub fn apply_function(f: MalType, args: []*MalType) MalError!*MalType { switch(f) { .FnCore => |fncoredata| { return fncoredata.data(args); }, .Func => |funcdata| { const apply_env = try funcdata.gen_env(args); defer apply_env.decref(); return EVAL(funcdata.body, apply_env, false); }, else => { return MalError.ApplyError; }, } } pub fn main() !void { // Break a circular dependency between modules. core.apply_function = &apply_function; try make_environment(); const args = try std.process.argsAlloc(Allocator); const arg_list = try MalType.new_list(); if(1 < args.len) { for (args[2..]) |arg| { const new_mal = try MalType.new_string(arg, false); try arg_list.List.data.append(Allocator, new_mal); } } const argv_sym = try MalType.new_symbol("*ARGV*", true); try repl_environment.set(argv_sym, arg_list); argv_sym.decref(); if(args.len > 1) { const run_cmd = try std.fmt.allocPrint(Allocator, "(load-file \"{s}\")", .{args[1]}); try rep(false, run_cmd); return; } try do_print_header(); while(try getline("user> ")) |line| { defer Allocator.free(line); rep(true, line) catch |err| { try stdout_file.writeAll("Error: "); try stdout_file.writeAll(@errorName(err)); try stdout_file.writeAll("\n"); if(get_error_data()) |mal| { defer mal.decref(); try stdout_file.writeAll("MAL error object is: "); try PRINT(mal.*); } }; } } ================================================ FILE: impls/zig/types.zig ================================================ const std = @import("std"); const allocator = std.heap.c_allocator; const warn = std.log.warn; const Env = @import("env.zig").Env; const MalError = @import("error.zig").MalError; const MalHashMap = @import("hmap.zig").MalHashMap; const MalLinkedList = @import("linked_list.zig").MalLinkedList; const linked_list = @import("linked_list.zig"); const hash_map = @import("hmap.zig"); const map_destroy = @import("hmap.zig").map_destroy; pub const debug_alloc = false; pub const ListData = struct { data: MalLinkedList, reference_count: i32 = 1, metadata: *MalType = &MalType.NIL, }; pub const FnCoreData = struct { data: *const fn (args: []*MalType) MalError!*MalType, reference_count: i32 = 1, // May reach 0 when metadata. metadata: *MalType = &MalType.NIL, }; pub const MalFuncData = struct { arg_list: *MalType, body: *MalType, environment: *Env, is_macro: bool = false, reference_count: i32 = 1, metadata: *MalType = &MalType.NIL, pub fn gen_env(self: MalFuncData, args: []*MalType) !*Env { const binds = try self.arg_list.as_slice(); var res = try Env.new(self.environment); self.environment.incref(); errdefer res.decref(); if (2 <= binds.len and std.hash_map.eqlString(binds[binds.len - 2].Symbol.data, "&")) { if (args.len < binds.len - 2) return MalError.TypeError; for (binds[0..binds.len-2], args[0..binds.len-2]) |k, v| { try res.set(k, v); v.incref(); } const more = try MalType.new_list(); errdefer more.decref(); for (args[binds.len-2..args.len]) |x| { try more.List.data.append(allocator, x); x.incref(); } try res.set(binds[binds.len - 1], more); // Do not increment the reference count for this value. } else { if (args.len != binds.len) { return MalError.TypeError; } for(binds, args) |k, v| { try res.set(k, v); v.incref(); } } return res; } }; pub const StringData = struct { data: [] const u8, reference_count: i32 = 1, }; pub const HashMapData = struct { data: MalHashMap, reference_count: i32 = 1, metadata: *MalType = &MalType.NIL, }; pub const MalType = union(enum) { List: ListData, Vector: ListData, Int: struct { data: i64, reference_count: i32 = 1, }, Symbol: StringData, String: StringData, Keyword: StringData, Nil: void, True: void, False: void, FnCore: FnCoreData, Func: MalFuncData, Atom: struct { data: *MalType, reference_count: i32 = 1, }, HashMap: HashMapData, // Define some frequent values in advance. They are not allocated // on the heap, but should never be deallocated anyway. pub var NIL = MalType { .Nil = undefined }; pub var FALSE = MalType { .False = undefined }; pub var TRUE = MalType { .True = undefined }; pub fn new_symbol(value: []const u8, copy: bool) !*MalType { const mal = try allocator.create(MalType); errdefer allocator.destroy(mal); const data = if (copy) try allocator.dupe(u8, value) else value; mal.* = .{.Symbol=.{.data = data}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_string(value: []const u8, copy: bool) !*MalType { const mal = try allocator.create(MalType); errdefer allocator.destroy(mal); const data = if (copy) try allocator.dupe(u8, value) else value; mal.* = .{.String=.{.data = data}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_keyword(value: []const u8, copy: bool) !*MalType { const mal = try allocator.create(MalType); errdefer allocator.destroy(mal); const data = if (copy) try allocator.dupe(u8, value) else value; mal.* = .{.Keyword=.{.data = data}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_int(value: i64) !*MalType { const mal = try allocator.create(MalType); mal.* = .{.Int=.{.data = value}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_bool(b: bool) *MalType { if(b) { return &TRUE; } else { return &FALSE; } } pub fn newFnCore(f: *const fn (args: []*MalType) MalError!*MalType) !*MalType { const mal = try allocator.create(MalType); mal.* = .{.FnCore=.{.data = f}}; if (debug_alloc) warn("Init core function", .{}); return mal; } pub fn newFunc(arg_list: *MalType, body: *MalType, environment: *Env, ) !*MalType { const mal = try allocator.create(MalType); mal.* = .{.Func=.{ .arg_list = arg_list, .body = body, .environment = environment, }}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_list() !*MalType { const mal = try allocator.create(MalType); mal.* = .{.List=.{.data = MalLinkedList { }}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_vector() !*MalType { const mal = try allocator.create(MalType); errdefer allocator.destroy(mal); mal.* = .{.Vector=.{.data = MalLinkedList { }}}; if (debug_alloc) warn("Init {any}", .{mal}); return mal; } pub fn new_atom(mal: *MalType) !*MalType { const new_mal = try allocator.create(MalType); errdefer allocator.destroy(new_mal); new_mal.* = .{.Atom=.{.data = mal}}; if (debug_alloc) warn("Init {any}", .{new_mal}); return new_mal; } pub fn new_hashmap() !*MalType { const new_mal = try allocator.create(MalType); errdefer allocator.destroy(new_mal); new_mal.* = .{.HashMap=.{.data = .{}}}; if (debug_alloc) warn("Init {any}", .{new_mal}); return new_mal; } // Trivial but convenient checkers/getters. pub fn as_slice(self: MalType) ![]*MalType { return switch (self) { .List, .Vector => |x| x.data.items, else => MalError.TypeError, }; } pub fn as_int(mal: MalType) !i64 { return switch (mal) { .Int => |val| val.data, else => MalError.TypeError, }; } pub fn as_string(self: MalType) ![]const u8 { return switch (self) { .String => |s| s.data, else => MalError.TypeError, }; } pub fn as_map(self: MalType) !MalHashMap { switch (self) { .HashMap => |x| return x.data, else => return MalError.TypeError, } } pub fn decref(mal: *MalType) void { switch(mal.*) { .List, .Vector => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); linked_list.list_destroy(&l.data); l.metadata.decref(); allocator.destroy(mal); } }, .Keyword, .String, .Symbol => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {s} {any}", .{l.data, mal}); allocator.free(l.data); allocator.destroy(mal); } }, .Atom => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); l.data.decref(); allocator.destroy(mal); } }, .HashMap => |*l| { std.debug.assert (0 <= l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); map_destroy(&l.data); l.metadata.decref(); allocator.destroy(mal); } }, .Func => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); l.arg_list.decref(); l.body.decref(); l.environment.decref(); l.metadata.decref(); allocator.destroy(mal); } }, .Int => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); allocator.destroy(mal); } }, .FnCore => |*l| { std.debug.assert (0 < l.reference_count); l.reference_count -= 1; if (l.reference_count == 0) { if (debug_alloc) warn("Free {any}", .{mal}); l.metadata.decref(); allocator.destroy(mal); } }, .Nil, .False, .True => {}, } } pub fn incref(mal: *MalType) void { // A procedure instead of a function returning its argument // because it must most of the time be applied *after* a // successful assignment. switch(mal.*) { .List, .Vector => |*l| l.reference_count += 1, .Int => |*l| l.reference_count += 1, .Keyword, .String, .Symbol => |*l| l.reference_count += 1, .FnCore => |*l| l.reference_count += 1, .Func => |*l| l.reference_count += 1, .Atom => |*l| l.reference_count += 1, .HashMap => |*l| l.reference_count += 1, .Nil, .False, .True => {}, } } }; ================================================ FILE: process/guide.md ================================================ # The Make-A-Lisp Process So you want to write a Lisp interpreter? Welcome! The goal of the Make-A-Lisp project is to make it easy to write your own Lisp interpreter without sacrificing those many "Aha!" moments that come from ascending the McCarthy mountain. When you reach the peak of this particular mountain, you will have an interpreter for the mal Lisp language that is powerful enough to be self-hosting, meaning it will be able to run a mal interpreter written in mal itself. So jump right in (er ... start the climb)! - [Pick a language](#pick-a-language) - [Getting started](#getting-started) - [General hints](#general-hints) - [The Make-A-Lisp Process](#the-make-a-lisp-process-1) - [Step 0: The REPL](#step-0-the-repl) - [Step 1: Read and Print](#step-1-read-and-print) - [Step 2: Eval](#step-2-eval) - [Step 3: Environments](#step-3-environments) - [Step 4: If Fn Do](#step-4-if-fn-do) - [Step 5: Tail call optimization](#step-5-tail-call-optimization) - [Step 6: Files, Mutation, and Evil](#step-6-files-mutation-and-evil) - [Step 7: Quoting](#step-7-quoting) - [Step 8: Macros](#step-8-macros) - [Step 9: Try](#step-9-try) - [Step A: Metadata, Self-hosting and Interop](#step-a-metadata-self-hosting-and-interop) ## Pick a language You might already have a language in mind that you want to use. Technically speaking, mal can be implemented in any sufficiently complete programming language (i.e. Turing complete), however, there are a few language features that can make the task MUCH easier. Here are some of them in rough order of importance: * A sequential compound data structure (e.g. arrays, lists, vectors, etc) * An associative compound data structure (e.g. a dictionary, hash-map, associative array, etc) * Function references (first class functions, function pointers, etc) * Real exception handling (try/catch, raise, throw, etc) * Variable argument functions (variadic, var args, splats, apply, etc) * Function closures * PCRE regular expressions In addition, the following will make your task especially easy: * Dynamic typing / boxed types (specifically, the ability to store different data types in the sequential and associative structures and the language keeps track of the type for you) * Compound data types support arbitrary runtime "hidden" data (metadata, metatables, dynamic fields attributes) Here are some examples of languages that have all of the above features: JavaScript, Ruby, Python, Lua, R, Clojure. Michael Fogus has some great blog posts on interesting but less well known languages and many of the languages on his lists do not yet have any mal implementations: * http://blog.fogus.me/2011/08/14/perlis-languages/ * http://blog.fogus.me/2011/10/18/programming-language-development-the-past-5-years/ Many of the most popular languages already have Mal implementations. However, this should not discourage you from creating your own implementation in a language that already has one. However, if you go this route, I suggest you avoid referring to the existing implementations (i.e. "cheating") to maximize your learning experience instead of just borrowing mine. On the other hand, if your goal is to add new implementations to mal as efficiently as possible, then you SHOULD find the most similar target language implementation and refer to it frequently. If you want a list of programming languages with an approximate measure of popularity try the [RedMonk Programming Language Rankings](https://redmonk.com/sogrady/2019/03/20/language-rankings-1-19/) or the [GitHut 2.0 Project](https://madnight.github.io/githut). ## Getting started * Install your chosen language interpreter/compiler, language package manager and build tools (if applicable) * Fork the mal repository on github and then clone your forked repository: ``` git clone git@github.com:YOUR_NAME/mal.git cd mal ``` * Make a new directory for your implementation. For example, if your language is called "quux": ``` mkdir impls/quux ``` * Modify the top level Makefile.impls to allow the tests to be run against your implementation. For example, if your language is named "quux" and uses "qx" as the file extension, then make the following 3 modifications to Makefile.impls: ``` IMPLS = ... quux ... ... quux_STEP_TO_PROG = impls/quux/$($(1)).qx ``` * Add a "run" script to your implementation directory that listens to the "STEP" environment variable for the implementation step to run and defaults to "stepA_mal". Make sure the run script has the executable file permission set (or else the test runner might fail with a permission denied error message). The following are examples of "run" scripts for a compiled language and an interpreted language (where the interpreter is named "quux"): ``` #!/usr/bin/env bash exec $(dirname $0)/${STEP:-stepA_mal} "${@}" ``` ``` #!/usr/bin/env bash exec quux $(dirname $0)/${STEP:-stepA_mal}.qx "${@}" ``` This allows you to run tests against your implementation like this: ``` make "test^quux^stepX" ``` If your implementation language is a compiled language, then you should also add a Makefile at the top level of your implementation directory. This Makefile will define how to build the files pointed to by the quux_STEP_TO_PROG macro. The top-level Makefile will attempt to build those targets before running tests. If it is a scripting language/uncompiled, then no Makefile is necessary because quux_STEP_TO_PROG will point to a source file that already exists and does not need to be compiled/built. ## General hints Stackoverflow and Google are your best friends. Modern polyglot developers do not memorize dozens of programming languages. Instead, they learn the peculiar terminology used with each language and then use this to search for their answers. Here are some other resources where multiple languages are compared/described: * http://learnxinyminutes.com/ * http://hyperpolyglot.org/ * http://rosettacode.org/ * http://rigaux.org/language-study/syntax-across-languages/ Do not let yourself be bogged down by specific problems. While the make-a-lisp process is structured as a series of steps, the reality is that building a lisp interpreter is more like a branching tree. If you get stuck on tail call optimization, or hash-maps, move on to other things. You will often have a stroke of inspiration for a problem as you work through other functionality. I have tried to structure this guide and the tests to make clear which things can be deferred until later. An aside on deferrable/optional bits: when you run the tests for a given step, the last tests are often marked with an "optional" header. This indicates that these are tests for functionality that is not critical to finish a basic mal implementation. Many of the steps in this process guide have a "Deferrable" section, however, it is not quite the same meaning. Those sections include the functionality that is marked as optional in the tests, but they also include functionality that becomes mandatory at a later step. In other words, this is a "make your own Lisp adventure". Use test driven development. Each step of the make-a-lisp process has a bunch of tests associated with it and there is an easy script to run all the tests for a specific step in the process. Pick a failing test, fix it, repeat until all the tests for that step pass. ## Reference Code The `process` directory contains abbreviated pseudocode and architecture diagrams for each step of the make-a-lisp process. Use a textual diff/comparison tool to compare the previous pseudocode step with the one you are working on. The architecture diagram images have changes from the previous step highlighted in red. There is also a concise [cheatsheet](http://kanaka.github.io/mal/cheatsheet.html) that summarizes the key changes at each step. If you get completely stuck and are feeling like giving up, then you should "cheat" by referring to the same step or functionality in an existing implementation language. You are here to learn, not to take a test, so do not feel bad about it. Okay, you should feel a little bit bad about it. ## The Make-A-Lisp Process Feel free to follow the guide as literally or as loosely as you like. You are here to learn; wandering off the beaten path may be the way you learn best. However, each step builds on the previous steps, so if you are new to Lisp or new to your implementation language then you may want to stick more closely to the guide your first time through to avoid frustration at later steps. In the steps that follow the name of the target language is "quux" and the file extension for that language is "qx". ### Step 0: The REPL ![step0_repl architecture](step0_repl.png) This step is basically just creating a skeleton of your interpreter. * Create a `step0_repl.qx` file in `impls/quux/`. * Add the 4 trivial functions `READ`, `EVAL`, `PRINT`, and `rep` (read-eval-print). `READ`, `EVAL`, and `PRINT` are basically just stubs that return their first parameter (a string if your target language is a statically typed) and `rep` calls them in order passing the return to the input of the next. * Add a main loop that repeatedly prints a prompt (needs to be "user> " for later tests to pass), gets a line of input from the user, calls `rep` with that line of input, and then prints out the result from `rep`. It should also exit when you send it an EOF (often Ctrl-D). * If you are using a compiled (ahead-of-time rather than just-in-time) language, then create a Makefile (or appropriate project definition file) in your directory. It is time to run your first tests. This will check that your program does input and output in a way that can be captured by the test harness. Go to the top level and run the following: ``` make "test^quux^step0" ``` Add and then commit your new `step0_repl.qx` and `Makefile` to git. Congratulations! You have just completed the first step of the make-a-lisp process. #### Optional: * Add full line editing and command history support to your interpreter REPL. Many languages have a library/module that provide line editing support. Another option if your language supports it is to use an FFI (foreign function interface) to load and call directly into GNU readline, editline, or linenoise library. Add line editing interface code to `readline.qx` ### Step 1: Read and Print ![step1_read_print architecture](step1_read_print.png) In this step, your interpreter will "read" the string from the user and parse it into an internal tree data structure (an abstract syntax tree) and then take that data structure and "print" it back to a string. In non-lisp languages, this step (called "lexing and parsing") can be one of the most complicated parts of the compiler/interpreter. In Lisp, the data structure that you want in memory is basically represented directly in the code that the programmer writes (homoiconicity). For example, if the string is "(+ 2 (* 3 4))" then the read function will process this into a tree structure that looks like this: ``` List / | \ / | \ / | \ Sym:+ Int:2 List / | \ / | \ / | \ Sym:* Int:3 Int:4 ``` Each left paren and its matching right paren (lisp "sexpr") becomes a node in the tree and everything else becomes a leaf in the tree. If you can find code for an implementation of a JSON encoder/decoder in your target language then you can probably just borrow and modify that and be 75% of the way done with this step. The rest of this section is going to assume that you are not starting from an existing JSON encoder/decoder, but that you do have access to a Perl compatible regular expressions (PCRE) module/library. You can certainly implement the reader using simple string operations, but it is more involved. The `make`, `ps` (postscript) and Haskell implementations have examples of a reader/parser without using regular expression support. * Copy `step0_repl.qx` to `step1_read_print.qx`. * Add a `reader.qx` file to hold functions related to the reader. * If the target language has object types (OOP), then the next step is to create a simple stateful Reader object in `reader.qx`. This object will store the tokens and a position. The Reader object will have two methods: `next` and `peek`. `next` returns the token at the current position and increments the position. `peek` just returns the token at the current position. * Add a function `read_str` in `reader.qx`. This function will call `tokenize` and then create a new Reader object instance with the tokens. Then it will call `read_form` with the Reader instance. * Add a function `tokenize` in `reader.qx`. This function will take a single string and return an array/list of all the tokens (strings) in it. The following regular expression (PCRE) will match all mal tokens. ``` [\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;.*|[^\s\[\]{}('"`,;)]*) ``` * For each match captured within the parenthesis starting at char 6 of the regular expression a new token will be created. * `[\s,]*`: Matches any number of whitespaces or commas. This is not captured so it will be ignored and not tokenized. * `~@`: Captures the special two-characters `~@` (tokenized). * ```[\[\]{}()'`~^@]```: Captures any special single character, one of ```[]{}()'`~^@``` (tokenized). * `"(?:\\.|[^\\"])*"?`: Starts capturing at a double-quote and stops at the next double-quote unless it was preceded by a backslash in which case it includes it until the next double-quote (tokenized). It will also match unbalanced strings (no ending double-quote) which should be reported as an error. * `;.*`: Captures any sequence of characters starting with `;` (tokenized). * ```[^\s\[\]{}('"`,;)]*```: Captures a sequence of zero or more non special characters (e.g. symbols, numbers, "true", "false", and "nil") and is sort of the inverse of the one above that captures special characters (tokenized). * Add the function `read_form` to `reader.qx`. This function will peek at the first token in the Reader object and switch on the first character of that token. If the character is a left paren then `read_list` is called with the Reader object. Otherwise, `read_atom` is called with the Reader Object. The return value from `read_form` is a mal data type. If your target language is statically typed then you will need some way for `read_form` to return a variant or subclass type. For example, if your language is object oriented, then you can define a top level MalType (in `types.qx`) that all your mal data types inherit from. The MalList type (which also inherits from MalType) will contain a list/array of other MalTypes. If your language is dynamically typed then you can likely just return a plain list/array of other mal types. * Add the function `read_list` to `reader.qx`. This function will repeatedly call `read_form` with the Reader object until it encounters a ')' token (if it reaches EOF before reading a ')' then that is an error). It accumulates the results into a List type. If your language does not have a sequential data type that can hold mal type values you may need to implement one (in `types.qx`). Note that `read_list` repeatedly calls `read_form` rather than `read_atom`. This mutually recursive definition between `read_list` and `read_form` is what allows lists to contain lists. * Add the function `read_atom` to `reader.qx`. This function will look at the contents of the token and return the appropriate scalar (simple/single) data type value. Initially, you can just implement numbers (integers) and symbols. This will allow you to proceed through the next couple of steps before you will need to implement the other fundamental mal types: nil, true, false, and string. The remaining scalar mal type, keyword does not need to be implemented until step A (but can be implemented at any point between this step and that). BTW, symbol types are just an object that contains a single string name value (some languages have symbol types already). * Add a file `printer.qx`. This file will contain a single function `pr_str` which does the opposite of `read_str`: take a mal data structure and return a string representation of it. But `pr_str` is much simpler and is basically just a switch statement on the type of the input object: * symbol: return the string name of the symbol * number: return the number as a string * list: iterate through each element of the list calling `pr_str` on it, then join the results with a space separator, and surround the final result with parens * Change the `READ` function in `step1_read_print.qx` to call `reader.read_str` and the `PRINT` function to call `printer.pr_str`. `EVAL` continues to simply return its input but the type is now a mal data type. You now have enough hooked up to begin testing your code. You can manually try some simple inputs: * `123` -> `123` * ` 123 ` -> `123` * `abc` -> `abc` * ` abc ` -> `abc` * `(123 456)` -> `(123 456)` * `( 123 456 789 ) ` -> `(123 456 789)` * `( + 2 (* 3 4) ) ` -> `(+ 2 (* 3 4))` To verify that your code is doing more than just eliminating extra spaces (and not failing), you can instrument your `reader.qx` functions. Once you have gotten past those simple manual tests, it is time to run the full suite of step 1 tests. Go to the top level and run the following: ``` make "test^quux^step1" ``` Fix any test failures related to symbols, numbers and lists. Depending on the functionality of your target language, it is likely that you have now just completed one of the most difficult steps. It is down hill from here. The remaining steps will probably be easier and each step will give progressively more bang for the buck. #### Deferrable: * Add support for the other basic data type to your reader and printer functions: string, nil, true, and false. Nil, true, and false become mandatory at step 4, strings at step 6. When a string is read, the following transformations are applied: a backslash followed by a doublequote is translated into a plain doublequote character, a backslash followed by "n" is translated into a newline, and a backslash followed by another backslash is translated into a single backslash. To properly print a string (for step 4 string functions), the `pr_str` function needs another parameter called `print_readably`. When `print_readably` is true, doublequotes, newlines, and backslashes are translated into their printed representations (the reverse of the reader). The `PRINT` function in the main program should call `pr_str` with print_readably set to true. * Add error checking to your reader functions to make sure parens are properly matched. Catch and print these errors in your main loop. If your language does not have try/catch style bubble up exception handling, then you will need to add explicit error handling to your code to catch and pass on errors without crashing. * Add support for reader macros which are forms that are transformed into other forms during the read phase. Refer to `tests/step1_read_print.mal` for the form that these macros should take (they are just simple transformations of the token stream). * Add support for the other mal types: keyword, vector, hash-map. * keyword: a keyword is a token that begins with a colon. A keyword can just be stored as a string with special unicode prefix like 0x29E (or char 0xff/127 if the target language does not have good unicode support) and the printer translates strings with that prefix back to the keyword representation. This makes it easy to use keywords as hash map keys in most languages. You can also store keywords as a unique data type, but you will need to make sure they can be used as hash map keys (which may involve doing a similar prefixed translation anyways). * vector: a vector can be implemented with same underlying type as a list as long as there is some mechanism to keep track of the difference. Vector literals are similar to lists, but use bracket as delimiters instead of parenthesis. For example, `[]` constructs an empty vector and `[1 "a"]` a vector with two elements. You can use the same reader function for both lists and vectors by adding parameters for the starting and ending tokens. * hash-map: a hash-map is an associative data structure that maps strings to other mal values. If you implement keywords as prefixed strings, then you only need a native associative data structure which supports string keys. Clojure allows any value to be a hash map key, but the base functionality in mal is to support strings and keyword keys. Hash-map literals are constructed with braces delimiters. For example, `{}` constructs an empty map, `{"a" 1 :b "whatever"}` associates the `a` key to an integer value and the `:b` key to a string value. Because of the representation of hash-maps as an alternating sequence of keys and values, you can probably use the same reader function for hash-maps as lists and vectors with parameters to indicate the starting and ending tokens. The odd tokens are then used for keys with the corresponding even tokens as the values. * Add comment support to your reader. The tokenizer should ignore tokens that start with ";". Your `read_str` function will need to properly handle when the tokenizer returns no values. The simplest way to do this is to return `nil` mal value. A cleaner option (that does not print `nil` at the prompt is to throw a special exception that causes the main loop to simply continue at the beginning of the loop without calling `rep`. ### Step 2: Eval ![step2_eval architecture](step2_eval.png) In step 1 your mal interpreter was basically just a way to validate input and eliminate extraneous white space. In this step you will turn your interpreter into a simple number calculator by adding functionality to the evaluator (`EVAL`). Compare the pseudocode for step 1 and step 2 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step1_read_print.txt ../../process/step2_eval.txt ``` * Copy `step1_read_print.qx` to `step2_eval.qx`. * Define a simple initial REPL environment. This environment is an associative structure that maps symbols (or symbol names) to numeric functions. For example, in python this would look something like this: ``` repl_env = {'+': lambda a,b: a+b, '-': lambda a,b: a-b, '*': lambda a,b: a*b, '/': lambda a,b: int(a/b)} ``` * Modify the `rep` function to pass the REPL environment as the second parameter for the `EVAL` call. * In `EVAL`, switch on the type of the first parameter `ast` as follows: * symbol: lookup the symbol in the environment structure and return the value. If the key is missing, throw/raise a "not found" error. * `ast` is a non-empty list: call `EVAL` on each of the members of the list. Take the first evaluated item and call it as function using the rest of the evaluated items as its arguments. * otherwise just return the original `ast` value If your target language does not have full variable length argument support (e.g. variadic, vararg, splats, apply) then you will need to pass the full list of arguments as a single parameter and split apart the individual values inside of every mal function. This is annoying, but workable. The process of taking a list and invoking or executing it to return something new is known in Lisp as the "apply" phase. Try some simple expressions: * `(+ 2 3)` -> `5` * `(+ 2 (* 3 4))` -> `14` The most likely challenge you will encounter is how to properly call a function reference using an arguments list. Now go to the top level, run the step 2 tests and fix the errors. ``` make "test^quux^step2" ``` You now have a simple prefix notation calculator! #### Deferrable: * Add a print statement at the top of the main `eval` function, for debugging issues or simply figuring how evaluation works. The statement should be active when `env` contains the `DEBUG-EVAL` key and the associated value is neither `nil` nor `false`. For consistency, it should print "EVAL: " followed by the current value of `ast` formatted with `pr_str` with the readably flag set. Feel free to add any information you see fit, for example the contents of `env`. * `EVAL` should evaluate elements of vectors and hash-maps. Add the following cases in `EVAL`: * If `ast` is a vector: return a new vector that is the result of calling `EVAL` on each of the members of the vector. * If `ast` is a hash-map: return a new hash-map which consists of key-value pairs where the key is a key from the hash-map and the value is the result of calling `EVAL` on the corresponding value. Depending on the implementation of maps, it may be convenient to also call `EVAL` on keys. The result is the same because keys are not affected by evaluation. ### Step 3: Environments ![step3_env architecture](step3_env.png) In step 2 you were already introduced to REPL environment (`repl_env`) where the basic numeric functions were stored and looked up. In this step you will add the ability to create new environments (`let*`) and modify existing environments (`def!`). A Lisp environment is an associative data structure that maps symbols (the keys) to values. But Lisp environments have an additional important function: they can refer to another environment (the outer environment). During environment lookups, if the current environment does not have the symbol, the lookup continues in the outer environment, and continues this way until the symbol is either found, or the outer environment is `nil` (the outermost environment in the chain). Compare the pseudocode for step 2 and step 3 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step2_eval.txt ../../process/step3_env.txt ``` * Copy `step2_eval.qx` to `step3_env.qx`. * Create `env.qx` to hold the environment definition. * Define an `Env` object that is instantiated with a single `outer` parameter and starts with an empty associative data structure property `data`. * Define three methods for the Env object: * set: takes a symbol key and a mal value and adds to the `data` structure * get: takes a symbol key and if the current environment contains that key then return the matching value. If no key is found and outer is not `nil` then call get (recurse) on the outer environment. Depending on the host language, a loop structure may be more simple or efficient than a recursion. If no key is found up the outer chain, then report that the key is missing with the most idiomatic mechanism. * Update `step3_env.qx` to use the new `Env` type to create the repl_env (with a `nil` outer value) and use the `set` method to add the numeric functions. * Modify `EVAL` to call the `get` method on the `env` parameter. * Modify the apply section of `EVAL` to switch on the first element of the list: * symbol "def!": call the set method of the current environment (second parameter of `EVAL` called `env`) using the unevaluated first parameter (second list element) as the symbol key and the evaluated second parameter as the value. * symbol "let\*": create a new environment using the current environment as the outer value and then use the first parameter as a list of new bindings in the "let\*" environment. Take the second element of the binding list, call `EVAL` using the new "let\*" environment as the evaluation environment, then call `set` on the "let\*" environment using the first binding list element as the key and the evaluated second element as the value. This is repeated for each odd/even pair in the binding list. Note in particular, the bindings earlier in the list can be referred to by later bindings. Finally, the second parameter (third element) of the original `let*` form is evaluated using the new "let\*" environment and the result is returned as the result of the `let*` (the new let environment is discarded upon completion). * otherwise: proceed as before. `def!` and `let*` are Lisp "specials" (or "special atoms") which means that they are language level features and more specifically that the rest of the list elements (arguments) may be evaluated differently (or not at all) unlike the default apply case where all elements of the list are evaluated before the first element is invoked. Lists which contain a "special" as the first element are known as "special forms". They are special because they follow special evaluation rules. Try some simple environment tests: * `(def! a 6)` -> `6` * `a` -> `6` * `(def! b (+ a 2))` -> `8` * `(+ a b)` -> `14` * `(let* (c 2) c)` -> `2` Now go to the top level, run the step 3 tests and fix the errors. ``` make "test^quux^step3" ``` Your mal implementation is still basically just a numeric calculator with save/restore capability. But you have set the foundation for step 4 where it will begin to feel like a real programming language. An aside on mutation and typing: The "!" suffix on symbols is used to indicate that this symbol refers to a function that mutates something else. In this case, the `def!` symbol indicates a special form that will mutate the current environment. Many (maybe even most) of runtime problems that are encountered in software engineering are a result of mutation. By clearly marking code where mutation may occur, you can more easily track down the likely cause of runtime problems when they do occur. Another cause of runtime errors is type errors, where a value of one type is unexpectedly treated by the program as a different and incompatible type. Statically typed languages try to make the programmer solve all type problems before the program is allowed to run. Most Lisp variants tend to be dynamically typed (types of values are checked when they are actually used at runtime). As an aside-aside: The great debate between static and dynamic typing can be understood by following the money. Advocates of strict static typing use words like "correctness" and "safety" and thus get government and academic funding. Advocates of dynamic typing use words like "agile" and "time-to-market" and thus get venture capital and commercial funding. ### Step 4: If Fn Do ![step4_if_fn_do architecture](step4_if_fn_do.png) In step 3 you added environments and the special forms for manipulating environments. In this step you will add 3 new special forms (`if`, `fn*` and `do`) and add several more core functions to the default REPL environment. Our new architecture will look like this: The `fn*` special form is how new user-defined functions are created. In some Lisps, this special form is named "lambda". Compare the pseudocode for step 3 and step 4 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step3_env.txt ../../process/step4_if_fn_do.txt ``` * Copy `step3_env.qx` to `step4_if_fn_do.qx`. * If you have not implemented reader and printer support (and data types) for `nil`, `true` and `false`, you will need to do so for this step. * Update the constructor/initializer for environments to take two new parameters: `binds` and `exprs`. Bind (`set`) each element (symbol) of the `binds` list to the respective element of the `exprs` list. * Add support to `printer.qx` to print function values. A string literal like "#\" is sufficient. * Add the following special forms to `EVAL`: * `do`: Evaluate all the elements of the list and return the final evaluated element. * `if`: Evaluate the first parameter (second element). If the result (condition) is anything other than `nil` or `false`, then evaluate the second parameter (third element of the list) and return the result. Otherwise, evaluate the third parameter (fourth element) and return the result. If condition is false and there is no third parameter, then just return `nil`. * `fn*`: Return a new function closure. The body of that closure does the following: * Create a new environment using `env` (closed over from outer scope) as the `outer` parameter, the first parameter (second list element of `ast` from the outer scope) as the `binds` parameter, and the parameters to the closure as the `exprs` parameter. * Call `EVAL` on the second parameter (third list element of `ast` from outer scope), using the new environment. Use the result as the return value of the closure. If your target language does not support closures, then you will need to implement `fn*` using some sort of structure or object that stores the values being closed over: the first and second elements of the `ast` list (function parameter list and function body) and the current environment `env`. In this case, your native functions will need to be wrapped in the same way. You will probably also need a method/function that invokes your function object/structure for the default case of the apply section of `EVAL`. Try out the basic functionality you have implemented: * `(fn* (a) a)` -> `#` * `( (fn* (a) a) 7)` -> `7` * `( (fn* (a) (+ a 1)) 10)` -> `11` * `( (fn* (a b) (+ a b)) 2 3)` -> `5` * Add a new file `core.qx` and define an associative data structure `ns` (namespace) that maps symbols to functions. Move the numeric function definitions into this structure. * Modify `step4_if_fn_do.qx` to iterate through the `core.ns` structure and add (`set`) each symbol/function mapping to the REPL environment (`repl_env`). * Add the following functions to `core.ns`: * `prn`: call `pr_str` on the first parameter with `print_readably` set to true, print the result to the screen and then return `nil`. Note that the full version of `prn` is a deferrable below. * `list`: take the parameters and return them as a list. * `list?`: return true if the first parameter is a list, false otherwise. * `empty?`: treat the first parameter as a list and return true if the list is empty and false if it contains any elements. * `count`: treat the first parameter as a list and return the number of elements that it contains. * `=`: compare the first two parameters and return true if they are the same type and contain the same value. In the case of equal length lists, each element of the list should be compared for equality and if they are the same return true, otherwise false. * `<`, `<=`, `>`, and `>=`: treat the first two parameters as numbers and do the corresponding numeric comparison, returning either true or false. Now go to the top level, run the step 4 tests. There are a lot of tests in step 4 but all of the non-optional tests that do not involve strings should be able to pass now. ``` make "test^quux^step4" ``` Your mal implementation is already beginning to look like a real language. You have flow control, conditionals, user-defined functions with lexical scope, side-effects (if you implement the string functions), etc. However, our little interpreter has not quite reached Lisp-ness yet. The next several steps will take your implementation from a neat toy to a full featured language. #### Deferrable: * Implement Clojure-style variadic function parameters. Modify the constructor/initializer for environments, so that if a "&" symbol is encountered in the `binds` list, the next symbol in the `binds` list after the "&" is bound to the rest of the `exprs` list that has not been bound yet. * Define a `not` function using mal itself. In `step4_if_fn_do.qx` call the `rep` function with this string: "(def! not (fn* (a) (if a false true)))". * Implement the string functions in `core.qx`. To implement these functions, you will need to implement the string support in the reader and printer (deferrable section of step 1). Each of the string functions takes multiple mal values, prints them (`pr_str`) and joins them together into a new string. * `pr-str`: calls `pr_str` on each argument with `print_readably` set to true, joins the results with " " and returns the new string. * `str`: calls `pr_str` on each argument with `print_readably` set to false, concatenates the results together ("" separator), and returns the new string. * `prn`: calls `pr_str` on each argument with `print_readably` set to true, joins the results with " ", prints the string to the screen and then returns `nil`. * `println`: calls `pr_str` on each argument with `print_readably` set to false, joins the results with " ", prints the string to the screen and then returns `nil`. ### Step 5: Tail call optimization ![step5_tco architecture](step5_tco.png) In step 4 you added special forms `do`, `if` and `fn*` and you defined some core functions. In this step you will add a Lisp feature called tail call optimization (TCO). Also called "tail recursion" or sometimes just "tail calls". Several of the special forms that you have defined in `EVAL` end up calling back into `EVAL`. For those forms that call `EVAL` as the last thing that they do before returning (tail call) you will just loop back to the beginning of eval rather than calling it again. The advantage of this approach is that it avoids adding more frames to the call stack. This is especially important in Lisp languages because they tend to prefer using recursion instead of iteration for control structures. (Though some Lisps, such as Common Lisp, have iteration.) However, with tail call optimization, recursion can be made as stack efficient as iteration. Compare the pseudocode for step 4 and step 5 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step4_if_fn_do.txt ../../process/step5_tco.txt ``` * Copy `step4_if_fn_do.qx` to `step5_tco.qx`. * Add a loop (e.g. while true) around all code in `EVAL`. * Modify each of the following form cases to add tail call recursion support: * `let*`: remove the final `EVAL` call on the second `ast` argument (third list element). Set `env` (i.e. the local variable passed in as second parameter of `EVAL`) to the new let environment. Set `ast` (i.e. the local variable passed in as first parameter of `EVAL`) to be the second `ast` argument. Continue at the beginning of the loop (no return). * `do`: change the implementation to evaluate all the parameters except for the last (2nd list element up to but not including last). Set `ast` to the last element of `ast`. Continue at the beginning of the loop (`env` stays unchanged). * `if`: the condition continues to be evaluated, however, rather than evaluating the true or false branch, `ast` is set to the unevaluated value of the chosen branch. Continue at the beginning of the loop (`env` is unchanged). * The return value from the `fn*` special form will now become an object/structure with attributes that allow the default invoke case of `EVAL` to do TCO on mal functions. Those attributes are: * `ast`: the second `ast` argument (third list element) representing the body of the function. * `params`: the first `ast` argument (second list element) representing the parameter names of the function. * `env`: the current value of the `env` parameter of `EVAL`. * `fn`: the original function value (i.e. what was return by `fn*` in step 4). Note that this is deferrable until step 9 when it is required for the `map` and `apply` core functions). You will also need it in step 6 if you choose to not to defer atoms/`swap!` from that step. * The default "apply"/invoke case of `EVAL` must now be changed to account for the new object/structure returned by the `fn*` form. Once each element of `ast` is evaluated, the first element of the result of `eval_ast` is `f` and the remaining elements are in `args`. Switch on the type of `f`: * regular function (not one defined by `fn*`): apply/invoke it as before (in step 4). * a `fn*` value: set `ast` to the `ast` attribute of `f`. Generate a new environment using the `env` and `params` attributes of `f` as the `outer` and `binds` arguments and `args` as the `exprs` argument. Set `env` to the new environment. Continue at the beginning of the loop. Run some manual tests from previous steps to make sure you have not broken anything by adding TCO. Now go to the top level, run the step 5 tests. ``` make "test^quux^step5" ``` Look at the step 5 test file `tests/step5_tco.mal`. The `sum-to` function cannot be tail call optimized because it does something after the recursive call (`sum-to` calls itself and then does the addition). Lispers say that the `sum-to` is not in tail position. The `sum2` function however, calls itself from tail position. In other words, the recursive call to `sum2` is the last action that `sum2` does. Calling `sum-to` with a large value will cause a stack overflow exception in most target languages (some have super-special tricks they use to avoid stack overflows). Congratulations, your mal implementation already has a feature (TCO) that most mainstream languages lack. ### Step 6: Files, Mutation, and Evil ![step6_file architecture](step6_file.png) In step 5 you added tail call optimization. In this step you will add some string and file operations and give your implementation a touch of evil ... er, eval. And as long as your language supports function closures, this step will be quite simple. However, to complete this step, you must implement string type support, so if you have been holding off on that you will need to go back and do so. Compare the pseudocode for step 5 and step 6 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step5_tco.txt ../../process/step6_file.txt ``` * Copy `step5_tco.qx` to `step6_file.qx`. * Add two new string functions to the core namespaces: * `read-string`: this function just exposes the `read_str` function from the reader. If your mal string type is not the same as your target language (e.g. statically typed language) then your `read-string` function will need to unbox (extract) the raw string from the mal string type in order to call `read_str`. * `slurp`: this function takes a file name (string) and returns the contents of the file as a string. Once again, if your mal string type wraps a raw target language string, then you will need to unmarshall (extract) the string parameter to get the raw file name string and marshall (wrap) the result back to a mal string type. * In your main program, add a new symbol "eval" to your REPL environment. The value of this new entry is a function that takes a single argument `ast`. The closure calls your `EVAL` function using the `ast` as the first argument and the REPL environment (closed over from outside) as the second argument. The result of the `EVAL` call is returned. This simple but powerful addition allows your program to treat mal data as a mal program. For example, you can now do this: ``` (def! mal-prog (list + 1 2)) (eval mal-prog) ``` * Define a `load-file` function using mal itself. In your main program call the `rep` function with this string: "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))". Try out `load-file`: * `(load-file "../tests/incA.mal")` -> `9` * `(inc4 3)` -> `7` The `load-file` function does the following: * Call `slurp` to read in a file by name. Surround the contents with "(do ...)" so that the whole file will be treated as a single program AST (abstract syntax tree). Add a new line in case the files ends with a comment. The `nil` ensures a short and predictable result, instead of what happens to be the last function defined in the loaded file. * Call `read-string` on the string returned from `slurp`. This uses the reader to read/convert the file contents into mal data/AST. * Call `eval` (the one in the REPL environment) on the AST returned from `read-string` to "run" it. Besides adding file and eval support, we'll add support for the atom data type in this step. An atom is the Mal way to represent *state*; it is heavily inspired by [Clojure's atoms](http://clojure.org/state). An atom holds a reference to a single Mal value of any type; it supports reading that Mal value and *modifying* the reference to point to another Mal value. Note that this is the only Mal data type that is mutable (but the Mal values it refers to are still immutable; immutability is explained in greater detail in step 7). You'll need to add 5 functions to the core namespace to support atoms: * `atom`: Takes a Mal value and returns a new atom which points to that Mal value. * `atom?`: Takes an argument and returns `true` if the argument is an atom. * `deref`: Takes an atom argument and returns the Mal value referenced by this atom. * `reset!`: Takes an atom and a Mal value; the atom is modified to refer to the given Mal value. The Mal value is returned. * `swap!`: Takes an atom, a function, and zero or more function arguments. The atom's value is modified to the result of applying the function with the atom's value as the first argument and the optionally given function arguments as the rest of the arguments. The new atom's value is returned. (Side note: Mal is single-threaded, but in concurrent languages like Clojure, `swap!` promises atomic update: `(swap! myatom (fn* [x] (+ 1 x)))` will always increase the `myatom` counter by one and will not suffer from missing updates when the atom is updated from multiple threads.) Optionally, you can add a reader macro `@` which will serve as a short form for `deref`, so that `@a` is equivalent to `(deref a)`. In order to do that, modify the conditional in reader function `read_form` and add a case which deals with the `@` token: if the token is `@` (at sign) then return a new list that contains the symbol `deref` and the result of reading the next form (`read_form`). Now go to the top level, run the step 6 tests. The optional tests will need support from the reader for comments, vectors, hash-maps and the `@` reader macro: ``` make "test^quux^step6" ``` Congratulations, you now have a full-fledged scripting language that can run other mal programs. The `slurp` function loads a file as a string, the `read-string` function calls the mal reader to turn that string into data, and the `eval` function takes data and evaluates it as a normal mal program. However, it is important to note that the `eval` function is not just for running external programs. Because mal programs are regular mal data structures, you can dynamically generate or manipulate those data structures before calling `eval` on them. This isomorphism (same shape) between data and programs is known as "homoiconicity". Lisp languages are homoiconic and this property distinguishes them from most other programming languages. Your mal implementation is quite powerful already but the set of functions that are available (from `core.qx`) is fairly limited. The bulk of the functions you will add are described in step 9 and step A, but you will begin to flesh them out over the next few steps to support quoting (step 7) and macros (step 8). #### Deferrable: * Add the ability to run another mal program from the command line. Prior to the REPL loop, check if your mal implementation is called with command line arguments. If so, treat the first argument as a filename and use `rep` to call `load-file` on that filename, and finally exit/terminate execution. * Add the rest of the command line arguments to your REPL environment so that programs that are run with `load-file` have access to their calling environment. Add a new "\*ARGV\*" (symbol) entry to your REPL environment. The value of this entry should be the rest of the command line arguments as a mal list value. ### Step 7: Quoting ![step7_quote architecture](step7_quote.png) In step 7 you will add the special forms `quote` and `quasiquote` and add supporting core functions `cons` and `concat`. The two quote forms add a powerful abstraction for manipulating mal code itself (meta-programming). The `quote` special form indicates to the evaluator (`EVAL`) that the parameter should not be evaluated (yet). At first glance, this might not seem particularly useful but an example of what this enables is the ability for a mal program to refer to a symbol itself rather than the value that it evaluates to. Likewise with lists. For example, consider the following: * `(prn abc)`: this will lookup the symbol `abc` in the current evaluation environment and print it. This will result in an error if `abc` is not defined. * `(prn (quote abc))`: this will print "abc" (prints the symbol itself). This will work regardless of whether `abc` is defined in the current environment. * `(prn (1 2 3))`: this will result in an error because `1` is not a function and cannot be applied to the arguments `(2 3)`. * `(prn (quote (1 2 3)))`: this will print "(1 2 3)". * `(def! l (quote (1 2 3)))`: list quoting allows us to define lists directly in the code (list literal). Another way of doing this is with the list function: `(def! l (list 1 2 3))`. The second special quoting form is `quasiquote`. This allows a quoted list to have internal elements of the list that are temporarily 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 (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 `splice-unquote` also turns evaluation back on for its argument, but the evaluated value must be a list which is then "spliced" into the quasiquoted list. The true power of the quasiquote form will be manifest when it is used together with macros (in the next step). Compare the pseudocode for step 6 and step 7 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step6_file.txt ../../process/step7_quote.txt ``` * Copy `step6_file.qx` to `step7_quote.qx`. * Before implementing the quoting forms, you will need to implement some supporting functions in the core namespace: * `cons`: this function takes a list as its second parameter and returns a new list that has the first argument prepended to it. * `concat`: this functions takes 0 or more lists as parameters and returns a new list that is a concatenation of all the list parameters. An aside on immutability: note that neither cons or concat mutate their original list arguments. Any references to them (i.e. other lists that they may be "contained" in) will still refer to the original unchanged value. Mal, like Clojure, is a language which uses immutable data structures. I encourage you to read about the power and importance of immutability as implemented in Clojure (from which 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` function. The `quasiquote` function takes a parameter `ast` and has the following conditional. - If `ast` is a list starting with the "unquote" symbol, return its second element. - If `ast` is a list failing the previous test, the result will be a 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 easier. * Add the `quasiquote` special form. This form calls the `quasiquote` function using the first `ast` argument (second list element), then evaluates the result in the current environment, 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: ``` make "test^quux^step7" ``` If some tests do not pass, it may be convenient to enable the debug print statement at the top of your main `eval` function (inside the TCO loop). The quasiquoted but yet unevaluated AST will often reveal the source of the issue. Quoting is one of the more mundane functions available in mal, but do not let that discourage you. Your mal implementation is almost complete, and quoting sets the stage for the next very exciting step: macros. #### Deferrable * The full names for the quoting forms are fairly verbose. Most Lisp languages have a short-hand syntax and Mal is no exception. These short-hand syntaxes are known as reader macros because they allow us to manipulate mal code during the reader phase. Macros that run during the eval phase are just called "macros" and are described in the next section. Expand the conditional in reader function `read_form` to add the following four cases: * token is "'" (single quote): return a new list that contains the symbol "quote" and the result of reading the next form (`read_form`). * token is "\`" (back-tick): return a new list that contains the symbol "quasiquote" and the result of reading the next form (`read_form`). * token is "~" (tilde): return a new list that contains the symbol "unquote" and the result of reading the next form (`read_form`). * token is "~@" (tilde + at sign): return a new list that contains the symbol "splice-unquote" and the result of reading the next form (`read_form`). * 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 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 `unquote`. ### Step 8: Macros ![step8_macros architecture](step8_macros.png) Your mal implementation is now ready for one of the most lispy and exciting of all programming concepts: macros. In the previous step, quoting enabled some simple manipulation data structures and therefore manipulation of mal code (because the `eval` function from step 6 turns mal data into code). In this step you will be able to mark mal functions as macros which can manipulate mal code before it is evaluated. In other words, macros are user-defined special forms. Or to look at it another way, macros allow mal programs to redefine the mal language itself. Compare the pseudocode for step 7 and step 8 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step7_quote.txt ../../process/step8_macros.txt ``` * Copy `step7_quote.qx` to `step8_macros.qx`. You might think that the infinite power of macros would require some sort of complex mechanism, but the implementation is actually fairly simple. * Add a new attribute `is_macro` to mal function types. This should default to false. * Add a new special form `defmacro!`. This is very similar to the `def!` form, but before the evaluated value (mal function) is set in the environment, the `is_macro` attribute should be set to true. * In `EVAL`, when `ast` is a non-empty list without leading special form, the normal apply phase evaluates all elements of `ast`. Start by evaluating the first element separately. The result must be a function. If this function does have the `is_macro` attribute set, * apply the function to the (unevaluated) remaining elements of `ast`, producing a new form. * evaluate the new form in the `env` environment. Of course, instead of recursively calling `EVAL`, replace `ast` with the new form and restart the TCO loop. For functions without the attribute, proceed as before: evaluate the remaining elements of `ast`, then apply the function to them. If you check existing implementations, be warned that former versions of this guide were describing a slightly different macro expansion mechanism. Now go to the top level, run the step 8 tests: ``` make "test^quux^step8" ``` There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me recommend an approach: * Enable the debug print statement at the top of your main `eval` function (inside the TCO loop). The expanded but yet unevaluated AST will often reveal the source of the issue. * Pull up the step8 implementation from another language and uncomment its `eval` function (yes, I give you permission to violate the rule this once). Run the two side-by-side. The first difference is likely to point to the bug. Congratulations! You now have a Lisp interpreter with a super power that most non-Lisp languages can only dream of (I have it on good authority that languages dream when you are not using them). If you are not already familiar with Lisp macros, I suggest the following exercise: write a recursive macro that handles postfixed mal code (with the function as the last parameter instead of the first). Or not. I have not actually done so myself, but I have heard it is an interesting exercise. In the next step you will add try/catch style exception handling to your implementation in addition to some new core functions. After step9 you will be very close to having a fully self-hosting mal implementation. Let us continue! #### Deferrable * Add the following new core functions which are frequently used in macro functions: * `nth`: this function takes a list (or vector) and a number (index) as arguments, returns the element of the list at the given index. If the index is out of range, this function raises an exception. * `first`: this function takes a list (or vector) as its argument and returns the first element. If the list (or vector) is empty or is `nil` then `nil` is returned. * `rest`: this function takes a list (or vector) as its argument and returns a new list containing all the elements except the first. If the list (or vector) is empty or is `nil` then `()` (empty list) is returned. * In the main program, call the `rep` function with the following string argument to define a new control structure. ``` "(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)))))))" ``` * Note that `cond` calls the `throw` function when `cond` is called with an odd number of args. The `throw` function is implemented in the next step, but it will still serve it's purpose here by causing an undefined symbol error. ### Step 9: Try ![step9_try architecture](step9_try.png) In this step you will implement the final mal special form for error/exception handling: `try*/catch*`. You will also add several core functions to your implementation. In particular, you will enhance the functional programming pedigree of your implementation by adding the `apply` and `map` core functions. Compare the pseudocode for step 8 and step 9 to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step8_macros.txt ../../process/step9_try.txt ``` * Copy `step8_macros.qx` to `step9_try.qx`. * Add the `try*/catch*` special form to the EVAL function. The try catch form looks like this: `(try* A (catch* B C))`. The form `A` is evaluated, if it throws an exception, then form `C` is evaluated with a new environment that binds the symbol `B` to the value of the exception that was thrown. * If your target language has built-in try/catch style exception handling then you are already 90% of the way done. Add a (native language) try/catch block that evaluates `A` within the try block and catches all exceptions. If an exception is caught, then translate it to a mal type/value. For native exceptions this is either the message string or a mal hash-map that contains the message string and other attributes of the exception. When a regular mal type/value is used as an exception, you will probably need to store it within a native exception type in order to be able to convey/transport it using the native try/catch mechanism. Then you will extract the mal type/value from the native exception. Create a new mal environment that binds `B` to the value of the exception. Finally, evaluate `C` using that new environment. * If your target language does not have built-in try/catch style exception handling then you have some extra work to do. One of the most straightforward approaches is to create a a global error variable that stores the thrown mal type/value. The complication is that there are a bunch of places where you must check to see if the global error state is set and return without proceeding. The rule of thumb is that this check should happen at the top of your EVAL function and also right after any call to EVAL (and after any function call that might happen to call EVAL further down the chain). Yes, it is ugly, but you were warned in the section on picking a language. * Add the `throw` core function. * If your language supports try/catch style exception handling, then this function takes a mal type/value and throws/raises it as an exception. In order to do this, you may need to create a custom exception object that wraps a mal value/type. * If your language does not support try/catch style exception handling, then set the global error state to the mal type/value. * Add the `apply` and `map` core functions. In step 5, if you did not add the original function (`fn`) to the structure returned from `fn*`, then you will need to do so now. * `apply`: takes at least two arguments. The first argument is a function and the last argument is a list (or vector). The function may be either a built-in core function, an user function constructed with the `fn*` special form, or a macro, not distinguished from the underlying user function). The arguments between the function and the last argument (if there are any) are concatenated with the final argument to create the arguments that are used to call the function. The apply function allows a function to be called with arguments that are contained in a list (or vector). In other words, `(apply F A B [C D])` is equivalent to `(F A B C D)`. * `map`: takes a function and a list (or vector) and evaluates the function against every element of the list (or vector) one at a time and returns the results as a list. * Add some type predicate core functions. In Lisp, predicates are functions that return true/false (or true value/nil) and typically end in "?" or "p". * `nil?`: takes a single argument and returns true (mal true value) if the argument is nil (mal nil value). * `true?`: takes a single argument and returns true (mal true value) if the argument is a true value (mal true value). * `false?`: takes a single argument and returns true (mal true value) if the argument is a false value (mal false value). * `symbol?`: takes a single argument and returns true (mal true value) if the argument is a symbol (mal symbol value). Now go to the top level, run the step 9 tests: ``` make "test^quux^step9" ``` Your mal implementation is now essentially a fully featured Lisp interpreter. But if you stop now you will miss one of the most satisfying and enlightening aspects of creating a mal implementation: self-hosting. #### Deferrable * Add the following new core functions: * `symbol`: takes a string and returns a new symbol with the string as its name. * `keyword`: takes a string and returns a keyword with the same name (usually just be prepending the special keyword unicode symbol). This function should also detect if the argument is already a keyword and just return it. * `keyword?`: takes a single argument and returns true (mal true value) if the argument is a keyword, otherwise returns false (mal false value). * `vector`: takes a variable number of arguments and returns a vector containing those arguments. * `vector?`: takes a single argument and returns true (mal true value) if the argument is a vector, otherwise returns false (mal false value). * `sequential?`: takes a single argument and returns true (mal true value) if it is a list or a vector, otherwise returns false (mal false value). * `hash-map`: takes a variable but even number of arguments and returns a new mal hash-map value with keys from the odd arguments and values from the even arguments respectively. This is basically the functional form of the `{}` reader literal syntax. * `map?`: takes a single argument and returns true (mal true value) if the argument is a hash-map, otherwise returns false (mal false value). * `assoc`: takes a hash-map as the first argument and the remaining arguments are odd/even key/value pairs to "associate" (merge) into the hash-map. Note that the original hash-map is unchanged (remember, mal values are immutable), and a new hash-map containing the old hash-maps key/values plus the merged key/value arguments is returned. * `dissoc`: takes a hash-map and a list of keys to remove from the hash-map. Again, note that the original hash-map is unchanged and a new hash-map with the keys removed is returned. Key arguments that do not exist in the hash-map are ignored. * `get`: takes a hash-map and a key and returns the value of looking up that key in the hash-map. If the key is not found in the hash-map then nil is returned. * `contains?`: takes a hash-map and a key and returns true (mal true value) if the key exists in the hash-map and false (mal false value) otherwise. * `keys`: takes a hash-map and returns a list (mal list value) of all the keys in the hash-map. * `vals`: takes a hash-map and returns a list (mal list value) of all the values in the hash-map. ### Step A: Metadata, Self-hosting and Interop ![stepA_mal architecture](stepA_mal.png) You have reached the final step of your mal implementation. This step is kind of a catchall for things that did not fit into other steps. But most importantly, the changes you make in this step will unlock the magical power known as "self-hosting". You might have noticed that one of the languages that mal is implemented in is "mal". Any mal implementation that is complete enough can run the mal implementation of mal. You might need to pull out your hammock and ponder this for a while if you have never built a compiler or interpreter before. Look at the step source files for the mal implementation of mal (it is not cheating now that you have reached step A). If you deferred the implementation of keywords, vectors and hash-maps, now is the time to go back and implement them if you want your implementation to self-host. Compare the pseudocode for step 9 and step A to get a basic idea of the changes that will be made during this step: ``` diff -u ../../process/step9_try.txt ../../process/stepA_mal.txt ``` * Copy `step9_try.qx` to `stepA_mal.qx`. * Add the `readline` core function. This functions takes a string that is used to prompt the user for input. The line of text entered by the user is returned as a string. If the user sends an end-of-file (usually Ctrl-D), then nil is returned. * Add a new "\*host-language\*" (symbol) entry to your REPL environment. The value of this entry should be a mal string containing the name of the current implementation. * When the REPL starts up (as opposed to when it is called with a script and/or arguments), call the `rep` function with this string to print a startup header: "(println (str \"Mal [\" \*host-language\* \"]\"))". * Ensure that the REPL environment contains definitions for `time-ms`, `meta`, `with-meta`, `fn?` `string?`, `number?`, `seq`, and `conj`. It doesn't really matter what they do at this stage: they just need to be defined. Making them functions that raise a "not implemented" exception would be fine. Now go to the top level, run the step A tests: ``` make "test^quux^stepA" ``` Once you have passed all the non-optional step A tests, it is time to try self-hosting. Run your step A implementation as normal, but use the file argument mode you added in step 6 to run each step from the mal implementation: ``` ./stepA_mal.qx ../mal/step1_read_print.mal ./stepA_mal.qx ../mal/step2_eval.mal ... ./stepA_mal.qx ../mal/step9_try.mal ./stepA_mal.qx ../mal/stepA_mal.mal ``` There is a very good chance that you will encounter an error at some point while trying to run the mal in mal implementation steps above. Debugging failures that happen while self-hosting is MUCH more difficult and mind bending. One of the best approaches I have personally found is to add prn statements to the mal implementation step (not your own implementation of mal) that is causing problems. Another approach I have frequently used is to pull out the code from the mal implementation that is causing the problem and simplify it step by step until you have a simple piece of mal code that still reproduces the problem. Once the reproducer is simple enough you will probably know where in your own implementation that problem is likely to be. Please add your simple reproducer as a test case so that future implementers will fix similar issues in their code before they get to self-hosting when it is much more difficult to track down and fix. Once you can manually run all the self-hosted steps, it is time to run all the tests in self-hosted mode: ``` make MAL_IMPL=quux "test^mal" ``` When you run into problems (which you almost certainly will), use the same process described above to debug them. Congratulations!!! When all the tests pass, you should pause for a moment and consider what you have accomplished. You have implemented a Lisp interpreter that is powerful and complete enough to run a large mal program which is itself an implementation of the mal language. You might even be asking if you can continue the "inception" by using your implementation to run a mal implementation which itself runs the mal implementation. #### Optional additions * Add meta-data support to composite data types (lists, vectors and hash-maps), and to functions (native or not), by adding a new metadata attribute that refers to another mal value/type (nil by default). Add the following metadata related core functions (and remove any stub versions): * `meta`: this takes a single mal function/list/vector/hash-map argument and returns the value of the metadata attribute. * `with-meta`: this function takes two arguments. The first argument is a mal value and the second argument is another mal value/type to set as metadata. A copy of the mal value is returned that has its `meta` attribute set to the second argument. Note that when copying a mal function, it is important that the environment and macro attribute are retained. * Add a reader-macro that expands the token "^" to return a new list that contains the symbol "with-meta" and the result of reading the next next form (2nd argument) (`read_form`) and the next form (1st argument) in that order (metadata comes first with the ^ macro and the function second). * If you implemented `defmacro!` as mutating an existing function without copying it, you can now use the function copying mechanism used for metadata to make functions immutable even in the defmacro! case... * Add the following new core functions (and remove any stub versions): * `time-ms`: takes no arguments and returns the number of milliseconds since epoch (00:00:00 UTC January 1, 1970), or, if not possible, since another point in time (`time-ms` is usually used relatively to measure time durations). After `time-ms` is implemented, you can run the performance micro-benchmarks by running `make perf^quux`. * `conj`: takes a collection and one or more elements as arguments and returns a new collection which includes the original collection and the new elements. If the collection is a list, a new list is returned with the elements inserted at the start of the given list in opposite order; if the collection is a vector, a new vector is returned with the elements added to the end of the given vector. * `string?`: returns true if the parameter is a string. * `number?`: returns true if the parameter is a number. * `fn?`: returns true if the parameter is a function (internal or user-defined). * `macro?`: returns true if the parameter is a macro. * `seq`: takes a list, vector, string, or nil. If an empty list, empty vector, or empty string ("") is passed in then nil is returned. Otherwise, a list is returned unchanged, a vector is converted into a list, and a string is converted to a list containing the original string split into single character strings. * For interop with the target language, add this core function: * `quux-eval`: takes a string, evaluates it in the target language, and returns the result converted to the relevant Mal type. You may also add other interop functions as you see fit; Clojure, for example, has a function called `.` which allows calling Java methods. If the target language is a static language, consider using FFI or some language-specific reflection mechanism, if available. The tests for `quux-eval` and any other interop function should be added in `impls/quux/tests/stepA_mal.mal` (see the [tests for `lua-eval`](../impls/lua/tests/stepA_mal.mal) as an example). ### Next Steps * Join our [Discord](https://discord.gg/CKgnNbJBpF) channel. * If you have created an implementation for a new target language (or a unique and interesting variant of an existing implementation), consider sending a pull request to add it into the main mal repository. The [FAQ](../docs/FAQ.md#will-you-add-my-new-implementation) describes general requirements for getting an implementation merged into the main repository. * Take your interpreter implementation and have it emit source code in the target language rather than immediately evaluating it. In other words, create a compiler. * Pick a new target language and implement mal in it. Pick a language that is very different from any that you already know. * Use your mal implementation to implement a real world project. Many of these will force you to address interop. Some ideas: * Web server (with mal as CGI language for extra points) * An IRC/Slack chat bot * An editor (GUI or curses) with mal as a scripting/extension language. * An AI player for a game like Chess or Go. * Implement a feature in your mal implementation that is not covered by this guide. Some ideas: * Namespaces * Multi-threading support * Errors with line numbers and/or stack traces. * Lazy sequences * Clojure-style protocols * Full call/cc (call-with-current-continuation) support * Explicit TCO (i.e. `recur`) with tail-position error checking ================================================ FILE: process/step0_repl.txt ================================================ --- step0_repl ---------------------------------- READ(str): return str EVAL(ast,env): return ast PRINT(exp): return exp rep(str): return PRINT(EVAL(READ(str),"")) main loop: println(rep(readline("user> "))) ================================================ FILE: process/step1_read_print.txt ================================================ --- step1_read_print ---------------------------- import reader, printer READ(str): return reader.read_str(str) EVAL(ast,env): return ast PRINT(exp): return printer.pr_str(exp) rep(str): return PRINT(EVAL(READ(str),"")) main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) ================================================ FILE: process/step2_eval.txt ================================================ --- step2_eval ---------------------------------- import types, reader, printer READ(str): return reader.read_str(str) EVAL(ast, env): // prn('EVAL ast) match ast: 'key: return env[key] or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = {'+: add_fn, ...} rep(str): return PRINT(EVAL(READ(str),repl_env)) main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) ================================================ FILE: process/step3_env.txt ================================================ --- step3_env ----------------------------------- import types, reader, printer, env READ(str): return reader.read_str(str) EVAL(ast, env): if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. return EVAL(form, env) ('let* [k1 v1 ..] form): // idem (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) repl_env.set('+, add_fn) ... main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null) data = hash_map() set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) ================================================ FILE: process/step4_if_fn_do.txt ================================================ --- step4_if_fn_do ------------------------------ import types, reader, printer, env, core READ(str): return reader.read_str(str) EVAL(ast, env): if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. return EVAL(form, env) ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. return EVAL(last, env) ('if cond yes no): if EVAL(cond, env) in nil, false then return EVAL(yes, env) else return EVAL(no, env) ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] if malfn?(f) then: return EVAL(f.impl, new Env(f.env, f.parm, args)) return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, 'empty?: empty?, 'count: count} ================================================ FILE: process/step5_tco.txt ================================================ --- step5_tco ----------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, 'empty?: empty?, 'count: count} ================================================ FILE: process/step6_file.txt ================================================ --- step6_file ---------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), 'read-string: read_str, 'slurp read-file, '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, 'empty?: empty?, 'count: count, 'atom: (a) -> new Atom(a[0]), 'atom?: (a) -> type(a[0]) == "atom", 'deref: (a) -> a[0].val, 'reset!: (a) -> a[0].val = a[1], 'swap!: swap!} ================================================ FILE: process/step7_quote.txt ================================================ --- step7_quote --------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem ('quote form): return form ('quasiquote form): ast = quasiquote(form); continue (callable arg1 ..): f = EVAL(callable, env) args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), 'read-string: read_str, 'slurp read-file, '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), 'vec: (l) -> l converted to vector, 'empty?: empty?, 'count: count, 'atom: (a) -> new Atom(a[0]), 'atom?: (a) -> type(a[0]) == "atom", 'deref: (a) -> a[0].val, 'reset!: (a) -> a[0].val = a[1], 'swap!: swap!} ================================================ FILE: process/step8_macros.txt ================================================ --- step8_macros -------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem ('quote form): return form ('quasiquote form): ast = quasiquote(form); continue ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) (callable arg1 ..): f = EVAL(callable, env) if macro?(f) then: ast = f(arg1, ..); continue args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), 'read-string: read_str, 'slurp read-file, '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, '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(), 'empty?: empty?, 'count: count, 'atom: (a) -> new Atom(a[0]), 'atom?: (a) -> type(a[0]) == "atom", 'deref: (a) -> a[0].val, 'reset!: (a) -> a[0].val = a[1], 'swap!: swap!} ================================================ FILE: process/step9_try.txt ================================================ --- step9_try ----------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem ('quote form): return form ('quasiquote form): ast = quasiquote(form); continue ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) ('try* f ('catch* 'k h)): try returning EVAL(f, env) if native or malval exception then: env = new Env(env) env.set(k, exception) ast = h; continue ('try* form): ast = form; continue (callable arg1 ..): f = EVAL(callable, env) if macro?(f) then: ast = f(arg1, ..); continue args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'throw: throw, 'nil?: nil?, 'true?: true?, 'false?: false?, 'symbol: symbol, 'symbol?: symbol?, 'keyword: keyword, 'keyword?: keyword?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), 'read-string: read_str, 'slurp read-file, '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'list: list, 'list?: list?, 'vector: vector, 'vector?: vector?, 'hash-map: hash_map, 'map?: hash_map?, 'assoc: assoc, 'dissoc: dissoc, 'get: get, 'contains?: contains?, 'keys: keys, 'vals: vals, 'sequential? sequential?, 'cons: (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(), 'empty?: empty?, 'count: count, 'apply: apply, 'map: map, 'atom: (a) -> new Atom(a[0]), 'atom?: (a) -> type(a[0]) == "atom", 'deref: (a) -> a[0].val, 'reset!: (a) -> a[0].val = a[1], 'swap!: swap!} ================================================ FILE: process/stepA_mal.txt ================================================ --- stepA_mal ------------------------------- import types, reader, printer, env, core READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote EVAL(ast, env): loop: if env.get('DEBUG-EVAL) exists and not in nil, false then prn('EVAL ast) match ast: 'key: return env.get(key) or raise "'{key}' not found" [form1 ..]: return [EVAL(form1, env) ..] {key1 value1 ..}: return {key1 EVAL(value1, env) ..} ('def! 'key value): return env.set(key, EVAL(value, env)) ('let* (k1 v1 ..) form): env = new Env(env) env.set(k1, EVAL(v1, env)) .. ast = form; continue ('let* [k1 v1 ..] form): // idem ('do form1 .. last): EVAL(form1, env) .. ast = last; continue ('if cond yes no): if EVAL(cond, env) in nil, false then ast = yes; continue else ast = no; continue ('if cond yes): // idem with return nil in the else branch ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) ('fn* ['key1 ..] impl): // idem ('quote form): return form ('quasiquote form): ast = quasiquote(form); continue ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) ('try* f ('catch* 'k h)): try returning EVAL(f, env) if native or malval exception then: env = new Env(env) env.set(k, exception) ast = h; continue ('try* form): ast = form; continue (callable arg1 ..): f = EVAL(callable, env) if macro?(f) then: ast = f(arg1, ..); continue args = [EVAL(arg1, env) ..] if malfn?(f) then: env = new Env(f.env, f.parm, args) ast = f.impl; continue return f(args) otherwise: return ast PRINT(exp): return printer.pr_str(exp) repl_env = new Env() rep(str): return PRINT(EVAL(READ(str),repl_env)) ;; core.EXT: defined using the host language. core.ns.map((k,v) -> (repl_env.set(k, v))) repl_env.set('eval, (ast) -> EVAL(ast, repl-env)) repl_env.set('*ARGV*, cmdline_args[1..]) ;; core.mal: defined using the language itself rep("(def! *host-language* \"...\")") rep("(def! not (fn* (a) (if a false true)))") rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); if cmdline_args: rep("(load-file \"" + args[0] + "\")"); exit 0 rep("(println (str \"Mal [\" *host-language* \"]\"))") main loop: try: println(rep(readline("user> "))) catch e: println("Error: ", e) --- env module ---------------------------------- class Env (outer=null,binds=[],exprs=[]) data = hash_map() foreach b, i in binds: if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, 'throw: throw, 'nil?: nil?, 'true?: true?, 'false?: false?, 'string?: string?, 'symbol: symbol, 'symbol?: symbol?, 'keyword: keyword, 'keyword?: keyword?, 'number?: number?, 'fn?: fn?, 'macro?: macro?, 'pr-str: (a) -> a.map(|s| pr_str(e,true)).join(" ")), 'str: (a) -> a.map(|s| pr_str(e,false)).join("")), 'prn: (a) -> println(a.map(|s| pr_str(e,true)).join(" ")), 'println: (a) -> println(a.map(|s| pr_str(e,false)).join(" ")), 'read-string: read_str, 'readline: readline, 'slurp read-file, '<: lt, '<=: lte, '>: gt, '>=: gte, '+: add, '-: sub, '*: mult, '/: div, 'time-ms cur-epoch-millis, 'list: list, 'list?: list?, 'vector: vector, 'vector?: vector?, 'hash-map: hash_map, 'map?: hash_map?, 'assoc: assoc, 'dissoc: dissoc, 'get: get, 'contains?: contains?, 'keys: keys, 'vals: vals, 'sequential? sequential?, 'cons: (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(), 'empty?: empty?, 'count: count, 'apply: apply, 'map: map, 'conj: conj, 'seq: seq, 'meta: (a) -> a[0].meta, 'with-meta: (a) -> a[0].with_meta(a[1]), 'atom: (a) -> new Atom(a[0]), 'atom?: (a) -> type(a[0]) == "atom", 'deref: (a) -> a[0].val, 'reset!: (a) -> a[0].val = a[1], 'swap!: swap!} ================================================ FILE: process/steps.drawio ================================================ ================================================ FILE: runtest.py ================================================ #!/usr/bin/env python from __future__ import print_function import os, sys, re import argparse, time import signal, atexit from subprocess import Popen, STDOUT, PIPE from select import select # Pseudo-TTY and terminal manipulation import pty, array, fcntl, termios IS_PY_3 = sys.version_info[0] == 3 verbose = 0 debug_file = None log_file = None def debug(data): if debug_file: debug_file.write(data) debug_file.flush() def log(data, verbosity=0, end='\n'): if log_file: log_file.write(data + end) log_file.flush() if verbose >= verbosity: print(data, end=end) sys.stdout.flush() def vlog(data, end='\n'): log(data, verbosity=1, end=end) def vvlog(data, end='\n'): log(data, verbosity=2, end=end) sep = "\n" rundir = None parser = argparse.ArgumentParser( description="Run a test file against a Mal implementation") parser.add_argument('-v', '--verbose', action='count', default=0, help="verbose output; repeat to increase verbosity") parser.add_argument('--rundir', help="change to the directory before running tests") parser.add_argument('--start-timeout', default=10, type=int, help="default timeout for initial prompt") parser.add_argument('--test-timeout', default=20, type=int, help="default timeout for each individual test action") parser.add_argument('--pre-eval', default=None, type=str, help="Mal code to evaluate prior to running the test") parser.add_argument('--no-pty', action='store_true', help="Use direct pipes instead of pseudo-tty") parser.add_argument('--log-file', type=str, help="Write messages to the named file in addition the screen") parser.add_argument('--debug-file', type=str, help="Write all test interactions to the named file") parser.add_argument('--hard', action='store_true', help="Turn soft tests (soft, deferrable, optional) into hard failures") parser.add_argument('--continue-after-fail', action='store_true', help="Run all tests in a test file even if there are failures") # Control whether deferrable and optional tests are executed parser.add_argument('--deferrable', dest='deferrable', action='store_true', help="Enable deferrable tests that follow a ';>>> deferrable=True'") parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', help="Disable deferrable tests that follow a ';>>> deferrable=True'") parser.set_defaults(deferrable=True) parser.add_argument('--optional', dest='optional', action='store_true', help="Enable optional tests that follow a ';>>> optional=True'") parser.add_argument('--no-optional', dest='optional', action='store_false', help="Disable optional tests that follow a ';>>> optional=True'") parser.set_defaults(optional=True) parser.add_argument('test_file', type=str, help="a test file formatted as with mal test data") parser.add_argument('mal_cmd', nargs="*", help="Mal implementation command line. Use '--' to " "specify a Mal command line with dashed options.") parser.add_argument('--crlf', dest='crlf', action='store_true', help="Write \\r\\n instead of \\n to the input") class Runner(): def __init__(self, args, no_pty=False, line_break="\n"): #print "args: %s" % repr(args) self.no_pty = no_pty # Cleanup child process on exit atexit.register(self.cleanup) self.p = None env = os.environ env['TERM'] = 'dumb' env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' if no_pty: self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, preexec_fn=os.setsid, env=env) self.stdin = self.p.stdin self.stdout = self.p.stdout else: # provide tty to get 'interactive' readline to work master, slave = pty.openpty() # Set terminal size large so that readline will not send # ANSI/VT escape codes when the lines are long. buf = array.array('h', [100, 200, 0, 0]) fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) self.p = Popen(args, bufsize=0, stdin=slave, stdout=slave, stderr=STDOUT, preexec_fn=os.setsid, env=env) # Now close slave so that we will get an exception from # read when the child exits early # http://stackoverflow.com/questions/11165521 os.close(slave) self.stdin = os.fdopen(master, 'r+b', 0) self.stdout = self.stdin #print "started" self.buf = "" self.last_prompt = "" self.line_break = line_break def read_to_prompt(self, prompts, timeout): end_time = time.time() + timeout while time.time() < end_time: [outs,_,_] = select([self.stdout], [], [], 1) if self.stdout in outs: new_data = self.stdout.read(1) new_data = new_data.decode("latin1") if IS_PY_3 else new_data #print("new_data: %s" % repr(new_data)) debug(new_data) # Perform newline cleanup self.buf += new_data.replace("\r", "") if self.buf.endswith('\x1b[6n'): vvlog("Handling ASCII cursor query") self.stdin.write(b"\x1b[1;1R") self.buf = "" continue for prompt in prompts: regexp = re.compile(prompt) match = regexp.search(self.buf) if match: end = match.end() buf = self.buf[0:match.start()] self.buf = self.buf[end:] self.last_prompt = prompt return buf return None def writeline(self, str): def _to_bytes(s): return bytes(s, "latin1") if IS_PY_3 else s data = _to_bytes(str.replace('\r', '\x16\r') + self.line_break) #print("write: %s" % repr(data)) self.stdin.write(data) def cleanup(self): #print "cleaning up" if self.p: try: os.killpg(self.p.pid, signal.SIGTERM) except OSError: pass self.p = None class TestReader: def __init__(self, test_file): self.line_num = 0 f = open(test_file, newline='') if IS_PY_3 else open(test_file) self.data = f.read().split('\n') self.soft = False self.deferrable = False self.optional = False def next(self): self.msg = None self.form = None self.out = "" self.ret = None while self.data: self.line_num += 1 line = self.data.pop(0) if re.match(r"^\s*$", line): # blank line continue elif line[0:3] == ";;;": # ignore comment continue elif line[0:2] == ";;": # output comment self.msg = line[3:] return True elif line[0:5] == ";>>> ": # settings/commands settings = {} exec(line[5:], {}, settings) if 'soft' in settings: self.soft = settings['soft'] if 'deferrable' in settings and settings['deferrable']: self.deferrable = "\nSkipping deferrable and optional tests" return True if 'optional' in settings and settings['optional']: self.optional = "\nSkipping optional tests" return True continue elif line[0:1] == ";": # unexpected comment raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) self.form = line # the line is a form to send # Now find the output and return value while self.data: line = self.data[0] if line[0:3] == ";=>": self.ret = line[3:] self.line_num += 1 self.data.pop(0) break elif line[0:2] == ";/": self.out = self.out + line[2:] + sep self.line_num += 1 self.data.pop(0) else: self.ret = "" break if self.ret != None: break if self.out[-1:] == sep and not self.ret: # If there is no return value, output should not end in # separator self.out = self.out[0:-1] return self.form args = parser.parse_args(sys.argv[1:]) verbose = args.verbose # Workaround argparse issue with two '--' on command line if sys.argv.count('--') > 0: args.mal_cmd = sys.argv[sys.argv.index('--')+1:] if args.rundir: os.chdir(args.rundir) if args.log_file: log_file = open(args.log_file, "a") if args.debug_file: debug_file = open(args.debug_file, "a") r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") t = TestReader(args.test_file) def assert_prompt(runner, prompts, timeout): # Wait for the initial prompt header = runner.read_to_prompt(prompts, timeout=timeout) if not header == None: if header: vvlog("Started with:\n%s" % header) else: log("Did not receive one of following prompt(s): %s" % repr(prompts)) log(" Got : %s" % repr(r.buf)) sys.exit(1) def elide(s, max = 79): """Replace middle of a long string with '...' so length is <= max.""" return s if len(s) <= max else s[:(max-3)//2] + "..." + s[-((max-2)//2):] # Wait for the initial prompt try: assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) except: _, exc, _ = sys.exc_info() log("\nException: %s" % repr(exc)) log("Output before exception:\n%s" % r.buf) sys.exit(1) # Send the pre-eval code if any if args.pre_eval: sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) r.writeline(args.pre_eval) assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) total_test_cnt = 0 test_cnt = 0 pass_cnt = 0 fail_cnt = 0 soft_fail_cnt = 0 failures = [] fail_type = "" class TestTimeout(Exception): pass while t.next(): if args.deferrable == False and t.deferrable: log(t.deferrable) break if args.optional == False and t.optional: log(t.optional) break if t.msg != None: # omit blank test lines unless verbose if verbose or t.msg: log(t.msg) continue if t.form == None: continue total_test_cnt += 1 if fail_type == "TIMED OUT": continue # repl is stuck if not args.continue_after_fail: if fail_cnt > 0: continue # The repeated form is to get around an occasional OS X issue # where the form is repeated. # https://github.com/kanaka/mal/issues/30 expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] test_msg = "TEST (line %d): %s -> %s" % ( t.line_num, repr(t.form), repr(expects[0])) vlog(test_msg, end='') r.writeline(t.form) try: test_cnt += 1 res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], timeout=args.test_timeout) #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) if (t.ret == "" and t.out == ""): vlog(" -> SUCCESS (result ignored)") pass_cnt += 1 elif res and (re.search(expects[0], res, re.S) or re.search(expects[1], res, re.S)): vlog(" -> SUCCESS") pass_cnt += 1 else: if (res == None): if verbose == 0: log(test_msg, end='') log(" -> TIMED OUT") fail_cnt += 1 fail_type = "TIMED OUT" elif t.soft and not args.hard: vlog(" -> SOFT FAIL:") soft_fail_cnt += 1 fail_type = "SOFT FAILED" else: vlog(" -> FAIL:") fail_cnt += 1 fail_type = "FAILED" expected = " Expected : %s" % repr(expects[0]) got = " Got : %s" % repr(res or "") vvlog(expected) vlog(got if verbose >= 2 else elide(got)) failed_test = "%s %s:\n%s\n%s" % ( fail_type, test_msg, expected, got) failures.append(failed_test) except: _, exc, _ = sys.exc_info() log("\nException: %s" % repr(exc)) log("Output before exception:\n%s" % r.buf) break if len(failures) > 0: log("\nFAILURES:") for f in failures: log(f) results = """ TEST RESULTS (for %s): %3d: soft failing tests %3d: failing tests %3d: passing tests %3d: executed tests %3d: total tests in the file (%d skipped) """ % (args.test_file, soft_fail_cnt, fail_cnt, pass_cnt, test_cnt, total_test_cnt, total_test_cnt - test_cnt) log(results) debug("\n") # add some separate to debug log if fail_cnt > 0: sys.exit(1) sys.exit(0) ================================================ FILE: voom-like-version.sh ================================================ #!/usr/bin/env sh echo $(TZ=UTC git log -1 --pretty=%ad-g%h --date=format-local:"%Y%m%d_%H%M%S" -- "$@")$(test -z "$(git status --short -- "$@")" || echo _DIRTY)